From b1d749e59444f86e40f897c41739168bb1b1b9b3 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sun, 25 Feb 2018 22:43:42 +0100 Subject: [located] Push inner locations in `reference` to a CAst.t node. The `reference` type contains some ad-hoc locations in its constructors, but there is no reason not to handle them with the standard attribute container provided by `CAst.t`. An orthogonal topic to this commit is whether the `reference` type should contain a location or not at all. It seems that many places would become a bit clearer by splitting `reference` into non-located `reference` and `lreference`, however some other places become messier so we maintain the current status-quo for now. --- plugins/ssr/ssrcommon.ml | 2 +- plugins/ssr/ssrparser.ml4 | 4 ++-- plugins/ssr/ssrvernac.ml4 | 6 +++--- 3 files changed, 6 insertions(+), 6 deletions(-) (limited to 'plugins/ssr') diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml index f049963f1..19abf6780 100644 --- a/plugins/ssr/ssrcommon.ml +++ b/plugins/ssr/ssrcommon.ml @@ -853,7 +853,7 @@ open Util (** Constructors for constr_expr *) let mkCProp loc = CAst.make ?loc @@ CSort GProp let mkCType loc = CAst.make ?loc @@ CSort (GType []) -let mkCVar ?loc id = CAst.make ?loc @@ CRef (Ident (Loc.tag ?loc id), None) +let mkCVar ?loc id = CAst.make ?loc @@ CRef (CAst.make ?loc @@ Ident id, None) let rec mkCHoles ?loc n = if n <= 0 then [] else (CAst.make ?loc @@ CHole (None, IntroAnonymous, None)) :: mkCHoles ?loc (n - 1) let mkCHole loc = CAst.make ?loc @@ CHole (None, IntroAnonymous, None) diff --git a/plugins/ssr/ssrparser.ml4 b/plugins/ssr/ssrparser.ml4 index 2f8b8cb02..0d82a9f09 100644 --- a/plugins/ssr/ssrparser.ml4 +++ b/plugins/ssr/ssrparser.ml4 @@ -1165,7 +1165,7 @@ ARGUMENT EXTEND ssrbvar TYPED AS constr PRINTED BY pr_ssrbvar END let bvar_lname = let open CAst in function - | { v = CRef (Ident (loc, id), _) } -> CAst.make ?loc @@ Name id + | { v = CRef ({loc;v=Ident id}, _) } -> CAst.make ?loc @@ Name id | { loc = loc } -> CAst.make ?loc Anonymous let pr_ssrbinder prc _ _ (_, c) = prc c @@ -1257,7 +1257,7 @@ END let pr_ssrfixfwd _ _ _ (id, fwd) = str " fix " ++ pr_id id ++ pr_fwd fwd let bvar_locid = function - | { CAst.v = CRef (Ident (loc, id), _) } -> CAst.make ?loc id + | { CAst.v = CRef ({CAst.loc=loc;v=Ident id}, _) } -> CAst.make ?loc id | _ -> CErrors.user_err (Pp.str "Missing identifier after \"(co)fix\"") diff --git a/plugins/ssr/ssrvernac.ml4 b/plugins/ssr/ssrvernac.ml4 index c3b6a7c59..05dbf0a86 100644 --- a/plugins/ssr/ssrvernac.ml4 +++ b/plugins/ssr/ssrvernac.ml4 @@ -432,7 +432,7 @@ END let interp_modloc mr = let interp_mod (_, mr) = - let (loc, qid) = qualid_of_reference mr in + let {CAst.loc=loc; v=qid} = qualid_of_reference mr in try Nametab.full_name_module qid with Not_found -> CErrors.user_err ?loc (str "No Module " ++ pr_qualid qid) in let mr_out, mr_in = List.partition fst mr in @@ -565,9 +565,9 @@ GEXTEND Gram gallina_ext: (* Canonical structure *) [[ IDENT "Canonical"; qid = Constr.global -> - Vernacexpr.VernacCanonical (AN qid) + Vernacexpr.VernacCanonical (CAst.make @@ AN qid) | IDENT "Canonical"; ntn = Prim.by_notation -> - Vernacexpr.VernacCanonical (ByNotation ntn) + Vernacexpr.VernacCanonical (CAst.make @@ ByNotation ntn) | IDENT "Canonical"; qid = Constr.global; d = G_vernac.def_body -> let s = coerce_reference_to_id qid in -- cgit v1.2.3