From 3ef7797ef6fc605dfafb32523261fe1b023aeecb Mon Sep 17 00:00:00 2001 From: Samuel Mimram Date: Fri, 28 Apr 2006 14:59:16 +0000 Subject: Imported Upstream version 8.0pl3+8.1alpha --- parsing/egrammar.ml | 420 +++++++++++++++++----------------------------------- 1 file changed, 139 insertions(+), 281 deletions(-) (limited to 'parsing/egrammar.ml') diff --git a/parsing/egrammar.ml b/parsing/egrammar.ml index 09889d40..c723175c 100644 --- a/parsing/egrammar.ml +++ b/parsing/egrammar.ml @@ -6,64 +6,31 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: egrammar.ml,v 1.48.2.4 2005/12/23 22:16:46 herbelin Exp $ *) +(* $Id: egrammar.ml 7762 2005-12-30 10:55:33Z herbelin $ *) open Pp open Util -open Ppextend -open Extend open Pcoq +open Extend open Topconstr -open Ast open Genarg open Libnames open Nameops - -(* State of the grammar extensions *) - -type notation_grammar = - int * Gramext.g_assoc option * notation * prod_item list * int list option - -type all_grammar_command = - | Notation of (precedence * tolerability list) * notation_grammar - | Grammar of grammar_command - | TacticGrammar of - (string * (string * grammar_production list) * - (Names.dir_path * Tacexpr.raw_tactic_expr)) - list * (string * Genarg.argument_type list * - (string * Pptactic.grammar_terminals)) list - -let subst_all_grammar_command subst = function - | Notation _ -> anomaly "Notation not in GRAMMAR summary" - | Grammar gc -> Grammar (subst_grammar_command subst gc) - | TacticGrammar (g,p) -> TacticGrammar (g,p) (* TODO ... *) - -let (grammar_state : all_grammar_command list ref) = ref [] - +open Tacexpr +open Names +open Vernacexpr (**************************************************************************) -(* Interpretation of the right hand side of grammar rules *) - -(* When reporting errors, we add the name of the grammar rule that failed *) -let specify_name name e = - match e with - | UserError(lab,strm) -> - UserError(lab, (str"during interpretation of grammar rule " ++ - str name ++ str"," ++ spc () ++ strm)) - | Anomaly(lab,strm) -> - Anomaly(lab, (str"during interpretation of grammar rule " ++ - str name ++ str"," ++ spc () ++ strm)) - | Failure s -> - Failure("during interpretation of grammar rule "^name^", "^s) - | e -> e - -(* Translation of environments: a production +(* + * --- Note on the mapping of grammar productions to camlp4 actions --- + * + * Translation of environments: a production * [ nt1(x1) ... nti(xi) ] -> act(x1..xi) * is written (with camlp4 conventions): * (fun vi -> .... (fun v1 -> act(v1 .. vi) )..) * where v1..vi are the values generated by non-terminals nt1..nti. * Since the actions are executed by substituting an environment, - * make_act builds the following closure: + * the make_*_action family build the following closure: * * ((fun env -> * (fun vi -> @@ -77,11 +44,18 @@ let specify_name name e = * []) *) -open Names +(**********************************************************************) +(** Declare Notations grammar rules *) + +type prod_item = + | Term of Token.pattern + | NonTerm of constr_production_entry * + (Names.identifier * constr_production_entry) option type 'a action_env = (identifier * 'a) list -let make_act (f : loc -> constr_expr action_env -> constr_expr) pil = +let make_constr_action + (f : loc -> constr_expr action_env -> constr_expr) pil = let rec make (env : constr_expr action_env) = function | [] -> Gramext.action (fun loc -> f loc env) @@ -95,8 +69,8 @@ let make_act (f : loc -> constr_expr action_env -> constr_expr) pil = Gramext.action (fun (v:identifier) -> make ((p,CRef (Ident (dummy_loc,v))) :: env) tl) | Some (p, ETBigint) :: tl -> (* non-terminal *) - Gramext.action (fun (v:Bignat.bigint) -> - make ((p,CNumeral (dummy_loc,v)) :: env) tl) + Gramext.action (fun (v:Bigint.bigint) -> + make ((p,CPrim (dummy_loc,Numeral v)) :: env) tl) | Some (p, ETConstrList _) :: tl -> Gramext.action (fun (v:constr_expr list) -> let dummyid = Ident (dummy_loc,id_of_string "") in @@ -105,7 +79,7 @@ let make_act (f : loc -> constr_expr action_env -> constr_expr) pil = failwith "Unexpected entry of type cases pattern" in make [] (List.rev pil) -let make_act_in_cases_pattern (* For Notations *) +let make_cases_pattern_action (f : loc -> cases_pattern_expr action_env -> cases_pattern_expr) pil = let rec make (env : cases_pattern_expr action_env) = function | [] -> @@ -121,8 +95,8 @@ let make_act_in_cases_pattern (* For Notations *) Gramext.action (fun (v:identifier) -> make ((p,CPatAtom (dummy_loc,Some (Ident (dummy_loc,v)))) :: env) tl) | Some (p, ETBigint) :: tl -> (* non-terminal *) - Gramext.action (fun (v:Bignat.bigint) -> - make ((p,CPatNumeral (dummy_loc,v)) :: env) tl) + Gramext.action (fun (v:Bigint.bigint) -> + make ((p,CPatPrim (dummy_loc,Numeral v)) :: env) tl) | Some (p, ETConstrList _) :: tl -> Gramext.action (fun (v:cases_pattern_expr list) -> let dummyid = Ident (dummy_loc,id_of_string "") in @@ -131,183 +105,37 @@ let make_act_in_cases_pattern (* For Notations *) failwith "Unexpected entry of type cases pattern or other" in make [] (List.rev pil) -(* For V7 Grammar only *) -let make_cases_pattern_act - (f : loc -> cases_pattern_expr action_env -> cases_pattern_expr) pil = - let rec make (env : cases_pattern_expr action_env) = function - | [] -> - Gramext.action (fun loc -> f loc env) - | None :: tl -> (* parse a non-binding item *) - Gramext.action (fun _ -> make env tl) - | Some (p, ETPattern) :: tl -> (* non-terminal *) - Gramext.action (fun v -> make ((p,v) :: env) tl) - | Some (p, ETReference) :: tl -> (* non-terminal *) - Gramext.action (fun v -> make ((p,CPatAtom(dummy_loc,Some v)) :: env) - tl) - | Some (p, ETBigint) :: tl -> (* non-terminal *) - Gramext.action (fun v -> make ((p,CPatNumeral(dummy_loc,v)) :: env) tl) - | Some (p, (ETConstrList _ | ETIdent | ETConstr _ | ETOther _)) :: tl -> - error "ident and constr entry not admitted in patterns cases syntax extensions" in - make [] (List.rev pil) - -(* Grammar extension command. Rules are assumed correct. - * Type-checking of grammar rules is done during the translation of - * ast to the type grammar_command. We only check that the existing - * entries have the type assumed in the grammar command (these types - * annotations are added when type-checking the command, function - * Extend.of_ast) *) - -let symbol_of_prod_item univ assoc from forpat = function +let make_constr_prod_item univ assoc from forpat = function | Term tok -> (Gramext.Stoken tok, None) | NonTerm (nt, ovar) -> let eobj = symbol_of_production assoc from forpat nt in (eobj, ovar) -let coerce_to_id = function - | CRef (Ident (_,id)) -> id - | c -> - user_err_loc (constr_loc c, "subst_rawconstr", - str"This expression should be a simple identifier") - -let coerce_to_ref = function - | CRef r -> r - | c -> - user_err_loc (constr_loc c, "subst_rawconstr", - str"This expression should be a simple reference") - -let subst_ref loc subst id = - try coerce_to_ref (List.assoc id subst) with Not_found -> Ident (loc,id) - -let subst_pat_id loc subst id = - try List.assoc id subst - with Not_found -> CPatAtom (loc,Some (Ident (loc,id))) - -let subst_id subst id = - try coerce_to_id (List.assoc id subst) with Not_found -> id - -(* -let subst_cases_pattern_expr a loc subs = - let rec subst = function - | CPatAlias (_,p,x) -> CPatAlias (loc,subst p,x) - (* No subst in compound pattern ? *) - | CPatCstr (_,ref,pl) -> CPatCstr (loc,ref,List.map subst pl) - | CPatAtom (_,Some (Ident (_,id))) -> subst_pat_id loc subs id - | CPatAtom (_,x) -> CPatAtom (loc,x) - | CPatNotation (_,ntn,l) -> CPatNotation - | CPatNumeral (_,n) -> CPatNumeral (loc,n) - | CPatDelimiters (_,key,p) -> CPatDelimiters (loc,key,subst p) - in subst a -*) - -let subst_constr_expr a loc subs = - let rec subst = function - | CRef (Ident (_,id)) -> - (try List.assoc id subs with Not_found -> CRef (Ident (loc,id))) - (* Temporary: no robust treatment of substituted binders *) - | CLambdaN (_,[],c) -> subst c - | CLambdaN (_,([],t)::bl,c) -> subst (CLambdaN (loc,bl,c)) - | CLambdaN (_,((_,na)::bl,t)::bll,c) -> - let na = name_app (subst_id subs) na in - CLambdaN (loc,[[loc,na],subst t], subst (CLambdaN (loc,(bl,t)::bll,c))) - | CProdN (_,[],c) -> subst c - | CProdN (_,([],t)::bl,c) -> subst (CProdN (loc,bl,c)) - | CProdN (_,((_,na)::bl,t)::bll,c) -> - let na = name_app (subst_id subs) na in - CProdN (loc,[[loc,na],subst t], subst (CProdN (loc,(bl,t)::bll,c))) - | CLetIn (_,(_,na),b,c) -> - let na = name_app (subst_id subs) na in - CLetIn (loc,(loc,na),subst b,subst c) - | CArrow (_,a,b) -> CArrow (loc,subst a,subst b) - | CAppExpl (_,(p,Ident (_,id)),l) -> - CAppExpl (loc,(p,subst_ref loc subs id),List.map subst l) - | CAppExpl (_,r,l) -> CAppExpl (loc,r,List.map subst l) - | CApp (_,(p,a),l) -> - CApp (loc,(p,subst a),List.map (fun (a,i) -> (subst a,i)) l) - | CCast (_,a,b) -> CCast (loc,subst a,subst b) - | CNotation (_,n,l) -> CNotation (loc,n,List.map subst l) - | CDelimiters (_,s,a) -> CDelimiters (loc,s,subst a) - | CHole _ | CEvar _ | CPatVar _ | CSort _ - | CNumeral _ | CDynamic _ | CRef _ as x -> x - | CCases (_,(po,rtntypo),a,bl) -> - (* TODO: apply g on the binding variables in pat... *) - let bl = List.map (fun (_,pat,rhs) -> (loc,pat,subst rhs)) bl in - CCases (loc,(option_app subst po,option_app subst rtntypo), - List.map (fun (tm,x) -> subst tm,x) a,bl) - | COrderedCase (_,s,po,a,bl) -> - COrderedCase (loc,s,option_app subst po,subst a,List.map subst bl) - | CLetTuple (_,nal,(na,po),a,b) -> - let na = option_app (name_app (subst_id subs)) na in - let nal = List.map (name_app (subst_id subs)) nal in - CLetTuple (loc,nal,(na,option_app subst po),subst a,subst b) - | CIf (_,c,(na,po),b1,b2) -> - let na = option_app (name_app (subst_id subs)) na in - CIf (loc,subst c,(na,option_app subst po),subst b1,subst b2) - | CFix (_,id,dl) -> - CFix (loc,id,List.map (fun (id,n,bl, t,d) -> - (id,n, - List.map(function - LocalRawAssum(nal,ty) -> LocalRawAssum(nal,subst ty) - | LocalRawDef(na,def) -> LocalRawDef(na,subst def)) bl, - subst t,subst d)) dl) - | CCoFix (_,id,dl) -> - CCoFix (loc,id,List.map (fun (id,bl,t,d) -> - (id, - List.map(function - LocalRawAssum(nal,ty) -> LocalRawAssum(nal,subst ty) - | LocalRawDef(na,def) -> LocalRawDef(na,subst def)) bl, - subst t,subst d)) dl) - in subst a - -(* For V7 Grammar only *) -let make_rule univ assoc etyp rule = - if not !Options.v7 then anomaly "No Grammar in new syntax"; - let pil = List.map (symbol_of_prod_item univ assoc etyp false) rule.gr_production in +let extend_constr entry (n,assoc,pos,p4assoc,name) mkact (forpat,pt) = + let univ = get_univ "constr" in + let pil = List.map (make_constr_prod_item univ assoc n forpat) pt in let (symbs,ntl) = List.split pil in - let act = match etyp with - | ETPattern -> - (* Ugly *) - let f loc env = match rule.gr_action, env with - | CRef (Ident(_,p)), [p',a] when p=p' -> a - | CDelimiters (_,s,CRef (Ident(_,p))), [p',a] when p=p' -> - CPatDelimiters (loc,s,a) - | _ -> error "Unable to handle this grammar extension of pattern" in - make_cases_pattern_act f ntl - | ETConstrList _ | ETIdent | ETBigint | ETReference -> error "Cannot extend" - | ETConstr _ | ETOther _ -> - make_act (subst_constr_expr rule.gr_action) ntl in - (symbs, act) + grammar_extend entry pos [(name, p4assoc, [symbs, mkact ntl])] -(* Rules of a level are entered in reverse order, so that the first rules - are applied before the last ones *) -(* For V7 Grammar only *) -let extend_entry univ (te, etyp, pos, name, ass, p4ass, rls) = - let rules = List.rev (List.map (make_rule univ ass etyp) rls) in - grammar_extend te pos [(name, p4ass, rules)] - -(* Defines new entries. If the entry already exists, check its type *) -let define_entry univ {ge_name=typ; gl_assoc=ass; gl_rules=rls} = - let e,lev,keepassoc = get_constr_entry false typ in - let pos,p4ass,name = find_position false keepassoc ass lev in - (e,typ,pos,name,ass,p4ass,rls) - -(* Add a bunch of grammar rules. Does not check if it is well formed *) -(* For V7 Grammar only *) -let extend_grammar_rules gram = - let univ = get_univ gram.gc_univ in - let tl = List.map (define_entry univ) gram.gc_entries in - List.iter (extend_entry univ) tl - -(* Add a grammar rules for tactics *) -type grammar_tactic_production = - | TacTerm of string - | TacNonTerm of loc * (Gram.te Gramext.g_symbol * argument_type) * string option +let extend_constr_notation (n,assoc,ntn,rule) = + (* Add the notation in constr *) + let mkact loc env = CNotation (loc,ntn,List.map snd env) in + let (e,level,keepassoc) = get_constr_entry false (ETConstr (n,())) in + let pos,p4assoc,name = find_position false keepassoc assoc level in + extend_constr e (ETConstr(n,()),assoc,pos,p4assoc,name) + (make_constr_action mkact) (false,rule); + (* Add the notation in cases_pattern *) + let mkact loc env = CPatNotation (loc,ntn,List.map snd env) in + let (e,level,keepassoc) = get_constr_entry true (ETConstr (n,())) in + let pos,p4assoc,name = find_position true keepassoc assoc level in + extend_constr e (ETConstr (n,()),assoc,pos,p4assoc,name) + (make_cases_pattern_action mkact) (true,rule) -let make_prod_item = function - | TacTerm s -> (Gramext.Stoken (Extend.terminal s), None) - | TacNonTerm (_,(nont,t), po) -> - (nont, option_app (fun p -> (p,t)) po) +(**********************************************************************) +(** Making generic actions in type generic_argument *) -let make_gen_act f pil = +let make_generic_action + (f:loc -> ('b * raw_generic_argument) list -> 'a) pil = let rec make env = function | [] -> Gramext.action (fun loc -> f loc env) @@ -317,73 +145,77 @@ let make_gen_act f pil = Gramext.action (fun v -> make ((p,in_generic t v) :: env) tl) in make [] (List.rev pil) -let extend_constr entry (n,assoc,pos,p4assoc,name) make_act (forpat,pt) = - let univ = get_univ "constr" in - let pil = List.map (symbol_of_prod_item univ assoc n forpat) pt in - let (symbs,ntl) = List.split pil in - let act = make_act ntl in - grammar_extend entry pos [(name, p4assoc, [symbs, act])] - -let extend_constr_notation (n,assoc,ntn,rule,permut) = - let mkact = - match permut with - None -> (fun loc env -> CNotation (loc,ntn,List.map snd env)) - | Some p -> (fun loc env -> - CNotation (loc,ntn,List.map (fun i -> snd (List.nth env i)) p)) in - let (e,level,keepassoc) = get_constr_entry false (ETConstr (n,())) in - let pos,p4assoc,name = find_position false keepassoc assoc level in - extend_constr e (ETConstr(n,()),assoc,pos,p4assoc,name) - (make_act mkact) (false,rule); - if not !Options.v7 then - let mkact loc env = CPatNotation (loc,ntn,List.map snd env) in - let (e,level,keepassoc) = get_constr_entry true (ETConstr (n,())) in - let pos,p4assoc,name = find_position true keepassoc assoc level in - extend_constr e (ETConstr (n,()),assoc,pos,p4assoc,name) - (make_act_in_cases_pattern mkact) (true,rule) - -(* These grammars are not a removable *) -let make_rule univ f g (s,pt) = - let hd = Gramext.Stoken ("IDENT", s) in - let pil = (hd,None) :: List.map g pt in - let (symbs,ntl) = List.split pil in - let act = make_gen_act f ntl in +let make_rule univ f g pt = + let (symbs,ntl) = List.split (List.map g pt) in + let act = make_generic_action f ntl in (symbs, act) +(**********************************************************************) +(** Grammar extensions declared at ML level *) + +type grammar_tactic_production = + | TacTerm of string + | TacNonTerm of + loc * (Gram.te Gramext.g_symbol * argument_type) * string option + +let make_prod_item = function + | TacTerm s -> (Gramext.Stoken (Lexer.terminal s), None) + | TacNonTerm (_,(nont,t), po) -> (nont, option_app (fun p -> (p,t)) po) + +(* Tactic grammar extensions *) + let tac_exts = ref [] let get_extend_tactic_grammars () = !tac_exts let extend_tactic_grammar s gl = tac_exts := (s,gl) :: !tac_exts; let univ = get_univ "tactic" in - let make_act loc l = Tacexpr.TacExtend (loc,s,List.map snd l) in - let rules = List.map (make_rule univ make_act make_prod_item) gl in + let mkact loc l = Tacexpr.TacExtend (loc,s,List.map snd l) in + let rules = List.map (make_rule univ mkact make_prod_item) gl in Gram.extend Tactic.simple_tactic None [(None, None, List.rev rules)] +(* Vernac grammar extensions *) + let vernac_exts = ref [] let get_extend_vernac_grammars () = !vernac_exts let extend_vernac_command_grammar s gl = vernac_exts := (s,gl) :: !vernac_exts; let univ = get_univ "vernac" in - let make_act loc l = Vernacexpr.VernacExtend (s,List.map snd l) in - let rules = List.map (make_rule univ make_act make_prod_item) gl in + let mkact loc l = VernacExtend (s,List.map snd l) in + let rules = List.map (make_rule univ mkact make_prod_item) gl in Gram.extend Vernac_.command None [(None, None, List.rev rules)] -let rec interp_entry_name u s = +(**********************************************************************) +(** Grammar declaration for Tactic Notation (Coq level) *) + +(* Interpretation of the grammar entry names *) + +let find_index s t = + let t,n = repr_ident (id_of_string t) in + if s <> t or n = None then raise Not_found; + out_some n + +let rec interp_entry_name up_level u s = let l = String.length s in if l > 8 & String.sub s 0 3 = "ne_" & String.sub s (l-5) 5 = "_list" then - let t, g = interp_entry_name u (String.sub s 3 (l-8)) in + let t, g = interp_entry_name up_level u (String.sub s 3 (l-8)) in List1ArgType t, Gramext.Slist1 g else if l > 5 & String.sub s (l-5) 5 = "_list" then - let t, g = interp_entry_name u (String.sub s 0 (l-5)) in + let t, g = interp_entry_name up_level u (String.sub s 0 (l-5)) in List0ArgType t, Gramext.Slist0 g else if l > 4 & String.sub s (l-4) 4 = "_opt" then - let t, g = interp_entry_name u (String.sub s 0 (l-4)) in + let t, g = interp_entry_name up_level u (String.sub s 0 (l-4)) in OptArgType t, Gramext.Sopt g else + try + let i = find_index "tactic" s in + TacticArgType i, + if i=up_level then Gramext.Sself else + if i=up_level-1 then Gramext.Snext else + Gramext.Snterml(Pcoq.Gram.Entry.obj Tactic.tactic_expr,string_of_int i) + with Not_found -> let e = - if !Options.v7 then get_entry (get_univ u) s - else (* Qualified entries are no longer in use *) try get_entry (get_univ "tactic") s with _ -> @@ -396,31 +228,61 @@ let rec interp_entry_name u s = let t = type_of_typed_entry e in t,Gramext.Snterm (Pcoq.Gram.Entry.obj o) -let qualified_nterm current_univ = function - | NtQual (univ, en) -> if !Options.v7 then (univ, en) else assert false - | NtShort en -> (current_univ, en) - -let make_vprod_item univ = function - | VTerm s -> (Gramext.Stoken (Extend.terminal s), None) +let make_vprod_item n univ = function + | VTerm s -> (Gramext.Stoken (Lexer.terminal s), None) | VNonTerm (loc, nt, po) -> - let (u,nt) = qualified_nterm univ nt in - let (etyp, e) = interp_entry_name u nt in + let (etyp, e) = interp_entry_name n univ nt in e, option_app (fun p -> (p,etyp)) po -let add_tactic_entries gl = +let get_tactic_entry n = + if n = 0 then + weaken_entry Tactic.simple_tactic, None + else if 1<=n && n<=5 then + weaken_entry Tactic.tactic_expr, Some (Gramext.Level (string_of_int n)) + else + error ("Invalid Tactic Notation level: "^(string_of_int n)) + +(* Declaration of the tactic grammar rule *) + +let head_is_ident = function VTerm _::_ -> true | _ -> false + +let add_tactic_entry (key,lev,prods,tac) = let univ = get_univ "tactic" in - let make_act s tac loc l = Tacexpr.TacAlias (loc,s,l,tac) in - let f (s,l,tac) = - make_rule univ (make_act s tac) (make_vprod_item "tactic") l in - let rules = List.map f gl in + let entry, pos = get_tactic_entry lev in + let mkprod = make_vprod_item lev "tactic" in + let rules = + if lev = 0 then begin + if not (head_is_ident prods) then + error "Notation for simple tactic must start with an identifier"; + let mkact s tac loc l = + (TacAlias(loc,s,l,tac):raw_atomic_tactic_expr) in + make_rule univ (mkact key tac) mkprod prods + end + else + let mkact s tac loc l = + (TacAtom(loc,TacAlias(loc,s,l,tac)):raw_tactic_expr) in + make_rule univ (mkact key tac) mkprod prods in let _ = find_position true true None None (* to synchronise with remove *) in - grammar_extend Tactic.simple_tactic None [(None, None, List.rev rules)] + grammar_extend entry pos [(None, None, List.rev [rules])] + +(**********************************************************************) +(** State of the grammar extensions *) + +type notation_grammar = + int * Gramext.g_assoc option * notation * prod_item list + +type all_grammar_command = + | Notation of Notation.level * notation_grammar + | TacticGrammar of + (string * int * grammar_production list * + (Names.dir_path * Tacexpr.glob_tactic_expr)) + +let (grammar_state : all_grammar_command list ref) = ref [] let extend_grammar gram = (match gram with | Notation (_,a) -> extend_constr_notation a - | Grammar g -> extend_grammar_rules g - | TacticGrammar (l,_) -> add_tactic_entries l); + | TacticGrammar g -> add_tactic_entry g); grammar_state := gram :: !grammar_state let reset_extend_grammars_v8 () = @@ -428,12 +290,12 @@ let reset_extend_grammars_v8 () = let tv = List.rev !vernac_exts in tac_exts := []; vernac_exts := []; - List.iter (fun (s,gl) -> extend_tactic_grammar s gl) te; + List.iter (fun (s,gl) -> print_string ("Resinstalling "^s); flush stdout; extend_tactic_grammar s gl) te; List.iter (fun (s,gl) -> extend_vernac_command_grammar s gl) tv let recover_notation_grammar ntn prec = let l = map_succeed (function - | Notation (prec',(_,_,ntn',_,_ as x)) when prec = prec' & ntn = ntn' -> x + | Notation (prec',(_,_,ntn',_ as x)) when prec = prec' & ntn = ntn' -> x | _ -> failwith "") !grammar_state in assert (List.length l = 1); List.hd l @@ -453,11 +315,7 @@ let factorize_grams l1 l2 = let number_of_entries gcl = List.fold_left (fun n -> function - | Notation _ -> - if !Options.v7 then n + 1 - else n + 2 (* 1 for operconstr, 1 for pattern *) - | Grammar gc -> - n + (List.length gc.gc_entries) + | Notation _ -> n + 2 (* 1 for operconstr, 1 for pattern *) | TacticGrammar _ -> n + 1) 0 gcl -- cgit v1.2.3