diff options
| -rw-r--r-- | parsing/g_basevernac.ml4 | 4 | ||||
| -rw-r--r-- | toplevel/metasyntax.ml | 7 | ||||
| -rw-r--r-- | toplevel/metasyntax.mli | 3 |
3 files changed, 14 insertions, 0 deletions
diff --git a/parsing/g_basevernac.ml4 b/parsing/g_basevernac.ml4 index 1bd70679ff..0b815a0c61 100644 --- a/parsing/g_basevernac.ml4 +++ b/parsing/g_basevernac.ml4 @@ -294,7 +294,11 @@ GEXTEND Gram VernacInfix (local,ai,ni,op,p,b,v8,sc) | IDENT "Distfix"; local = locality; a = entry_prec; n = natural; s = STRING; p = global; sc = OPT [ ":"; sc = IDENT -> sc ] -> + let (a,s,c) = Metasyntax.translate_distfix a s p in + VernacNotation (local,c,Some(s,[SetLevel n;SetAssoc a]),None,sc) +(* VernacDistfix (local,a,n,s,p,sc) +*) | IDENT "Notation"; local = locality; s = IDENT; ":="; c = constr; l = [ "("; IDENT "only"; IDENT "parsing"; ")" -> [SetOnlyParsing] | -> [] ] -> diff --git a/toplevel/metasyntax.ml b/toplevel/metasyntax.ml index 3d11b2412e..2a5fd697c9 100644 --- a/toplevel/metasyntax.ml +++ b/toplevel/metasyntax.ml @@ -888,6 +888,13 @@ let rec rename x vars n = function | WhiteSpace _::l -> rename x vars n l +let translate_distfix assoc df r = + let (vars,l) = rename "x" [] 1 (split df) in + let df = String.concat " " l in + let a = mkAppC (mkRefC r, vars) in + let assoc = match assoc with None -> Gramext.LeftA | Some a -> a in + (assoc,df,a) + let add_distfix local assoc n df r sc = (* "x" cannot clash since r is globalized (included section vars) *) let (vars,l) = rename "x" [] 1 (split df) in diff --git a/toplevel/metasyntax.mli b/toplevel/metasyntax.mli index aae9229125..31b8e046d0 100644 --- a/toplevel/metasyntax.mli +++ b/toplevel/metasyntax.mli @@ -35,6 +35,9 @@ val add_infix : locality_flag -> val add_distfix : locality_flag -> grammar_associativity -> precedence -> string -> reference -> scope_name option -> unit +val translate_distfix : grammar_associativity -> string -> reference -> + Gramext.g_assoc * string * constr_expr + val add_delimiters : scope_name -> string -> unit val add_notation : locality_flag -> constr_expr |