tuned decode;
authorwenzelm
Tue, 07 Oct 1997 17:58:50 +0200
changeset 3804 f9d14407fbf6
parent 3803 3e581526ae5e
child 3805 a50d0b5219dd
tuned decode;
src/Pure/type.ML
--- a/src/Pure/type.ML	Tue Oct 07 17:58:01 1997 +0200
+++ b/src/Pure/type.ML	Tue Oct 07 17:58:50 1997 +0200
@@ -804,7 +804,7 @@
       | (None, Some S) => S
       | (Some S, None) => S
       | (Some S, Some S') =>
-          if eq_sort tsig (S, S') then S
+          if eq_sort tsig (S, S') then S'
           else error ("Sort constraint inconsistent with default for type variable " ^
             quote (Syntax.string_of_vname' xi)));
   in get end;
@@ -819,34 +819,34 @@
 
 (* decode_types *)
 
-(*transform parse tree into raw term (idempotent)*)
+(*transform parse tree into raw term*)
 fun decode_types tsig is_const def_type def_sort map_const map_type map_sort tm =
   let
     fun get_type xi = if_none (def_type xi) dummyT;
     val raw_env = Syntax.raw_term_sorts tm;
     val sort_of = get_sort tsig def_sort map_sort raw_env;
 
-    fun decodeT t =
-      cert_typ tsig (map_type (Syntax.typ_of_term sort_of t));
+    val certT = cert_typ tsig o map_type;
+    fun decodeT t = certT (Syntax.typ_of_term sort_of t);
 
     fun decode (Const ("_constrain", _) $ t $ typ) =
           constrain (decode t) (decodeT typ)
-      | decode (Const ("_constrainAbs", _) $ (abs as Abs (x, T, t)) $ typ) =
+      | decode (Const ("_constrainAbs", _) $ (Abs (x, T, t)) $ typ) =
           if T = dummyT then Abs (x, decodeT typ, decode t)
-          else constrain abs (decodeT typ --> dummyT)
-      | decode (Abs (x, T, t)) = Abs (x, T, decode t)
+          else constrain (Abs (x, certT T, decode t)) (decodeT typ --> dummyT)
+      | decode (Abs (x, T, t)) = Abs (x, certT T, decode t)
       | decode (t $ u) = decode t $ decode u
-      | decode (t as Free (x, T)) =
+      | decode (Free (x, T)) =
           let val c = map_const x in
-            if is_const c then Const (c, T)
+            if is_const c then Const (c, certT T)
             else if T = dummyT then Free (x, get_type (x, ~1))
-            else constrain t (get_type (x, ~1))
+            else constrain (Free (x, certT T)) (get_type (x, ~1))
           end
-      | decode (t as Var (xi, T)) =
+      | decode (Var (xi, T)) =
           if T = dummyT then Var (xi, get_type xi)
-          else constrain t (get_type xi)
+          else constrain (Var (xi, certT T)) (get_type xi)
       | decode (t as Bound _) = t
-      | decode (Const (c, T)) = Const (map_const c, T);
+      | decode (Const (c, T)) = Const (map_const c, certT T);
   in
     decode tm
   end;