fixes tvar issue in type inference
authorhaftmann
Thu, 24 May 2007 08:37:43 +0200
changeset 23090 eb3000a5c478
parent 23089 9669110656b9
child 23091 c91530f18d9c
fixes tvar issue in type inference
src/Pure/Tools/nbe.ML
--- a/src/Pure/Tools/nbe.ML	Thu May 24 08:37:42 2007 +0200
+++ b/src/Pure/Tools/nbe.ML	Thu May 24 08:37:43 2007 +0200
@@ -133,17 +133,17 @@
   let
     fun subst_Frees [] = I
       | subst_Frees inst =
-          Term.map_aterms (fn (t as Free(s, _)) => the_default t (AList.lookup (op =) inst s)
-                      | t => t);
+          Term.map_aterms (fn (t as Free (s, _)) => the_default t (AList.lookup (op =) inst s)
+                            | t => t);
     val anno_vars =
       subst_Frees (map (fn (s, T) => (s, Free (s, T))) (Term.add_frees t []))
-      #> subst_Vars  (map (fn (ixn, T) => (ixn, Var(ixn,T))) (Term.add_vars t []))
+      #> subst_Vars (map (fn (ixn, T) => (ixn, Var (ixn, T))) (Term.add_vars t []))
     fun check_tvars t = if null (Term.term_tvars t) then t else
       error ("Illegal schematic type variables in normalized term: "
         ^ setmp show_types true (Sign.string_of_term thy) t);
     val ty = type_of t;
     fun constrain t =
-      singleton (ProofContext.infer_types (ProofContext.init thy)) (TypeInfer.constrain t ty);
+      singleton (ProofContext.infer_types_pats (ProofContext.init thy)) (TypeInfer.constrain t ty);
     val _ = ensure_funs thy funcgr t;
   in
     t
@@ -151,10 +151,12 @@
     |> NBE_Eval.eval thy (!tab)
     |> tracing (fn nt => "Normalized:\n" ^ NBE_Eval.string_of_nterm nt)
     |> NBE_Codegen.nterm_to_term thy
-    |> tracing (fn t =>"Converted back:\n" ^ Display.raw_string_of_term t)
+    |> tracing (fn t => "Converted back:\n" ^ setmp show_types true Display.raw_string_of_term t)
+    |> tracing (fn _ => "Term type:\n" ^ Display.raw_string_of_typ ty)
     |> anno_vars
-    |> tracing (fn t =>"Vars typed:\n" ^ Display.raw_string_of_term t)
+    |> tracing (fn t => "Vars typed:\n" ^ setmp show_types true Display.raw_string_of_term t)
     |> constrain
+    |> tracing (fn t => "Types inferred:\n" ^ setmp show_types true Display.raw_string_of_term t)
     |> check_tvars
   end;