]> matita.cs.unibo.it Git - helm.git/blobdiff - matita/components/grafite_parser/grafiteParser.ml
New syntax -H1 .. Hn for clear
[helm.git] / matita / components / grafite_parser / grafiteParser.ml
index 29d52c01f2753ec1dda2cd4ed14e324b335855fb..5873d29c7a1ddbfeb2ccc45599c2e376772cf132 100644 (file)
 
 module N  = NotationPt
 module G  = GrafiteAst
-module L  = LexiconAst
-module LE = LexiconEngine
-
-exception NoInclusionPerformed of string (* full path *)
-
-type 'a localized_option =
-   LSome of 'a
- | LNone of G.loc
-
-type ast_statement = G.statement
 
 let exc_located_wrapper f =
   try
@@ -228,8 +218,11 @@ EXTEND
         G.NTactic(loc,[G.NCases (loc, what, where)])
     | IDENT "change"; what = pattern_spec; "with"; with_what = tactic_term -> 
         G.NTactic(loc,[G.NChange (loc, what, with_what)])
-    | SYMBOL "@"; num = OPT NUMBER; l = LIST0 tactic_term -> 
-        G.NTactic(loc,[G.NConstructor (loc, (match num with None -> None | Some x -> Some (int_of_string x)),l)])
+    | SYMBOL "-"; ids = LIST1 IDENT ->
+        G.NTactic(loc,[G.NClear (loc, ids)])
+    | (*SYMBOL "^"*)PLACEHOLDER; num = OPT NUMBER; 
+       l = OPT [ SYMBOL "{"; l = LIST1 tactic_term; SYMBOL "}" -> l ] -> 
+        G.NTactic(loc,[G.NConstructor (loc, (match num with None -> None | Some x -> Some (int_of_string x)),match l with None -> [] | Some l -> l)])
     | IDENT "cut"; t = tactic_term -> G.NTactic(loc,[G.NCut (loc, t)])
 (*  | IDENT "discriminate"; t = tactic_term -> G.NDiscriminate (loc, t)
     | IDENT "subst"; t = tactic_term -> G.NSubst (loc, t) *)
@@ -440,7 +433,7 @@ EXTEND
           if (try ignore (NReference.reference_of_string uri); true
               with NReference.IllFormedReference _ -> false)
           then
-            L.Ident_alias (id, uri)
+            G.Ident_alias (id, uri)
           else
             raise
              (HExtlib.Localized (loc, CicNotationParser.Parse_error (Printf.sprintf "Not a valid uri: %s" uri)))
@@ -453,14 +446,14 @@ EXTEND
           let instance =
             match instance with Some i -> i | None -> 0
           in
-          L.Symbol_alias (symbol, instance, dsc)
+          G.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
-          L.Number_alias (instance, dsc)
+          G.Number_alias (instance, dsc)
       ]
      ];
     argument: [
@@ -524,11 +517,9 @@ EXTEND
     
     include_command: [ [
         IDENT "include" ; path = QSTRING -> 
-          loc,path,true,L.WithPreferences
-      | IDENT "include" ; IDENT "source" ; path = QSTRING -> 
-          loc,path,false,L.WithPreferences       
+          loc,path,G.WithPreferences
       | IDENT "include'" ; path = QSTRING -> 
-          loc,path,true,L.WithoutPreferences
+          loc,path,G.WithoutPreferences
      ]];
 
   grafite_ncommand: [ [
@@ -546,9 +537,9 @@ EXTEND
       paramspec = OPT inverter_param_list ; 
       outsort = OPT [ SYMBOL ":" ; outsort = term -> outsort ] -> 
         G.NInverter (loc,name,indty,paramspec,outsort)
-    | NLETCOREC ; defs = let_defs -> 
+    | LETCOREC ; defs = let_defs -> 
         nmk_rec_corec `CoInductive defs loc
-    | NLETREC ; defs = let_defs -> 
+    | LETREC ; defs = let_defs -> 
         nmk_rec_corec `Inductive defs loc
     | IDENT "inductive"; spec = inductive_spec ->
         let (params, ind_types) = spec in
@@ -583,16 +574,17 @@ EXTEND
       m = LIST0 [ u1 = URI; SYMBOL <:unicode<mapsto>>; u2 = URI -> u1,u2 ] ->
         G.NCopy (loc,s,NUri.uri_of_string u,
           List.map (fun a,b -> NUri.uri_of_string a, NUri.uri_of_string b) m)
+    | lc = lexicon_command -> lc
   ]];
 
   lexicon_command: [ [
       IDENT "alias" ; spec = alias_spec ->
-        L.Alias (loc, spec)
+        G.Alias (loc, spec)
     | IDENT "notation"; (dir, l1, assoc, prec, l2) = notation ->
-        L.Notation (loc, dir, l1, assoc, prec, l2)
+        G.Notation (loc, dir, l1, assoc, prec, l2)
     | IDENT "interpretation"; id = QSTRING;
       (symbol, args, l3) = interpretation ->
-        L.Interpretation (loc, id, (symbol, args), l3)
+        G.Interpretation (loc, id, (symbol, args), l3)
   ]];
   executable: [
     [ ncmd = grafite_ncommand; SYMBOL "." -> G.NCommand (loc, ncmd)
@@ -616,20 +608,10 @@ EXTEND
     ]
   ];
   statement: [
-    [ ex = executable ->
-          LSome (G.Executable (loc, ex))
-    | com = comment ->
-          LSome (G.Comment (loc, com))
-    | (iloc,fname,normal,mode) = include_command ; SYMBOL "."  ->
-         LSome (G.Executable 
-            (loc,G.Command (loc,G.Include (iloc,fname,(),""))))
-    | scom = lexicon_command ; SYMBOL "." ->
-                    assert false
-(*
-       fun ?(never_include=false) ~include_paths status ->
-         let status = LE.eval_command status scom in
-          status, LNone loc
-*)
+    [ ex = executable -> G.Executable (loc, ex)
+    | com = comment -> G.Comment (loc, com)
+    | (iloc,fname,mode) = include_command ; SYMBOL "."  ->
+              G.Executable (loc,G.NCommand (loc,G.Include (iloc,mode,fname)))
     | EOI -> raise End_of_file
     ]
   ];
@@ -638,28 +620,36 @@ EXTEND
   statement
 ;;
 
-type db = ast_statement localized_option Grammar.Entry.e ;;
+type db = GrafiteAst.statement Grammar.Entry.e ;;
 
 class type g_status =
  object
-  inherit LexiconEngine.g_status
+  inherit CicNotationParser.g_status
   method parser_db: db
  end
 
 class status =
-  let lstatus = assert false in
-  let grammar = CicNotationParser.level2_ast_grammar lstatus in
- object
-  inherit LexiconEngine.status
-  val db = 
-   mk_parser (Grammar.Entry.create grammar "statement") lstatus  
-  method parser_db = db
-  method set_parser_db v = {< db = v >}
+ object(self)
+  inherit CicNotationParser.status ~keywords:[]
+  val mutable db = None
+  method parser_db = match db with None -> assert false | Some x -> x
+  method set_parser_db v = {< db = Some v >}
   method set_parser_status
    : 'status. #g_status as 'status -> 'self
-   = fun o -> {< db = o#parser_db >}#set_lexicon_engine_status o
+   = fun o -> {< db = Some o#parser_db >}#set_notation_parser_status o
+  initializer
+   let grammar = CicNotationParser.level2_ast_grammar self in
+   db <- Some (mk_parser (Grammar.Entry.create grammar "statement") self)
  end
 
+let extend status l1 action = 
+  let status = CicNotationParser.extend status l1 action in
+  let grammar = CicNotationParser.level2_ast_grammar status in
+  status#set_parser_db
+    (mk_parser (Grammar.Entry.create grammar "statement") status)
+;;
+
+
 let parse_statement status = 
   parse_statement status#parser_db