* New implementation of localized exceptions

[helm.git] / helm / ocaml / cic_notation / cicNotationPt.ml

diff --git a/helm/ocaml/cic_notation/cicNotationPt.ml b/helm/ocaml/cic_notation/cicNotationPt.ml
index 4ea310ee5d5d19d181b4e534107fd844bfd451c2..d0310d0e57e6683e689f68cad961cf6aac08f230 100644 (file)
--- a/helm/ocaml/cic_notation/cicNotationPt.ml
+++ b/helm/ocaml/cic_notation/cicNotationPt.ml
@@ -27,28 +27,26 @@
 
 type binder_kind = [ `Lambda | `Pi | `Exists | `Forall ]
 type induction_kind = [ `Inductive | `CoInductive ]
-type sort_kind = [ `Prop | `Set | `Type | `CProp ]
+type sort_kind = [ `Prop | `Set | `Type of CicUniv.universe | `CProp ]
 type fold_kind = [ `Left | `Right ]
 
-type location = Lexing.position * Lexing.position
-(* cut and past from CicAst.loc_of_floc *)
-let loc_of_floc = function
-  | { Lexing.pos_cnum = loc_begin }, { Lexing.pos_cnum = loc_end } ->
-      (loc_begin, loc_end)
+type location = Token.flocation
 let fail floc msg =
-  let (x, y) = loc_of_floc floc in
+  let (x, y) = HExtlib.loc_of_floc floc in
   failwith (Printf.sprintf "Error at characters %d - %d: %s" x y msg)
 
-type blob_context = [ `Ast | `Meta ]
+type href = UriManager.uri
+
+type child_pos = [ `Left | `Right | `Inner ]
 
 type term_attribute =
   [ `Loc of location                  (* source file location *)
   | `IdRef of string                  (* ACic pointer *)
-  | `Href of UriManager.uri list      (* hyperlinks for literals *)
   | `Level of int * Gramext.g_assoc   (* precedence, associativity *)
+  | `ChildPos of child_pos            (* position of l1 pattern variables *)
   | `XmlAttrs of (string option * string * string) list
       (* list of XML attributes: namespace, name, value *)
-  | `Raw of string * blob_context option  (* unparsed version *)
+  | `Raw of string                    (* unparsed version *)
   ]
 
 type literal =
@@ -57,6 +55,12 @@ type literal =
   | `Number of string
   ]
 
+type case_indtype = string * href option
+
+(** To be increased each time the term type below changes, used for "safe"
+ * marshalling *)
+let magic = 1
+
 type term =
   (* CIC AST *)
 
@@ -64,7 +68,8 @@ type term =
 
   | Appl of term list
   | Binder of binder_kind * capture_variable * term (* kind, name, body *)
-  | Case of term * string option * term option * (case_pattern * term) list
+  | Case of term * case_indtype option * term option *
+      (case_pattern * term) list
       (* what to match, inductive type, out type, <pattern,action> list *)
   | Cast of term * term
   | LetIn of capture_variable * term * term  (* name, body, where *)
@@ -97,7 +102,7 @@ and capture_variable = term * term option
 
 and meta_subst = term option
 and subst = string * term
-and case_pattern = string * capture_variable list
+and case_pattern = string * href option * capture_variable list
 
 and box_kind = H | V | HV | HOV
 and box_spec = box_kind * bool * bool (* kind, spacing, indent *)