X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_parser%2FgrafiteParser.ml;h=51c7d07b267b8bb33d1b9432612a728ffe7c032d;hb=9b09890767aaa93e512324f8e7f13e2cdeebac88;hp=20aad1cd3a19c16788264e634cb95028cca31c89;hpb=63ed9d3148199584ae8b238f018e0f9883768ada;p=helm.git

diff --git a/helm/software/components/grafite_parser/grafiteParser.ml b/helm/software/components/grafite_parser/grafiteParser.ml
index 20aad1cd3..51c7d07b2 100644
--- a/helm/software/components/grafite_parser/grafiteParser.ml
+++ b/helm/software/components/grafite_parser/grafiteParser.ml
@@ -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,10 +102,16 @@ 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) ] ];
-  tactic_term: [ [ t = term LEVEL "90N" -> t ] ];
+  tactic_term: [ [ t = term LEVEL "90" -> t ] ];
   new_name: [
     [ id = IDENT -> Some id
     | SYMBOL "_" -> None ]
@@ -167,8 +183,12 @@ EXTEND
   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 ->
+        GrafiteAst.ApplyP (loc, t)
     | IDENT "applyS"; t = tactic_term ; params = auto_params ->
         GrafiteAst.ApplyS (loc, t, params)
     | IDENT "assumption" ->
@@ -450,8 +470,15 @@ EXTEND
     | [ IDENT "theorem"     ] -> `Theorem
     ]
   ];
+  inline_flavour: [
+     [ attr = theorem_flavour -> attr
+     | [ IDENT "axiom"     ]  -> `Axiom
+     | [ IDENT "mutual"    ]  -> `MutualDefinition
+     ]
+  ];
   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";
@@ -473,7 +500,8 @@ EXTEND
   ] ];
   
   record_spec: [ [
-    name = IDENT; params = LIST0 CicNotationParser.protected_binder_vars ;
+    name = IDENT; 
+    params = LIST0 protected_binder_vars;
      SYMBOL ":"; typ = term; SYMBOL <:unicode<def>>; SYMBOL "{" ; 
      fields = LIST0 [ 
        name = IDENT ; 
@@ -498,15 +526,18 @@ EXTEND
   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 ->
+        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)
+         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 ->
@@ -528,7 +559,8 @@ EXTEND
       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 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
@@ -593,7 +625,7 @@ EXTEND
           in
           let p1 =
             add_raw_attribute ~text:s
-              (CicNotationParser.parse_level1_pattern
+              (CicNotationParser.parse_level1_pattern prec
                 (Ulexing.from_utf8_string s))
           in
           (dir, p1, assoc, prec, p2)
@@ -643,9 +675,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
@@ -657,13 +689,15 @@ EXTEND
             ind_types
         in
         GrafiteAst.Obj (loc, Ast.Inductive (params, ind_types))
-    | IDENT "coercion" ; suri = URI ; arity = OPT int ; 
-      saturations = OPT int; composites = OPT (IDENT "nocomposites") ->
+    | IDENT "coercion" ; 
+      t = [ u = URI -> Ast.Uri (u,None) | t = tactic_term ; OPT "with" -> t ] ;
+      arity = OPT int ; saturations = OPT int; 
+      composites = OPT (IDENT "nocomposites") ->
         let arity = match arity with None -> 0 | Some x -> x in
         let saturations = match saturations with None -> 0 | Some x -> x in
         let composites = match composites with None -> true | Some _ -> false in
         GrafiteAst.Coercion
-         (loc, UriManager.uri_of_string suri, composites, arity, saturations)
+         (loc, t, composites, arity, saturations)
     | IDENT "record" ; (params,name,ty,fields) = record_spec ->
         GrafiteAst.Obj (loc, Ast.Record (params,name,ty,fields))
     | IDENT "default" ; what = QSTRING ; uris = LIST1 URI ->
@@ -734,6 +768,10 @@ EXTEND
     ]
   ];
 END
+(* }}} *)
+;;
+
+let _ = initialize_parser () ;;
 
 let exc_located_wrapper f =
   try
@@ -751,5 +789,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: *)
+