diff options
| author |  Matej Košík <matej.kosik@inria.fr> | 2017-08-04 18:28:31 +0200 |
|---|---|---|
| committer | Matej Košík <matej.kosik@inria.fr> | 2017-11-01 08:05:37 +0100 |
| commit | f874a292c94b290a31af8e0f707ffd20ab31001b (patch) | |
| tree | eb8c4b67597cbf6adaee337717e9a09eaf9325eb /vernac | |
| parent | e5659c8ffe735c530a707a61c692a3af21a79a9a (diff) | |
provide "loc : Loc.t" binding within "VERNAC COMMAND EXTEND" rules
Originally, it was not possible to define a new vernacular command
in the following way:
VERNAC COMMAND EXTEND Cmd6 CLASSIFIED AS QUERY
[ "SomeCmd" ] -> [ Feedback.msg_notice ?loc (Pp.str "some message") ]
END
because "loc : Loc.t" was not bound.
This commit fixes that, i.e. the location of the custom Vernacular command
(within *.v file) is made available as "loc" variable bound on the right side
of "->" .
Diffstat (limited to 'vernac')
| -rw-r--r-- | vernac/vernacentries.ml | 2 | ||||
| -rw-r--r-- | vernac/vernacinterp.ml | 14 | ||||
| -rw-r--r-- | vernac/vernacinterp.mli | 4 |
3 files changed, 10 insertions, 10 deletions
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index e08cb8387..f83546ea6 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -2070,7 +2070,7 @@ let interp ?proof ?loc locality poly c = | VernacProofMode mn -> Proof_global.set_proof_mode mn [@ocaml.warning "-3"] (* Extensions *) - | VernacExtend (opn,args) -> Vernacinterp.call ?locality (opn,args) + | VernacExtend (opn,args) -> Vernacinterp.call ?locality ?loc (opn,args) (* Vernaculars that take a locality flag *) let check_vernac_supports_locality c l = diff --git a/vernac/vernacinterp.ml b/vernac/vernacinterp.ml index 2d9c0fa36..41fee6bd0 100644 --- a/vernac/vernacinterp.ml +++ b/vernac/vernacinterp.ml @@ -11,7 +11,7 @@ open Pp open CErrors type deprecation = bool -type vernac_command = Genarg.raw_generic_argument list -> unit -> unit +type vernac_command = Genarg.raw_generic_argument list -> Loc.t option -> unit (* Table of vernac entries *) let vernac_tab = @@ -49,8 +49,8 @@ let warn_deprecated_command = (* Interpretation of a vernac command *) -let call ?locality (opn,converted_args) = - let loc = ref "Looking up command" in +let call ?locality ?loc (opn,converted_args) = + let phase = ref "Looking up command" in try let depr, callback = vinterp_map opn in let () = if depr then @@ -62,16 +62,16 @@ let call ?locality (opn,converted_args) = let pr = pr_sequence pr_gram rules in warn_deprecated_command pr; in - loc:= "Checking arguments"; + phase := "Checking arguments"; let hunk = callback converted_args in - loc:= "Executing command"; + phase := "Executing command"; Locality.LocalityFixme.set locality; - hunk(); + hunk loc; Locality.LocalityFixme.assert_consumed() with | Drop -> raise Drop | reraise -> let reraise = CErrors.push reraise in if !Flags.debug then - Feedback.msg_debug (str"Vernac Interpreter " ++ str !loc); + Feedback.msg_debug (str"Vernac Interpreter " ++ str !phase); iraise reraise diff --git a/vernac/vernacinterp.mli b/vernac/vernacinterp.mli index f58d07086..84370fdc2 100644 --- a/vernac/vernacinterp.mli +++ b/vernac/vernacinterp.mli @@ -9,7 +9,7 @@ (** Interpretation of extended vernac phrases. *) type deprecation = bool -type vernac_command = Genarg.raw_generic_argument list -> unit -> unit +type vernac_command = Genarg.raw_generic_argument list -> Loc.t option -> unit val vinterp_add : deprecation -> Vernacexpr.extend_name -> vernac_command -> unit @@ -17,4 +17,4 @@ val overwriting_vinterp_add : Vernacexpr.extend_name -> vernac_command -> unit val vinterp_init : unit -> unit -val call : ?locality:bool -> Vernacexpr.extend_name * Genarg.raw_generic_argument list -> unit +val call : ?locality:bool -> ?loc:Loc.t -> Vernacexpr.extend_name * Genarg.raw_generic_argument list -> unit |