X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Facic_content%2FcicNotationUtil.ml;h=0c8abce504694b5053f62a9feeb997c0bc6a1a4f;hb=806ecbdd749ecf2a1cabff52b41cf748fe022401;hp=8997a924f46916b3739ac66e9b7dd719573cadaf;hpb=be73a507f4f3c1b40a77dd7fc587adaf45b4d8ea;p=helm.git

diff --git a/helm/software/components/acic_content/cicNotationUtil.ml b/helm/software/components/acic_content/cicNotationUtil.ml
index 8997a924f..0c8abce50 100644
--- a/helm/software/components/acic_content/cicNotationUtil.ml
+++ b/helm/software/components/acic_content/cicNotationUtil.ml
@@ -27,13 +27,19 @@
 
 module Ast = CicNotationPt
 
-let visit_ast ?(special_k = fun _ -> assert false) k =
+let visit_ast ?(special_k = fun _ -> assert false) 
+  ?(map_xref_option= fun x -> x) ?(map_case_indty= fun x -> x) 
+  ?(map_case_outtype=
+      fun k x -> match x with None -> None | Some x -> Some (k x)) 
+  k 
+=
   let rec aux = function
     | Ast.Appl terms -> Ast.Appl (List.map k terms)
     | Ast.Binder (kind, var, body) ->
         Ast.Binder (kind, aux_capture_variable var, k body) 
     | Ast.Case (term, indtype, typ, patterns) ->
-        Ast.Case (k term, indtype, aux_opt typ, aux_patterns patterns)
+        Ast.Case (k term, map_case_indty indtype, map_case_outtype k typ,
+          aux_patterns map_xref_option patterns)
     | Ast.Cast (t1, t2) -> Ast.Cast (k t1, k t2)
     | Ast.LetIn (var, t1, t3) ->
         Ast.LetIn (aux_capture_variable var, k t1, k t3)
@@ -56,7 +62,8 @@ let visit_ast ?(special_k = fun _ -> assert false) k =
       | Ast.Magic _
       | Ast.Variable _) as t -> special_k t
     | (Ast.Ident _
-      | Ast.Implicit
+      | Ast.NRef _
+      | Ast.Implicit _
       | Ast.Num _
       | Ast.Sort _
       | Ast.Symbol _
@@ -66,11 +73,11 @@ let visit_ast ?(special_k = fun _ -> assert false) k =
     | None -> None
     | Some term -> Some (k term)
   and aux_capture_variable (term, typ_opt) = k term, aux_opt typ_opt
-  and aux_patterns patterns = List.map aux_pattern patterns
-  and aux_pattern =
+  and aux_patterns k_xref patterns = List.map (aux_pattern k_xref) patterns
+  and aux_pattern k_xref =
    function
       Ast.Pattern (head, hrefs, vars), term ->
-        Ast.Pattern (head, hrefs, List.map aux_capture_variable vars), k term
+        Ast.Pattern (head, k_xref hrefs, List.map aux_capture_variable vars), k term
     | Ast.Wildcard, term -> Ast.Wildcard, k term
   and aux_subst (name, term) = (name, k term)
   and aux_substs substs = List.map aux_subst substs
@@ -93,6 +100,7 @@ let visit_layout k = function
   | Ast.Group terms -> Ast.Group (List.map k terms)
   | Ast.Mstyle (l, term) -> Ast.Mstyle (l, List.map k term)
   | Ast.Mpadded (l, term) -> Ast.Mpadded (l, List.map k term)
+  | Ast.Maction terms -> Ast.Maction (List.map k terms)
 
 let visit_magic k = function
   | Ast.List0 (t, l) -> Ast.List0 (k t, l)
@@ -200,7 +208,7 @@ let meta_names_of_term term =
     | Ast.Ident (_, Some substs) -> aux_substs substs
     | Ast.Meta (_, substs) -> aux_meta_substs substs
 
-    | Ast.Implicit
+    | Ast.Implicit _
     | Ast.Ident _
     | Ast.Num _
     | Ast.Sort _
@@ -319,13 +327,21 @@ let dressn ~sep:sauces =
 let find_appl_pattern_uris ap =
   let rec aux acc =
     function
-    | Ast.UriPattern uri -> uri :: acc
+    | Ast.UriPattern uri -> `Uri uri :: acc
+    | Ast.NRefPattern nref -> `NRef nref :: acc
     | Ast.ImplicitPattern
     | Ast.VarPattern _ -> acc
     | Ast.ApplPattern apl -> List.fold_left aux acc apl
   in
   let uris = aux [] ap in
-  HExtlib.list_uniq (List.fast_sort UriManager.compare uris)
+  let cmp u1 u2 =
+   match u1,u2 with
+      `Uri u1, `Uri u2 -> UriManager.compare u1 u2
+    | `NRef r1, `NRef r2 -> NReference.compare r1 r2
+    | `Uri _,`NRef _ -> -1
+    | `NRef _, `Uri _ -> 1
+  in
+  HExtlib.list_uniq (List.fast_sort cmp uris)
 
 let rec find_branch =
   function
@@ -355,7 +371,8 @@ let fresh_id () =
   !fresh_index
 
   (* TODO ensure that names generated by fresh_var do not clash with user's *)
-let fresh_name () = "fresh" ^ string_of_int (fresh_id ())
+  (* FG: "η" is not an identifier (it is rendered, but not be parsed) *)
+let fresh_name () = "eta" ^ string_of_int (fresh_id ())
 
 let rec freshen_term ?(index = ref 0) term =
   let freshen_term = freshen_term ~index in
@@ -389,11 +406,11 @@ let freshen_obj obj =
           indtypes
       in
       CicNotationPt.Inductive (freshen_capture_variables params, indtypes)
-  | CicNotationPt.Theorem (flav, n, t, ty_opt) ->
+  | CicNotationPt.Theorem (flav, n, t, ty_opt,p) ->
       let ty_opt =
         match ty_opt with None -> None | Some ty -> Some (freshen_term ty)
       in
-      CicNotationPt.Theorem (flav, n, freshen_term t, ty_opt)
+      CicNotationPt.Theorem (flav, n, freshen_term t, ty_opt,p)
   | CicNotationPt.Record (params, n, ty, fields) ->
       CicNotationPt.Record (freshen_capture_variables params, n,
         freshen_term ty, freshen_name_ty_b fields)