removed debug prerr_endline

[helm.git] / helm / ocaml / cic_disambiguation / cicTextualParser2.ml

diff --git a/helm/ocaml/cic_disambiguation/cicTextualParser2.ml b/helm/ocaml/cic_disambiguation/cicTextualParser2.ml
index a7c7a9ae21329089fc0c3983ca8c6618a08b1a69..9f5fd193e9d170c05ef4fe9473e175c9805d251d 100644 (file)
--- a/helm/ocaml/cic_disambiguation/cicTextualParser2.ml
+++ b/helm/ocaml/cic_disambiguation/cicTextualParser2.ml
@@ -69,6 +69,7 @@ let alias_spec = Grammar.Entry.create grammar "alias_spec"
 let macro = Grammar.Entry.create grammar "macro"
 let script = Grammar.Entry.create grammar "script"
 let statement = Grammar.Entry.create grammar "statement"
+let statements = Grammar.Entry.create grammar "statements"
 
 let return_term loc term = CicAst.AttributedTerm (`Loc loc, term)
 
@@ -116,7 +117,7 @@ let mk_binder_ast binder typ vars body =
     vars body
 
 EXTEND
-  GLOBAL: term term0 statement;
+  GLOBAL: term term0 statement statements;
   int: [
     [ num = NUM ->
         try
@@ -147,20 +148,18 @@ EXTEND
     ]
   ];
   subst: [
-    [ subst = OPT [
-        SYMBOL "\\subst";  (* to avoid catching frequent "a [1]" cases *)
-        PAREN "[";
-        substs = LIST1 [
-          i = IDENT; SYMBOL <:unicode<Assign>> (* ≔ *); t = term -> (i, t)
-        ] SEP SYMBOL ";";
-        PAREN "]" ->
-          substs
-      ] -> subst
+    [ SYMBOL "\\subst";  (* to avoid catching frequent "a [1]" cases *)
+      PAREN "[";
+      substs = LIST1 [
+        i = IDENT; SYMBOL <:unicode<Assign>> (* ≔ *); t = term -> (i, t)
+      ] SEP SYMBOL ";";
+      PAREN "]" ->
+        substs
     ]
   ];
   substituted_name: [ (* a subs.name is an explicit substitution subject *)
-    [ s = IDENT; subst = subst -> CicAst.Ident (s, subst)
-    | s = URI; subst = subst -> CicAst.Uri (ind_expansion s, subst)
+    [ s = IDENT; subst = OPT subst -> CicAst.Ident (s, subst)
+    | s = URI; subst = OPT subst -> CicAst.Uri (ind_expansion s, subst)
     ]
   ];
   name: [ (* as substituted_name with no explicit substitution *)
@@ -250,6 +249,9 @@ EXTEND
         b = binder_low; (vars, typ) = binder_vars; SYMBOL "."; body = term ->
           let binder = mk_binder_ast b typ vars body in
           return_term loc binder
+      | b = binder_high; (vars, typ) = binder_vars; SYMBOL "."; body = term ->
+          let binder = mk_binder_ast b typ vars body in
+          return_term loc binder
       | t1 = term; SYMBOL <:unicode<to>> (* → *); t2 = term ->
           return_term loc (CicAst.Binder (`Pi, (Cic.Anonymous, Some t1), t2))
       ]
@@ -272,12 +274,6 @@ EXTEND
         in
         CicAst.Appl (aux t1 @ [t2])
       ]
-    | "binder" RIGHTA
-      [
-        b = binder_high; (vars, typ) = binder_vars; SYMBOL "."; body = term ->
-          let binder = mk_binder_ast b typ vars body in
-          return_term loc binder
-      ]
     | "simple" NONA
       [ sort = sort -> CicAst.Sort sort
       | n = substituted_name -> return_term loc n
@@ -335,7 +331,8 @@ EXTEND
         TacticAst.Apply (loc, t)
     | [ IDENT "assumption" ] ->
         TacticAst.Assumption loc
-    | [ IDENT "auto" ] -> TacticAst.Auto loc
+    | [ IDENT "auto" ] ; num = OPT [ i = NUM -> int_of_string i ] -> 
+          TacticAst.Auto (loc,num)
     | [ IDENT "change" ];
       t1 = tactic_term; "with"; t2 = tactic_term;
       where = tactic_where ->
@@ -390,14 +387,17 @@ EXTEND
         (match (pat, terms) with
         | None, [] -> TacticAst.Reduce (loc, kind, None)
         | None, terms -> TacticAst.Reduce (loc, kind, Some (terms, `Goal))
-        | Some pat, [] -> TacticAst.Reduce (loc, kind, Some ([], pat))
+        | Some pat, [] -> fail loc "Missing term [list]"
         | Some pat, terms -> TacticAst.Reduce (loc, kind, Some (terms, pat)))
     | [ IDENT "reflexivity" ] ->
         TacticAst.Reflexivity loc
     | [ IDENT "replace" ];
       t1 = tactic_term; "with"; t2 = tactic_term ->
         TacticAst.Replace (loc, t1, t2)
-    (* TODO Rewrite *)
+    | [ IDENT "rewrite" ; IDENT "left" ] ; t = term ->
+        TacticAst.Rewrite (loc,`Left, t, None)
+    | [ IDENT "rewrite" ; IDENT "right" ] ; t = term ->
+        TacticAst.Rewrite (loc,`Right, t, None)
     (* TODO Replace_pattern *)
     | [ IDENT "right" ] -> TacticAst.Right loc
     | [ IDENT "ring" ] -> TacticAst.Ring loc
@@ -480,7 +480,16 @@ EXTEND
     | [ IDENT "check"   ]; t = term ->
         TacticAst.Check (loc, t)
     | [ IDENT "hint" ] -> TacticAst.Hint loc
-    | [ IDENT "pmatch" ] ; t = term -> TacticAst.Match (loc,t)
+    | [ IDENT "whelp"; "match" ] ; t = term -> 
+        TacticAst.WMatch (loc,t)
+    | [ IDENT "whelp"; IDENT "instance" ] ; t = term -> 
+        TacticAst.WInstance (loc,t)
+    | [ IDENT "whelp"; IDENT "locate" ] ; id = IDENT -> 
+        TacticAst.WLocate (loc,id)
+    | [ IDENT "whelp"; IDENT "elim" ] ; t = term ->
+        TacticAst.WElim (loc, t)
+    | [ IDENT "whelp"; IDENT "hint" ] ; t = term -> 
+        TacticAst.WHint (loc,t)
     | [ IDENT "print" ]; name = QSTRING -> TacticAst.Print (loc, name)
   ]];
 
@@ -558,12 +567,30 @@ EXTEND
         TacticAst.Alias (loc, spec)
   ]];
 
-  statement: [
+  executable: [
     [ cmd = command; SYMBOL "." -> TacticAst.Command (loc, cmd)
     | tac = tactical; SYMBOL "." -> TacticAst.Tactical (loc, tac)
     | mac = macro; SYMBOL "." -> TacticAst.Macro (loc, mac)
     ]
   ];
+  
+  comment: [
+    [ BEGINCOMMENT ; ex = executable ; ENDCOMMENT -> 
+       TacticAst.Code (loc, ex)
+    | str = NOTE -> 
+       TacticAst.Note (loc, str)
+    ]
+  ];
+  
+  statement: [
+    [ ex = executable -> TacticAst.Executable (loc,ex)
+    | com = comment -> TacticAst.Comment (loc, com)
+    ]
+  ];
+  statements: [
+    [ l = LIST0 [ statement ] -> l 
+    ]  
+  ];
 END
 
 let exc_located_wrapper f =
@@ -579,6 +606,9 @@ let parse_term stream =
   exc_located_wrapper (fun () -> (Grammar.Entry.parse term0 stream))
 let parse_statement stream =
   exc_located_wrapper (fun () -> (Grammar.Entry.parse statement stream))
+let parse_statements stream =
+  exc_located_wrapper (fun () -> (Grammar.Entry.parse statements stream))
+  
 
 (**/**)