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

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

diff --git a/components/acic_content/termAcicContent.ml b/components/acic_content/termAcicContent.ml
index 257d2440ba87b66c93e6863f660e715318bb0d35..681f3cd541312e8dff3e86e475cfe3e89aa0db7d 100644 (file)
--- a/components/acic_content/termAcicContent.ml
+++ b/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
@@ -196,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
-                Ast.Pattern (name, Some (ctor_puri !j), capture_variables), rhs
+                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
@@ -323,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
@@ -341,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
@@ -357,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