]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/components/grafite_parser/grafiteParser.ml
Quick&dirty implementation of neqd:
[helm.git] / helm / software / components / grafite_parser / grafiteParser.ml
index 38a8667d304ae511da33b6abf47971f178922726..be6dab1a61085b8b84c0ec9d77d490f779944c95 100644 (file)
@@ -48,10 +48,20 @@ type statement =
   LexiconEngine.status ->
     LexiconEngine.status * ast_statement localized_option
 
-let grammar = CicNotationParser.level2_ast_grammar
+type parser_status = {
+  grammar : Grammar.g;
+  term : CicNotationPt.term Grammar.Entry.e;
+  statement : statement Grammar.Entry.e;
+}
 
-let term = CicNotationParser.term
-let statement = Grammar.Entry.create grammar "statement"
+let initial_parser () = 
+  let grammar = CicNotationParser.level2_ast_grammar () in
+  let term = CicNotationParser.term () in
+  let statement = Grammar.Entry.create grammar "statement" in
+  { grammar = grammar; term = term; statement = statement }
+;;
+
+let grafite_parser = ref (initial_parser ())
 
 let add_raw_attribute ~text t = Ast.AttributedTerm (`Raw text, t)
 
@@ -92,6 +102,12 @@ type by_continuation =
  | BYC_letsuchthat of string * CicNotationPt.term * string * CicNotationPt.term
  | BYC_wehaveand of string * CicNotationPt.term * string * CicNotationPt.term
 
+let initialize_parser () =
+  (* {{{ parser initialization *)
+  let term = !grafite_parser.term in
+  let statement = !grafite_parser.statement in
+  let let_defs = CicNotationParser.let_defs () in
+  let protected_binder_vars = CicNotationParser.protected_binder_vars () in
 EXTEND
   GLOBAL: term statement;
   constructor: [ [ name = IDENT; SYMBOL ":"; typ = term -> (name, typ) ] ];
@@ -146,6 +162,20 @@ EXTEND
          None -> None,[],Some Ast.UserInput
        | Some ps -> ps]
   ];
+  inverter_param_list: [ 
+    [ params = tactic_term -> 
+      let deannotate = function
+        | Ast.AttributedTerm (_,t) | t -> t
+      in match deannotate params with
+      | Ast.Implicit -> [false]
+      | Ast.UserInput -> [true]
+      | Ast.Appl l -> 
+         List.map (fun x -> match deannotate x with  
+           | Ast.Implicit -> false
+           | Ast.UserInput -> true
+           | _ -> raise (Invalid_argument "malformed target parameter list 1")) l
+      | _ -> raise (Invalid_argument ("malformed target parameter list 2\n" ^ CicNotationPp.pp_term params)) ]
+  ];
   direction: [
     [ SYMBOL ">" -> `LeftToRight
     | SYMBOL "<" -> `RightToLeft ]
@@ -164,9 +194,47 @@ EXTEND
     ]
   ];
   using: [ [ using = OPT [ IDENT "using"; t = tactic_term -> t ] -> using ] ];
+  ntactic: [
+    [ IDENT "napply"; t = tactic_term -> GrafiteAst.NApply (loc, t)
+    | IDENT "nassert";
+       seqs = LIST0 [
+        hyps = LIST0
+         [ id = IDENT ; SYMBOL ":" ; ty = tactic_term -> id,`Decl ty
+         | id = IDENT ; SYMBOL ":" ; ty = tactic_term ;
+                        SYMBOL <:unicode<def>> ; bo = tactic_term ->
+            id,`Def (bo,ty)];
+        SYMBOL <:unicode<vdash>>;
+        concl = tactic_term -> (List.rev hyps,concl) ] ->
+         GrafiteAst.NAssert (loc, seqs)
+    | IDENT "ncases"; what = tactic_term ; where = pattern_spec ->
+        GrafiteAst.NCases (loc, what, where)
+    | IDENT "nchange"; what = pattern_spec; "with"; with_what = tactic_term -> 
+        GrafiteAst.NChange (loc, what, with_what)
+    | IDENT "nelim"; what = tactic_term ; where = pattern_spec ->
+        GrafiteAst.NElim (loc, what, where)
+    | IDENT "ngeneralize"; p=pattern_spec ->
+        GrafiteAst.NGeneralize (loc, p)
+    | IDENT "nletin"; name = IDENT ; SYMBOL <:unicode<def>> ; t = tactic_term;
+        where = pattern_spec ->
+        GrafiteAst.NLetIn (loc,where,t,name)
+    | IDENT "nrewrite"; dir = direction; what = tactic_term ; where = pattern_spec ->
+        GrafiteAst.NRewrite (loc, dir, what, where)
+    | IDENT "nwhd"; delta = OPT [ IDENT "nodelta" -> () ];
+      where = pattern_spec ->
+        let delta = match delta with None -> true | _ -> false in
+        GrafiteAst.NEval (loc, where, `Whd delta)
+    | SYMBOL "#"; n=IDENT -> GrafiteAst.NIntro (loc,n)
+    | SYMBOL "#"; SYMBOL "_" -> GrafiteAst.NIntro (loc,"_")
+    | SYMBOL "*" -> GrafiteAst.NCase1 (loc,"_")
+    | SYMBOL "*"; n=IDENT ->
+        GrafiteAst.NCase1 (loc,n)
+    ]
+  ];
   tactic: [
     [ IDENT "absurd"; t = tactic_term ->
         GrafiteAst.Absurd (loc, t)
+    | IDENT "apply"; IDENT "rule"; t = tactic_term ->
+        GrafiteAst.ApplyRule (loc, t)
     | IDENT "apply"; t = tactic_term ->
         GrafiteAst.Apply (loc, t)
     | IDENT "applyP"; t = tactic_term ->
@@ -209,12 +277,12 @@ EXTEND
         GrafiteAst.Destruct (loc, xts)
     | IDENT "elim"; what = tactic_term; using = using; 
        pattern = OPT pattern_spec;
-       (num, idents) = intros_spec ->
+       ispecs = intros_spec ->
         let pattern = match pattern with
            | None         -> None, [], Some Ast.UserInput
            | Some pattern -> pattern   
-        in
-        GrafiteAst.Elim (loc, what, using, pattern, (num, idents))
+          in
+          GrafiteAst.Elim (loc, what, using, pattern, ispecs)
     | IDENT "elimType"; what = tactic_term; using = using;
       (num, idents) = intros_spec ->
         GrafiteAst.ElimType (loc, what, using, (num, idents))
@@ -229,7 +297,7 @@ EXTEND
             raise (HExtlib.Localized (loc, CicNotationParser.Parse_error
               ("the pattern cannot specify the term to replace, only its"
               ^ " paths in the hypotheses and in the conclusion")))
-        else
+       else
          GrafiteAst.Fold (loc, kind, t, p)
     | IDENT "fourier" ->
         GrafiteAst.Fourier loc
@@ -363,6 +431,8 @@ EXTEND
    | IDENT "timeout"
    | IDENT "library"
    | IDENT "type"
+   | IDENT "steps"
+   | IDENT "all"
    ]
 ];
   auto_params: [
@@ -424,8 +494,8 @@ EXTEND
       | IDENT "progress"; tac = SELF -> GrafiteAst.Progress (loc, tac)
       | LPAREN; tac = SELF; RPAREN -> tac
       | tac = tactic -> tac
-      ]
-    ];
+        ]
+      ];
   punctuation_tactical:
     [
       [ SYMBOL "[" -> GrafiteAst.Branch loc
@@ -443,7 +513,11 @@ EXTEND
       | IDENT "unfocus" -> GrafiteAst.Unfocus loc
       | IDENT "skip" -> GrafiteAst.Skip loc
       ]
-    ];
+      ];
+  ntheorem_flavour: [
+    [ [ IDENT "ntheorem"     ] -> `Theorem
+    ]
+  ];
   theorem_flavour: [
     [ [ IDENT "definition"  ] -> `Definition
     | [ IDENT "fact"        ] -> `Fact
@@ -459,178 +533,183 @@ EXTEND
      ]
   ];
   inductive_spec: [ [
-    fst_name = IDENT; params = LIST0 CicNotationParser.protected_binder_vars;
+    fst_name = IDENT; 
+      params = LIST0 protected_binder_vars;
     SYMBOL ":"; fst_typ = term; SYMBOL <:unicode<def>>; OPT SYMBOL "|";
     fst_constructors = LIST0 constructor SEP SYMBOL "|";
     tl = OPT [ "with";
-      types = LIST1 [
-        name = IDENT; SYMBOL ":"; typ = term; SYMBOL <:unicode<def>>;
-       OPT SYMBOL "|"; constructors = LIST0 constructor SEP SYMBOL "|" ->
-          (name, true, typ, constructors) ] SEP "with" -> types
-    ] ->
-      let params =
-        List.fold_right
-          (fun (names, typ) acc ->
-            (List.map (fun name -> (name, typ)) names) @ acc)
-          params []
-      in
-      let fst_ind_type = (fst_name, true, fst_typ, fst_constructors) in
-      let tl_ind_types = match tl with None -> [] | Some types -> types in
-      let ind_types = fst_ind_type :: tl_ind_types in
-      (params, ind_types)
-  ] ];
-  
-  record_spec: [ [
-    name = IDENT; params = LIST0 CicNotationParser.protected_binder_vars ;
-     SYMBOL ":"; typ = term; SYMBOL <:unicode<def>>; SYMBOL "{" ; 
-     fields = LIST0 [ 
-       name = IDENT ; 
-       coercion = [ 
-           SYMBOL ":" -> false,0 
-         | SYMBOL ":"; SYMBOL ">" -> true,0
-         | SYMBOL ":"; arity = int ; SYMBOL ">" -> true,arity
-       ]; 
-       ty = term -> 
-         let b,n = coercion in 
-         (name,ty,b,n) 
-     ] SEP SYMBOL ";"; SYMBOL "}" -> 
-      let params =
-        List.fold_right
-          (fun (names, typ) acc ->
-            (List.map (fun name -> (name, typ)) names) @ acc)
-          params []
-      in
-      (params,name,typ,fields)
-  ] ];
-  
-  macro: [
-    [ [ IDENT "check"   ]; t = term ->
-        GrafiteAst.Check (loc, t)
-    | [ IDENT "inline"]; 
-        style = OPT [ IDENT "procedural"; depth = OPT int -> depth ];
-        suri = QSTRING; prefix = OPT QSTRING;
-       flavour = OPT [ IDENT "as"; attr = inline_flavour -> attr ]->
-         let style = match style with 
-            | None       -> GrafiteAst.Declarative
-            | Some depth -> GrafiteAst.Procedural depth
-         in
-         let prefix = match prefix with None -> "" | Some prefix -> prefix in
-         GrafiteAst.Inline (loc,style,suri,prefix, flavour)
-    | [ IDENT "hint" ]; rew = OPT (IDENT "rewrite")  -> 
-         if rew = None then GrafiteAst.Hint (loc, false) else GrafiteAst.Hint (loc,true)
-    | IDENT "auto"; params = auto_params ->
-        GrafiteAst.AutoInteractive (loc,params)
-    | [ IDENT "whelp"; "match" ] ; t = term -> 
-        GrafiteAst.WMatch (loc,t)
-    | [ IDENT "whelp"; IDENT "instance" ] ; t = term -> 
-        GrafiteAst.WInstance (loc,t)
-    | [ IDENT "whelp"; IDENT "locate" ] ; id = QSTRING -> 
-        GrafiteAst.WLocate (loc,id)
-    | [ IDENT "whelp"; IDENT "elim" ] ; t = term ->
-        GrafiteAst.WElim (loc, t)
-    | [ IDENT "whelp"; IDENT "hint" ] ; t = term -> 
-        GrafiteAst.WHint (loc,t)
-    ]
-  ];
-  alias_spec: [
-    [ IDENT "id"; id = QSTRING; SYMBOL "="; uri = QSTRING ->
-      let alpha = "[a-zA-Z]" in
-      let num = "[0-9]+" in
-      let ident_cont = "\\("^alpha^"\\|"^num^"\\|_\\|\\\\\\)" in
-      let ident = "\\("^alpha^ident_cont^"*\\|_"^ident_cont^"+\\)" in
-      let rex = Str.regexp ("^"^ident^"$") in
-      if Str.string_match rex id 0 then
-        if (try ignore (UriManager.uri_of_string uri); true
-            with UriManager.IllFormedUri _ -> false)
-        then
-          LexiconAst.Ident_alias (id, uri)
-        else 
-          raise
-           (HExtlib.Localized (loc, CicNotationParser.Parse_error (Printf.sprintf "Not a valid uri: %s" uri)))
-      else
-        raise (HExtlib.Localized (loc, CicNotationParser.Parse_error (
-          Printf.sprintf "Not a valid identifier: %s" id)))
-    | IDENT "symbol"; symbol = QSTRING;
-      instance = OPT [ LPAREN; IDENT "instance"; n = int; RPAREN -> n ];
-      SYMBOL "="; dsc = QSTRING ->
-        let instance =
-          match instance with Some i -> i | None -> 0
+        types = LIST1 [
+          name = IDENT; SYMBOL ":"; typ = term; SYMBOL <:unicode<def>>;
+         OPT SYMBOL "|"; constructors = LIST0 constructor SEP SYMBOL "|" ->
+            (name, true, typ, constructors) ] SEP "with" -> types
+      ] ->
+        let params =
+          List.fold_right
+            (fun (names, typ) acc ->
+              (List.map (fun name -> (name, typ)) names) @ acc)
+            params []
         in
-        LexiconAst.Symbol_alias (symbol, instance, dsc)
-    | IDENT "num";
-      instance = OPT [ LPAREN; IDENT "instance"; n = int; RPAREN -> n ];
-      SYMBOL "="; dsc = QSTRING ->
-        let instance =
-          match instance with Some i -> i | None -> 0
+        let fst_ind_type = (fst_name, true, fst_typ, fst_constructors) in
+        let tl_ind_types = match tl with None -> [] | Some types -> types in
+        let ind_types = fst_ind_type :: tl_ind_types in
+        (params, ind_types)
+    ] ];
+    
+    record_spec: [ [
+      name = IDENT; 
+      params = LIST0 protected_binder_vars;
+       SYMBOL ":"; typ = term; SYMBOL <:unicode<def>>; SYMBOL "{" ; 
+       fields = LIST0 [ 
+         name = IDENT ; 
+         coercion = [ 
+             SYMBOL ":" -> false,0 
+           | SYMBOL ":"; SYMBOL ">" -> true,0
+           | SYMBOL ":"; arity = int ; SYMBOL ">" -> true,arity
+         ]; 
+         ty = term -> 
+           let b,n = coercion in 
+           (name,ty,b,n) 
+       ] SEP SYMBOL ";"; SYMBOL "}" -> 
+        let params =
+          List.fold_right
+            (fun (names, typ) acc ->
+              (List.map (fun name -> (name, typ)) names) @ acc)
+            params []
         in
-        LexiconAst.Number_alias (instance, dsc)
-    ]
-  ];
-  argument: [
-    [ l = LIST0 [ SYMBOL <:unicode<eta>> (* η *); SYMBOL "." -> () ];
-      id = IDENT ->
-        Ast.IdentArg (List.length l, id)
-    ]
-  ];
-  associativity: [
-    [ IDENT "left";  IDENT "associative" -> Gramext.LeftA
-    | IDENT "right"; IDENT "associative" -> Gramext.RightA
-    | IDENT "non"; IDENT "associative" -> Gramext.NonA
-    ]
-  ];
-  precedence: [
-    [ "with"; IDENT "precedence"; n = NUMBER -> int_of_string n ]
-  ];
-  notation: [
-    [ dir = OPT direction; s = QSTRING;
-      assoc = OPT associativity; prec = precedence;
-      IDENT "for";
-      p2 = 
-        [ blob = UNPARSED_AST ->
-            add_raw_attribute ~text:(Printf.sprintf "@{%s}" blob)
-              (CicNotationParser.parse_level2_ast
-                (Ulexing.from_utf8_string blob))
-        | blob = UNPARSED_META ->
-            add_raw_attribute ~text:(Printf.sprintf "${%s}" blob)
-              (CicNotationParser.parse_level2_meta
-                (Ulexing.from_utf8_string blob))
-        ] ->
-          let assoc =
-            match assoc with
-            | None -> default_associativity
-            | Some assoc -> assoc
+        (params,name,typ,fields)
+    ] ];
+    
+    macro: [
+      [ [ IDENT "check"   ]; t = term ->
+          GrafiteAst.Check (loc, t)
+      | [ IDENT "eval" ]; kind = reduction_kind; "on"; t = tactic_term ->
+          GrafiteAst.Eval (loc, kind, t)
+      | [ IDENT "inline"]; 
+          style = OPT [ IDENT "procedural"; depth = OPT int -> depth ];
+          suri = QSTRING; prefix = OPT QSTRING;
+          flavour = OPT [ "as"; attr = inline_flavour -> attr ] ->
+           let style = match style with 
+              | None       -> GrafiteAst.Declarative
+              | Some depth -> GrafiteAst.Procedural depth
+           in
+           let prefix = match prefix with None -> "" | Some prefix -> prefix in
+           GrafiteAst.Inline (loc,style,suri,prefix, flavour)
+      | [ IDENT "hint" ]; rew = OPT (IDENT "rewrite")  -> 
+           if rew = None then GrafiteAst.Hint (loc, false) else GrafiteAst.Hint (loc,true)
+      | IDENT "auto"; params = auto_params ->
+          GrafiteAst.AutoInteractive (loc,params)
+      | [ IDENT "whelp"; "match" ] ; t = term -> 
+          GrafiteAst.WMatch (loc,t)
+      | [ IDENT "whelp"; IDENT "instance" ] ; t = term -> 
+          GrafiteAst.WInstance (loc,t)
+      | [ IDENT "whelp"; IDENT "locate" ] ; id = QSTRING -> 
+          GrafiteAst.WLocate (loc,id)
+      | [ IDENT "whelp"; IDENT "elim" ] ; t = term ->
+          GrafiteAst.WElim (loc, t)
+      | [ IDENT "whelp"; IDENT "hint" ] ; t = term -> 
+          GrafiteAst.WHint (loc,t)
+      ]
+    ];
+    alias_spec: [
+      [ IDENT "id"; id = QSTRING; SYMBOL "="; uri = QSTRING ->
+        let alpha = "[a-zA-Z]" in
+        let num = "[0-9]+" in
+        let ident_cont = "\\("^alpha^"\\|"^num^"\\|_\\|\\\\\\)" in
+        let decoration = "\\'" in
+        let ident = "\\("^alpha^ident_cont^"*"^decoration^"*\\|_"^ident_cont^"+"^decoration^"*\\)" in
+        let rex = Str.regexp ("^"^ident^"$") in
+        if Str.string_match rex id 0 then
+          if (try ignore (UriManager.uri_of_string uri); true
+              with UriManager.IllFormedUri _ -> false)
+          then
+            LexiconAst.Ident_alias (id, uri)
+          else 
+            raise
+             (HExtlib.Localized (loc, CicNotationParser.Parse_error (Printf.sprintf "Not a valid uri: %s" uri)))
+        else
+          raise (HExtlib.Localized (loc, CicNotationParser.Parse_error (
+            Printf.sprintf "Not a valid identifier: %s" id)))
+      | IDENT "symbol"; symbol = QSTRING;
+        instance = OPT [ LPAREN; IDENT "instance"; n = int; RPAREN -> n ];
+        SYMBOL "="; dsc = QSTRING ->
+          let instance =
+            match instance with Some i -> i | None -> 0
           in
-          let p1 =
-            add_raw_attribute ~text:s
-              (CicNotationParser.parse_level1_pattern prec
-                (Ulexing.from_utf8_string s))
+          LexiconAst.Symbol_alias (symbol, instance, dsc)
+      | IDENT "num";
+        instance = OPT [ LPAREN; IDENT "instance"; n = int; RPAREN -> n ];
+        SYMBOL "="; dsc = QSTRING ->
+          let instance =
+            match instance with Some i -> i | None -> 0
           in
-          (dir, p1, assoc, prec, p2)
-    ]
-  ];
-  level3_term: [
-    [ u = URI -> Ast.UriPattern (UriManager.uri_of_string u)
-    | id = IDENT -> Ast.VarPattern id
-    | SYMBOL "_" -> Ast.ImplicitPattern
-    | LPAREN; terms = LIST1 SELF; RPAREN ->
-        (match terms with
-        | [] -> assert false
-        | [term] -> term
-        | terms -> Ast.ApplPattern terms)
-    ]
-  ];
-  interpretation: [
-    [ s = CSYMBOL; args = LIST0 argument; SYMBOL "="; t = level3_term ->
-        (s, args, t)
-    ]
-  ];
-  
-  include_command: [ [
-      IDENT "include" ; path = QSTRING -> 
-        loc,path,LexiconAst.WithPreferences
-    | IDENT "include'" ; path = QSTRING -> 
-        loc,path,LexiconAst.WithoutPreferences
-   ]];
+          LexiconAst.Number_alias (instance, dsc)
+      ]
+    ];
+    argument: [
+      [ l = LIST0 [ SYMBOL <:unicode<eta>> (* η *); SYMBOL "." -> () ];
+        id = IDENT ->
+          Ast.IdentArg (List.length l, id)
+      ]
+    ];
+    associativity: [
+      [ IDENT "left";  IDENT "associative" -> Gramext.LeftA
+      | IDENT "right"; IDENT "associative" -> Gramext.RightA
+      | IDENT "non"; IDENT "associative" -> Gramext.NonA
+      ]
+    ];
+    precedence: [
+      [ "with"; IDENT "precedence"; n = NUMBER -> int_of_string n ]
+    ];
+    notation: [
+      [ dir = OPT direction; s = QSTRING;
+        assoc = OPT associativity; prec = precedence;
+        IDENT "for";
+        p2 = 
+          [ blob = UNPARSED_AST ->
+              add_raw_attribute ~text:(Printf.sprintf "@{%s}" blob)
+                (CicNotationParser.parse_level2_ast
+                  (Ulexing.from_utf8_string blob))
+          | blob = UNPARSED_META ->
+              add_raw_attribute ~text:(Printf.sprintf "${%s}" blob)
+                (CicNotationParser.parse_level2_meta
+                  (Ulexing.from_utf8_string blob))
+          ] ->
+            let assoc =
+              match assoc with
+              | None -> default_associativity
+              | Some assoc -> assoc
+            in
+            let p1 =
+              add_raw_attribute ~text:s
+                (CicNotationParser.parse_level1_pattern prec
+                  (Ulexing.from_utf8_string s))
+            in
+            (dir, p1, assoc, prec, p2)
+      ]
+    ];
+    level3_term: [
+      [ u = URI -> Ast.UriPattern (UriManager.uri_of_string u)
+      | id = IDENT -> Ast.VarPattern id
+      | SYMBOL "_" -> Ast.ImplicitPattern
+      | LPAREN; terms = LIST1 SELF; RPAREN ->
+          (match terms with
+          | [] -> assert false
+          | [term] -> term
+          | terms -> Ast.ApplPattern terms)
+      ]
+    ];
+    interpretation: [
+      [ s = CSYMBOL; args = LIST0 argument; SYMBOL "="; t = level3_term ->
+          (s, args, t)
+      ]
+    ];
+    
+    include_command: [ [
+        IDENT "include" ; path = QSTRING -> 
+          loc,path,LexiconAst.WithPreferences
+      | IDENT "include'" ; path = QSTRING -> 
+          loc,path,LexiconAst.WithoutPreferences
+     ]];
 
   grafite_command: [ [
       IDENT "set"; n = QSTRING; v = QSTRING ->
@@ -638,11 +717,15 @@ EXTEND
     | IDENT "drop" -> GrafiteAst.Drop loc
     | IDENT "print"; s = IDENT -> GrafiteAst.Print (loc,s)
     | IDENT "qed" -> GrafiteAst.Qed loc
+    | IDENT "nqed" -> GrafiteAst.NQed loc
     | IDENT "variant" ; name = IDENT; SYMBOL ":"; 
       typ = term; SYMBOL <:unicode<def>> ; newname = IDENT ->
         GrafiteAst.Obj (loc, 
           Ast.Theorem 
             (`Variant,name,typ,Some (Ast.Ident (newname, None))))
+    | nflavour = ntheorem_flavour; name = IDENT; SYMBOL ":"; typ = term;
+      body = OPT [ SYMBOL <:unicode<def>> (* ≝ *); body = term -> body ] ->
+        GrafiteAst.NObj (loc, Ast.Theorem (nflavour, name, typ, body))
     | flavour = theorem_flavour; name = IDENT; SYMBOL ":"; typ = term;
       body = OPT [ SYMBOL <:unicode<def>> (* ≝ *); body = term -> body ] ->
         GrafiteAst.Obj (loc, Ast.Theorem (flavour, name, typ, body))
@@ -652,9 +735,9 @@ EXTEND
           Ast.Theorem (flavour, name, Ast.Implicit, Some body))
     | IDENT "axiom"; name = IDENT; SYMBOL ":"; typ = term ->
         GrafiteAst.Obj (loc, Ast.Theorem (`Axiom, name, typ, None))
-    | LETCOREC ; defs = CicNotationParser.let_defs -> 
+    | LETCOREC ; defs = let_defs -> 
         mk_rec_corec `CoInductive defs loc
-    | LETREC ; defs = CicNotationParser.let_defs -> 
+    | LETREC ; defs = let_defs -> 
         mk_rec_corec `Inductive defs loc
     | IDENT "inductive"; spec = inductive_spec ->
         let (params, ind_types) = spec in
@@ -675,7 +758,17 @@ EXTEND
         let composites = match composites with None -> true | Some _ -> false in
         GrafiteAst.Coercion
          (loc, t, composites, arity, saturations)
-    | IDENT "record" ; (params,name,ty,fields) = record_spec ->
+    | IDENT "prefer" ; IDENT "coercion"; t = tactic_term ->
+        GrafiteAst.PreferCoercion (loc, t)
+    | IDENT "pump" ; steps = int ->
+        GrafiteAst.Pump(loc,steps)
+    | IDENT "unification"; IDENT "hint"; n = int; t = tactic_term ->
+        GrafiteAst.UnificationHint (loc, t, n)
+    | IDENT "inverter"; name = IDENT; IDENT "for";
+        indty = tactic_term; paramspec = inverter_param_list ->
+          GrafiteAst.Inverter
+            (loc, name, indty, paramspec)
+            | IDENT "record" ; (params,name,ty,fields) = record_spec ->
         GrafiteAst.Obj (loc, Ast.Record (params,name,ty,fields))
     | IDENT "default" ; what = QSTRING ; uris = LIST1 URI ->
        let uris = List.map UriManager.uri_of_string uris in
@@ -704,6 +797,10 @@ EXTEND
     | tac = atomic_tactical LEVEL "loops"; punct = punctuation_tactical ->
         GrafiteAst.Tactic (loc, Some tac, punct)
     | punct = punctuation_tactical -> GrafiteAst.Tactic (loc, None, punct)
+    | tac = ntactic; punct = punctuation_tactical ->
+        GrafiteAst.NTactic (loc, tac, punct)
+    | SYMBOL "#" ; SYMBOL "#" ; punct = punctuation_tactical ->
+        GrafiteAst.NTactic (loc, GrafiteAst.NId loc, punct)
     | tac = non_punctuation_tactical; punct = punctuation_tactical ->
         GrafiteAst.NonPunctuationTactical (loc, tac, punct)
     | mac = macro; SYMBOL "." -> GrafiteAst.Macro (loc, mac)
@@ -720,7 +817,8 @@ EXTEND
     [ ex = executable ->
        fun ?(never_include=false) ~include_paths status -> status,LSome(GrafiteAst.Executable (loc,ex))
     | com = comment ->
-       fun ?(never_include=false) ~include_paths status -> status,LSome (GrafiteAst.Comment (loc, com))
+       fun ?(never_include=false) ~include_paths status -> 
+               status,LSome (GrafiteAst.Comment (loc, com))
     | (iloc,fname,mode) = include_command ; SYMBOL "."  ->
        !out fname;       
        fun ?(never_include=false) ~include_paths status ->
@@ -745,6 +843,10 @@ EXTEND
     ]
   ];
 END
+(* }}} *)
+;;
+
+let _ = initialize_parser () ;;
 
 let exc_located_wrapper f =
   try
@@ -762,5 +864,28 @@ let exc_located_wrapper f =
 
 let parse_statement lexbuf =
   exc_located_wrapper
-    (fun () -> (Grammar.Entry.parse statement (Obj.magic lexbuf)))
+    (fun () -> (Grammar.Entry.parse !grafite_parser.statement (Obj.magic lexbuf)))
+
+let statement () = !grafite_parser.statement
+
+let history = ref [] ;;
+
+let push () =
+  LexiconSync.push ();
+  history := !grafite_parser :: !history;
+  grafite_parser := initial_parser ();
+  initialize_parser ()
+;;
+
+let pop () =
+  LexiconSync.pop ();
+  match !history with
+  | [] -> assert false
+  | gp :: tail ->
+      grafite_parser := gp;
+      history := tail
+;;
+
+(* vim:set foldmethod=marker: *)
+