diff options
| author | Pierre-Marie Pédrot | 2018-07-12 16:30:16 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2018-10-02 09:25:25 +0200 |
| commit | 389aa51f37fda1a7a8490d1b4042b881aba730df (patch) | |
| tree | 6cf820636ded03e0fb91d954af615345c35be19a /grammar | |
| parent | 1bde8c0912ed1129e71ffe20299ac89299492ba5 (diff) | |
Pass unnamed arguments to ML macros.
This was imposing a bit of useless burden on the API for no good reason.
Diffstat (limited to 'grammar')
| -rw-r--r-- | grammar/q_util.mli | 2 | ||||
| -rw-r--r-- | grammar/q_util.mlp | 6 | ||||
| -rw-r--r-- | grammar/tacextend.mlp | 15 | ||||
| -rw-r--r-- | grammar/vernacextend.mlp | 13 |
4 files changed, 15 insertions, 21 deletions
diff --git a/grammar/q_util.mli b/grammar/q_util.mli index f3af318b60..b163100fc3 100644 --- a/grammar/q_util.mli +++ b/grammar/q_util.mli @@ -50,3 +50,5 @@ val type_of_user_symbol : user_symbol -> argument_type val parse_user_entry : string -> string -> user_symbol val mlexpr_of_symbol : user_symbol -> MLast.expr + +val binders_of_tokens : MLast.expr -> extend_token list -> MLast.expr diff --git a/grammar/q_util.mlp b/grammar/q_util.mlp index 0e2bf55d86..a2007d258c 100644 --- a/grammar/q_util.mlp +++ b/grammar/q_util.mlp @@ -142,3 +142,9 @@ let rec mlexpr_of_symbol = function assert (e = "tactic"); let wit = <:expr< $lid:"wit_"^e$ >> in <:expr< Extend.TUentryl (Genarg.get_arg_tag $wit$) $mlexpr_of_int l$>> + +let rec binders_of_tokens e = function +| [] -> e +| ExtNonTerminal(_,None) :: cl -> <:expr< fun _ -> $binders_of_tokens e cl$ >> +| ExtNonTerminal(_,Some id) :: cl -> <:expr< fun $lid:id$ -> $binders_of_tokens e cl$ >> +| ExtTerminal _ :: cl -> binders_of_tokens e cl diff --git a/grammar/tacextend.mlp b/grammar/tacextend.mlp index 5943600b7c..a093f78388 100644 --- a/grammar/tacextend.mlp +++ b/grammar/tacextend.mlp @@ -20,16 +20,8 @@ let plugin_name = <:expr< __coq_plugin_name >> let rec mlexpr_of_clause = function | [] -> <:expr< TyNil >> | ExtTerminal s :: cl -> <:expr< TyIdent($str:s$, $mlexpr_of_clause cl$) >> -| ExtNonTerminal(g,None) :: cl -> - <:expr< TyAnonArg($mlexpr_of_symbol g$, $mlexpr_of_clause cl$) >> -| ExtNonTerminal(g,Some id) :: cl -> - <:expr< TyArg($mlexpr_of_symbol g$, $mlexpr_of_string id$, $mlexpr_of_clause cl$) >> - -let rec binders_of_clause e = function -| [] -> <:expr< fun ist -> $e$ >> -| ExtNonTerminal(_,None) :: cl -> binders_of_clause e cl -| ExtNonTerminal(_,Some id) :: cl -> <:expr< fun $lid:id$ -> $binders_of_clause e cl$ >> -| _ :: cl -> binders_of_clause e cl +| ExtNonTerminal (g, _) :: cl -> + <:expr< TyArg($mlexpr_of_symbol g$, $mlexpr_of_clause cl$) >> open Pcaml @@ -52,7 +44,8 @@ EXTEND tacrule: [ [ "["; l = LIST1 tacargs; "]"; "->"; "["; e = Pcaml.expr; "]" -> - <:expr< TyML($mlexpr_of_clause l$, $binders_of_clause e l$) >> + let e = <:expr< fun ist -> $e$ >> in + <:expr< TyML($mlexpr_of_clause l$, $binders_of_tokens e l$) >> ] ] ; diff --git a/grammar/vernacextend.mlp b/grammar/vernacextend.mlp index f30c96a7f5..3c401e827e 100644 --- a/grammar/vernacextend.mlp +++ b/grammar/vernacextend.mlp @@ -24,23 +24,16 @@ type rule = { (** Whether this entry is deprecated *) } -let rec make_patt r = function -| [] -> r -| ExtNonTerminal (_, Some p) :: l -> <:expr< fun $lid:p$ -> $make_patt r l$ >> -| ExtNonTerminal (_, None) :: l -> <:expr< fun _ -> $make_patt r l$ >> -| ExtTerminal _ :: l -> make_patt r l - let rec mlexpr_of_clause = function | [] -> <:expr< Vernacentries.TyNil >> | ExtTerminal s :: cl -> <:expr< Vernacentries.TyTerminal ($str:s$, $mlexpr_of_clause cl$) >> | ExtNonTerminal (g, id) :: cl -> - let id = mlexpr_of_option mlexpr_of_string id in - <:expr< Vernacentries.TyNonTerminal ($id$, $mlexpr_of_symbol g$, $mlexpr_of_clause cl$) >> + <:expr< Vernacentries.TyNonTerminal ($mlexpr_of_symbol g$, $mlexpr_of_clause cl$) >> let make_rule r = let ty = mlexpr_of_clause r.r_patt in - let cmd = make_patt r.r_branch r.r_patt in - let make_classifier c = make_patt c r.r_patt in + let cmd = binders_of_tokens r.r_branch r.r_patt in + let make_classifier c = binders_of_tokens c r.r_patt in let classif = mlexpr_of_option make_classifier r.r_class in <:expr< Vernacentries.TyML ($mlexpr_of_bool r.r_depr$, $ty$, $cmd$, $classif$) >> |
