X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_refiner%2FnCicRefiner.ml;h=757fceea2a4a5dd83e728fb88e069a7f28f54957;hb=dc7e826399162e2fde3ddf1f02d5530d6cd11205;hp=6664a5b9781cf0b06bb465c78f9f017558d6c522;hpb=1144eafda5f046c21ceda807f4b5659b3e74147d;p=helm.git diff --git a/helm/software/components/ng_refiner/nCicRefiner.ml b/helm/software/components/ng_refiner/nCicRefiner.ml index 6664a5b97..757fceea2 100644 --- 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,6 +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 ~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"))) @@ -240,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 @@ -308,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] *) @@ -374,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)