fixed Ref generation

[helm.git] / helm / software / components / ng_refiner / nCicRefiner.ml

diff --git a/helm/software/components/ng_refiner/nCicRefiner.ml b/helm/software/components/ng_refiner/nCicRefiner.ml
index 03de06d1c6c3306613b31e77b2f24639be93ec3f..757fceea2a4a5dd83e728fb88e069a7f28f54957 100644 (file)
--- a/helm/software/components/ng_refiner/nCicRefiner.ml
+++ b/helm/software/components/ng_refiner/nCicRefiner.ml
@@ -22,13 +22,14 @@ let indent = ref "";;
 let inside c = indent := !indent ^ String.make 1 c;;
 let outside () = indent := String.sub !indent 0 (String.length !indent -1);;
 
-
+let debug = ref false;;
 let pp s = 
-  prerr_endline (Printf.sprintf "%-20s" !indent ^ " " ^ Lazy.force s)
+  if !debug then
+    prerr_endline (Printf.sprintf "%-20s" !indent ^ " " ^ Lazy.force s)
+  else 
+    ()
 ;;  
 
-let pp _ = ();;
-
 let wrap_exc msg = function
   | NCicUnification.Uncertain _ -> Uncertain msg
   | NCicUnification.UnificationFailure _ -> RefineFailure msg
@@ -42,7 +43,8 @@ let exp_implicit ~localise metasenv context expty t =
   | `Closed -> NCicMetaSubst.mk_meta metasenv [] (foo `Term)
   | `Type -> NCicMetaSubst.mk_meta metasenv context (foo `Type)
   | `Term -> NCicMetaSubst.mk_meta metasenv context (foo `Term)
-  | `Tagged s -> NCicMetaSubst.mk_meta ~name:s metasenv context (foo `Term)
+  | `Tagged s ->
+      NCicMetaSubst.mk_meta ~attrs:[`Name s] metasenv context (foo `Term)
   | `Vector ->
       raise (RefineFailure (lazy (localise t, "A vector of implicit terms " ^
        "can only be used in argument position")))
@@ -241,7 +243,8 @@ let rec typeof rdb
          | Some x -> 
              let m, s, x = 
                NCicUnification.delift_type_wrt_terms 
-                 rdb metasenv subst context x [t]
+                rdb metasenv subst context1 (NCicSubstitution.lift 1 x)
+                [NCicSubstitution.lift 1 t]
              in
                m, s, Some x
        in
@@ -309,7 +312,7 @@ let rec typeof rdb
       let metasenv =
        List.filter (function (j,_) -> j <> metanoouttype) metasenv in
       let subst =
-       (metanoouttype,(Some "outtype",context,outtype,metaoutsort))::subst in
+       (metanoouttype,([`Name "outtype"],context,outtype,metaoutsort))::subst in
       let outtype = newouttype in
 
       (* let's control if the sort elimination is allowed: [(I q1 ... qr)|B] *)
@@ -375,7 +378,7 @@ and try_coercions rdb
   let rec first exc = function
   | [] ->         
       raise (wrap_exc (lazy (localise orig_t, Printf.sprintf
-        "The term %s has type %s but is here used with type %s"
+        "The term\n%s\nhas type\n%s\nbut is here used with type\n%s"
         (NCicPp.ppterm ~metasenv ~subst ~context t)
         (NCicPp.ppterm ~metasenv ~subst ~context infty)
         (NCicPp.ppterm ~metasenv ~subst ~context expty))) exc)