]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/ocaml/cic_notation/cicNotationParser.ml
snapshot
[helm.git] / helm / ocaml / cic_notation / cicNotationParser.ml
index b408e6e3bea60fdd718e5354691c987b875d8bd3..4dcc772975b9e28287d3840b90bd640de4a067cf 100644 (file)
@@ -37,6 +37,16 @@ let min_precedence = 0
 let max_precedence = 100
 let default_precedence = 50
 
+let let_in_prec = 10
+let binder_prec = 20
+let apply_prec = 70
+let simple_prec = 90
+
+let let_in_assoc = Gramext.NonA
+let binder_assoc = Gramext.RightA
+let apply_assoc = Gramext.LeftA
+let simple_assoc = Gramext.NonA
+
 let level1_pattern = Grammar.Entry.create grammar "level1_pattern"
 let level2_pattern = Grammar.Entry.create grammar "level2_pattern"
 let level3_term = Grammar.Entry.create grammar "level3_term"
@@ -79,40 +89,30 @@ type binding =
 let make_action action bindings =
   let rec aux (vl : CicNotationEnv.t) =
     function
-      [] ->
-        prerr_endline "aux: make_action";
-        Gramext.action (fun (loc: location) -> action vl loc)
-    | NoBinding :: tl ->
-        prerr_endline "aux: none";
-        Gramext.action (fun _ -> aux vl tl)
-    (* LUCA: DEFCON 2 BEGIN *)
+      [] -> Gramext.action (fun (loc: location) -> action vl loc)
+    | NoBinding :: tl -> Gramext.action (fun _ -> aux vl tl)
+    (* LUCA: DEFCON 5 BEGIN *)
     | Binding (name, TermType) :: tl ->
-        prerr_endline "aux: term";
         Gramext.action
-          (fun (v:term) -> aux ((name, (TermType, (TermValue v)))::vl) tl)
+          (fun (v:term) -> aux ((name, (TermType, TermValue v))::vl) tl)
     | Binding (name, StringType) :: tl ->
-        prerr_endline "aux: string";
         Gramext.action
           (fun (v:string) ->
-            aux ((name, (StringType, (StringValue v))) :: vl) tl)
+            aux ((name, (StringType, StringValue v)) :: vl) tl)
     | Binding (name, NumType) :: tl ->
-        prerr_endline "aux: num";
         Gramext.action
-          (fun (v:string) -> aux ((name, (NumType, (NumValue v))) :: vl) tl)
+          (fun (v:string) -> aux ((name, (NumType, NumValue v)) :: vl) tl)
     | Binding (name, OptType t) :: tl ->
-        prerr_endline "aux: opt";
         Gramext.action
           (fun (v:'a option) ->
-            aux ((name, (OptType t, (OptValue v))) :: vl) tl)
+            aux ((name, (OptType t, OptValue v)) :: vl) tl)
     | Binding (name, ListType t) :: tl ->
-        prerr_endline "aux: list";
         Gramext.action
           (fun (v:'a list) ->
-            aux ((name, (ListType t, (ListValue v))) :: vl) tl)
+            aux ((name, (ListType t, ListValue v)) :: vl) tl)
     | Env _ :: tl ->
-        prerr_endline "aux: env";
         Gramext.action (fun (v:CicNotationEnv.t) -> aux (v @ vl) tl)
-    (* LUCA: DEFCON 2 END *)
+    (* LUCA: DEFCON 5 END *)
   in
     aux [] (List.rev bindings)
 
@@ -154,7 +154,7 @@ let extract_term_production pattern =
         [NoBinding, symbol "\\ROOT"] @ aux p2 @ [NoBinding, symbol "\\OF"]
         @ aux p1
     | Sqrt p -> [NoBinding, symbol "\\SQRT"] @ aux p
-    | Break -> []
+(*     | Break -> [] *)
     | Box (_, pl) -> List.flatten (List.map aux pl)
   and aux_magic magic =
     match magic with
@@ -172,9 +172,8 @@ let extract_term_production pattern =
     | List0 (p, _)
     | List1 (p, _) ->
         let p_bindings, p_atoms, p_names, p_action = inner_pattern p in
-        let env0 = List.map list_binding_of_name p_names in
+(*         let env0 = List.map list_binding_of_name p_names in
         let grow_env_entry env n v =
-          prerr_endline "grow_env_entry";
           List.map
             (function
               | (n', (ty, ListValue vl)) as entry ->
@@ -183,14 +182,12 @@ let extract_term_production pattern =
             env
         in
         let grow_env env_i env =
-          prerr_endline "grow_env";
           List.fold_left
             (fun env (n, (_, v)) -> grow_env_entry env n v)
             env env_i
-        in
+        in *)
         let action (env_list : CicNotationEnv.t list) (loc : location) =
-          prerr_endline "list action";
-          List.fold_right grow_env env_list env0
+          CicNotationEnv.coalesce_env p_names env_list
         in
         let g_symbol s =
           match magic with
@@ -257,10 +254,6 @@ let delete atoms = Grammar.delete_rule l2_pattern atoms
 
 (** {2 Grammar} *)
 
-let boxify = function
-  | [ a ] -> a
-  | l -> Layout (Box (H, l))
-
 let fold_binder binder pt_names body =
   let fold_cluster binder terms ty body =
     List.fold_right
@@ -337,12 +330,17 @@ EXTEND
       | SYMBOL "\\ROOT"; index = SELF; SYMBOL "\\OF"; arg = SELF ->
           return_term loc (Layout (Root (arg, index)));
       | SYMBOL "\\HBOX"; DELIM "\\["; p = l1_pattern; DELIM "\\]" ->
-          return_term loc (Layout (Box (H, p)))
+          return_term loc (Layout (Box ((H, false, false), p)))
       | SYMBOL "\\VBOX"; DELIM "\\["; p = l1_pattern; DELIM "\\]" ->
-          return_term loc (Layout (Box (V, p)))
-      | SYMBOL "\\BREAK" -> return_term loc (Layout Break)
+          return_term loc (Layout (Box ((V, false, false), p)))
+      | SYMBOL "\\HVBOX"; DELIM "\\["; p = l1_pattern; DELIM "\\]" ->
+          return_term loc (Layout (Box ((HV, false, false), p)))
+      | SYMBOL "\\HOVBOX"; DELIM "\\["; p = l1_pattern; DELIM "\\]" ->
+          return_term loc (Layout (Box ((HOV, false, false), p)))
+(*       | SYMBOL "\\BREAK" -> return_term loc (Layout Break) *)
+(*       | SYMBOL "\\SPACE" -> return_term loc (Layout Space) *)
       | DELIM "\\["; p = l1_pattern; DELIM "\\]" ->
-          return_term loc (boxify p)
+          return_term loc (CicNotationUtil.boxify p)
       | p = SELF; SYMBOL "\\AS"; id = IDENT ->
           return_term loc (Variable (Ascription (p, id)))
       ]
@@ -510,8 +508,9 @@ EXTEND
     [ "90" NONA
       [ id = IDENT -> return_term loc (Ident (id, None))
       | id = IDENT; s = explicit_subst -> return_term loc (Ident (id, Some s))
+      | s = CSYMBOL -> return_term loc (Symbol (s, 0))
       | u = URI -> return_term loc (Uri (u, None))
-      | n = NUMBER -> prerr_endline "number"; return_term loc (Num (n, 0))
+      | n = NUMBER -> return_term loc (Num (n, 0))
       | IMPLICIT -> return_term loc (Implicit)
       | m = META -> return_term loc (Meta (int_of_string m, []))
       | m = META; s = meta_substs -> return_term loc (Meta (int_of_string m, s))
@@ -537,15 +536,15 @@ EXTEND
 (* }}} *)
 (* {{{ Grammar for interpretation, notation level 3 *)
   argument: [
-    [ id = IDENT -> IdentArg id
-    | SYMBOL <:unicode<eta>> (* η *); SYMBOL "."; a = SELF -> EtaArg (None, a)
-    | SYMBOL <:unicode<eta>> (* η *); id = IDENT; SYMBOL "."; a = SELF ->
-        EtaArg (Some id, a)
+    [ id = IDENT -> IdentArg (0, id)
+    | l = LIST1 [ SYMBOL <:unicode<eta>> (* η *) -> () ] SEP SYMBOL ".";
+      SYMBOL "."; id = IDENT ->
+        IdentArg (List.length l, id)
     ]
   ];
   level3_term: [
-    [ u = URI -> UriPattern u
-    | a = argument -> ArgPattern a
+    [ u = URI -> UriPattern (UriManager.uri_of_string u)
+    | id = IDENT -> VarPattern id
     | SYMBOL "("; terms = LIST1 SELF; SYMBOL ")" ->
         (match terms with
         | [] -> assert false
@@ -572,8 +571,7 @@ EXTEND
     ]
   ];
   interpretation: [
-    [ s = SYMBOL; args = LIST1 argument; SYMBOL "=";
-      t = level3_term ->
+    [ s = CSYMBOL; args = LIST1 argument; SYMBOL "="; t = level3_term ->
         (s, args, t)
     ]
   ];