# HG changeset patch # User wenzelm # Date 876239930 -7200 # Node ID f9d14407fbf6a7333a567cf4a3f76534f9302f60 # Parent 3e581526ae5eb1edff50317472da3b242e03c261 tuned decode; diff -r 3e581526ae5e -r f9d14407fbf6 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;