Pretty-printing of "match ... with" pattern syntax fixed. We need an

[helm.git] / helm / software / components / acic_content / termAcicContent.ml

diff --git a/helm/software/components/acic_content/termAcicContent.ml b/helm/software/components/acic_content/termAcicContent.ml
index eaa53259021821dc3dc4b053f6eeffbfa160915d..681f3cd541312e8dff3e86e475cfe3e89aa0db7d 100644 (file)
--- a/helm/software/components/acic_content/termAcicContent.ml
+++ b/helm/software/components/acic_content/termAcicContent.ml
@@ -70,7 +70,7 @@ let constructor_of_inductive_type uri i j =
 let left_params_no_of_inductive_type uri =
    snd (get_types uri)
 
-let ast_of_acic0 term_info acic k =
+let ast_of_acic0 ~output_type term_info acic k =
   let k = k term_info in
   let id_to_uris = term_info.uri in
   let register_uri id uri = Hashtbl.add id_to_uris id uri in
@@ -123,7 +123,7 @@ let ast_of_acic0 term_info acic k =
           k s, k t))
     | Cic.AAppl (aid,(Cic.AConst _ as he::tl as args))
     | Cic.AAppl (aid,(Cic.AMutInd _ as he::tl as args))
-    | Cic.AAppl (aid,(Cic.AMutConstruct _ as he::tl as args)) ->
+    | Cic.AAppl (aid,(Cic.AMutConstruct _ as he::tl as args)) as t ->
        let last_n n l =
          let rec aux =
           function
@@ -143,14 +143,17 @@ let ast_of_acic0 term_info acic k =
                idref aid (Ast.Appl (l@tl))
            | l -> idref aid (Ast.Appl l)
        in
-       let deannot_he = Deannotate.deannotate_term he in
-       if CoercDb.is_a_coercion' deannot_he && !Acic2content.hide_coercions
-       then
-         match CoercDb.is_a_coercion_to_funclass deannot_he with
-         | None -> idref aid (last_n 1 (List.map k tl))
-         | Some i -> idref aid (last_n (i+1) (List.map k tl))
-       else
-        idref aid (Ast.Appl (List.map k args))
+       (match LibraryObjects.destroy_nat t with
+       | Some n -> idref aid (Ast.Num (string_of_int n, -1))
+       | None ->
+           let deannot_he = Deannotate.deannotate_term he in
+           if CoercDb.is_a_coercion' deannot_he && !Acic2content.hide_coercions
+           then
+             (match CoercDb.is_a_coercion_to_funclass deannot_he with
+             | None -> idref aid (last_n 1 (List.map k tl))
+             | Some i -> idref aid (last_n (i+1) (List.map k tl)))
+           else
+             idref aid (Ast.Appl (List.map k args)))
     | Cic.AAppl (aid,args) ->
         idref aid (Ast.Appl (List.map k args))
     | Cic.AConst (id,uri,substs) ->
@@ -193,12 +196,21 @@ let ast_of_acic0 term_info acic k =
             List.map2
               (fun (name, ty) pat ->
                 incr j;
-                let (capture_variables, rhs) = eat_branch lpsno ty pat in
-                ((name, Some (ctor_puri !j), capture_variables), rhs))
-              constructors patterns
+                let name,(capture_variables,rhs) =
+                 match output_type with
+                    `Term -> name, eat_branch lpsno ty pat
+                  | `Pattern -> "_", ([], k pat)
+                in
+                 Ast.Pattern (name, Some (ctor_puri !j), capture_variables), rhs
+              ) constructors patterns
           with Invalid_argument _ -> assert false
         in
-        idref id (Ast.Case (k te, Some case_indty, Some (k ty), patterns))
+        let indty =
+         match output_type with
+            `Pattern -> None
+          | `Term -> Some case_indty
+        in
+        idref id (Ast.Case (k te, indty, Some (k ty), patterns))
     | Cic.AFix (id, no, funs) -> 
         let defs = 
           List.map
@@ -320,11 +332,12 @@ let instantiate32 term_info idrefs env symbol args =
   if args = [] then head
   else Ast.Appl (head :: List.map instantiate_arg args)
 
-let rec ast_of_acic1 term_info annterm = 
+let rec ast_of_acic1 ~output_type term_info annterm = 
   let id_to_uris = term_info.uri in
   let register_uri id uri = Hashtbl.add id_to_uris id uri in
   match (get_compiled32 ()) annterm with
-  | None -> ast_of_acic0 term_info annterm ast_of_acic1
+  | None ->
+     ast_of_acic0 ~output_type term_info annterm (ast_of_acic1 ~output_type)
   | Some (env, ctors, pid) -> 
       let idrefs =
         List.map
@@ -338,7 +351,8 @@ let rec ast_of_acic1 term_info annterm =
           ctors
       in
       let env' =
-        List.map (fun (name, term) -> (name, ast_of_acic1 term_info term)) env
+       List.map
+        (fun (name, term) -> name, ast_of_acic1 ~output_type term_info term) env
       in
       let _, symbol, args, _ =
         try
@@ -354,11 +368,11 @@ let load_patterns32 t =
   in
   set_compiled32 (lazy (Acic2astMatcher.Matcher32.compiler t))
 
-let ast_of_acic id_to_sort annterm =
+let ast_of_acic ~output_type id_to_sort annterm =
   debug_print (lazy ("ast_of_acic <- "
     ^ CicPp.ppterm (Deannotate.deannotate_term annterm)));
   let term_info = { sort = id_to_sort; uri = Hashtbl.create 211 } in
-  let ast = ast_of_acic1 term_info annterm in
+  let ast = ast_of_acic1 ~output_type term_info annterm in
   debug_print (lazy ("ast_of_acic -> " ^ CicNotationPp.pp_term ast));
   ast, term_info.uri