librarian: retrieval of buildable files speeded up a lot

[helm.git] / helm / software / components / content_pres / termContentPres.ml

diff --git a/helm/software/components/content_pres/termContentPres.ml b/helm/software/components/content_pres/termContentPres.ml
index 85edd595c2aed439e70b6e504afd0fb8bf1ee050..fd326e5e99413902675530d2da45f38c9d1d05f9 100644 (file)
--- a/helm/software/components/content_pres/termContentPres.ml
+++ b/helm/software/components/content_pres/termContentPres.ml
@@ -196,7 +196,7 @@ let pp_ast0 t k =
               hvbox false true [
                 aux_var var; space;
                 builtin_symbol "\\def"; break; top_pos (k s) ];
-              break; space; keyword "in" ];
+              break; space; keyword "in"; space ];
             break;
             k t ])
     | Ast.LetRec (rec_kind, funs, where) ->
@@ -323,8 +323,7 @@ let instantiate21 idrefs env l1 =
         let value = CicNotationEnv.term_of_value value in
         let value = 
           match expected_ty with
-          | Env.TermType (Some l) -> 
-              Ast.AttributedTerm (`Level l,value) 
+          | Env.TermType l -> Ast.AttributedTerm (`Level l,value) 
           | _ -> value
         in
         [ value ]
@@ -512,6 +511,8 @@ let head_names names env =
         (match ty, v with
         | Env.ListType ty, Env.ListValue (v :: _) ->
             aux ((name, (ty, v)) :: acc) tl
+        | Env.TermType _, Env.TermValue _  ->
+            aux ((name, (ty, v)) :: acc) tl
         | _ -> assert false)
     | _ :: tl -> aux acc tl
       (* base pattern may contain only meta names, thus we trash all others *)
@@ -525,6 +526,8 @@ let tail_names names env =
         (match ty, v with
         | Env.ListType ty, Env.ListValue (_ :: vtl) ->
             aux ((name, (Env.ListType ty, Env.ListValue vtl)) :: acc) tl
+        | Env.TermType _, Env.TermValue _  ->
+            aux ((name, (ty, v)) :: acc) tl
         | _ -> assert false)
     | binding :: tl -> aux (binding :: acc) tl
     | [] -> acc
@@ -532,6 +535,7 @@ let tail_names names env =
   aux [] env
 
 let instantiate_level2 env term =
+(*   prerr_endline ("istanzio: " ^ CicNotationPp.pp_term term); *)
   let fresh_env = ref [] in
   let lookup_fresh_name n =
     try
@@ -544,7 +548,7 @@ let instantiate_level2 env term =
   let rec aux env term =
 (*    prerr_endline ("ENV " ^ CicNotationPp.pp_env env); *)
     match term with
-    | Ast.AttributedTerm (_, term) -> aux env term
+    | Ast.AttributedTerm (a, term) -> (*Ast.AttributedTerm (a, *)aux env term
     | Ast.Appl terms -> Ast.Appl (List.map (aux env) terms)
     | Ast.Binder (binder, var, body) ->
         Ast.Binder (binder, aux_capture_var env var, aux env body)
@@ -593,9 +597,7 @@ let instantiate_level2 env term =
   and aux_variable env = function
     | Ast.NumVar name -> Ast.Num (Env.lookup_num env name, 0)
     | Ast.IdentVar name -> Ast.Ident (Env.lookup_string env name, None)
-    | Ast.TermVar (name,None) -> 
-        Env.lookup_term env name
-    | Ast.TermVar (name,Some l) -> 
+    | Ast.TermVar (name,(Ast.Level l|Ast.Self l)) -> 
         Ast.AttributedTerm (`Level l,Env.lookup_term env name)
     | Ast.FreshVar name -> Ast.Ident (lookup_fresh_name name, None)
     | Ast.Ascription (term, name) -> assert false
@@ -637,7 +639,7 @@ let instantiate_level2 env term =
               | Env.ListValue (_ :: _) ->
                   instantiate_fold_left 
                     (let acc_binding =
-                      acc_name, (Env.TermType None, Env.TermValue acc)
+                      acc_name, (Env.TermType 0, Env.TermValue acc)
                      in
                      aux (acc_binding :: head_names names env') rec_pattern)
                     (tail_names names env')
@@ -659,7 +661,7 @@ let instantiate_level2 env term =
               | Env.ListValue (_ :: _) ->
                   let acc = instantiate_fold_right (tail_names names env') in
                   let acc_binding =
-                    acc_name, (Env.TermType None, Env.TermValue acc)
+                    acc_name, (Env.TermType 0, Env.TermValue acc)
                   in
                   aux (acc_binding :: head_names names env') rec_pattern
               | Env.ListValue [] -> aux env base_pattern