# HG changeset patch
# User wenzelm
# Date 1159384391 -7200
# Node ID a041bf3c8f2ff5a87e3d625e1043747d83762d48
# Parent  8aa9590bd452bc535a998f06608f72ca487ae59a
internal params: Vartab instead of AList;

diff -r 8aa9590bd452 -r a041bf3c8f2f src/Pure/type_infer.ML
--- a/src/Pure/type_infer.ML	Wed Sep 27 21:13:09 2006 +0200
+++ b/src/Pure/type_infer.ML	Wed Sep 27 21:13:11 2006 +0200
@@ -118,12 +118,12 @@
     val params' = fold_atyps
       (fn TVar (xi as (x, _), S) =>
           (fn ps =>
-            if is_param xi andalso not (AList.defined (op =) ps xi)
-            then (xi, mk_param S) :: ps else ps)
+            if is_param xi andalso not (Vartab.defined ps xi)
+            then Vartab.update (xi, mk_param S) ps else ps)
         | _ => I) typ params;
 
     fun pre_of (TVar (v as (xi, _))) =
-          (case AList.lookup (op =) params' xi of
+          (case Vartab.lookup params' xi of
             NONE => PTVar v
           | SOME p => p)
       | pre_of (TFree ("'_dummy_", S)) = mk_param S
@@ -139,8 +139,8 @@
 fun preterm_of const_type is_param tm (vparams, params) =
   let
     fun add_vparm xi ps =
-      if not (AList.defined Term.eq_ix ps xi) then
-        (xi, mk_param []) :: ps
+      if not (Vartab.defined ps xi) then
+        Vartab.update (xi, mk_param []) ps
       else ps;
 
     val vparams' = fold_aterms
@@ -149,10 +149,11 @@
         | Free (x, _) => add_vparm (x, ~1)
         | _ => I)
       tm vparams;
-    fun var_param xi = (the o AList.lookup (op =) vparams') xi;
+    fun var_param xi = the (Vartab.lookup vparams' xi);
 
 
     val preT_of = pretyp_of is_param;
+    fun polyT_of T = fst (pretyp_of (K true) T Vartab.empty);
 
     fun constrain T t ps =
       if T = dummyT then (t, ps)
@@ -162,10 +163,9 @@
 
     fun pre_of (Const (c, T)) ps =
           (case const_type c of
-            SOME U => constrain T (PConst (c, fst (pretyp_of (K true) U []))) ps
+            SOME U => constrain T (PConst (c, polyT_of U)) ps
           | NONE => raise TYPE ("No such constant: " ^ quote c, [], []))
-      | pre_of (Var (xi, Type ("_polymorphic_", [T]))) ps =
-          (PVar (xi, fst (pretyp_of (K true) T [])), ps)
+      | pre_of (Var (xi, Type ("_polymorphic_", [T]))) ps = (PVar (xi, polyT_of T), ps)
       | pre_of (Var (xi, T)) ps = constrain T (PVar (xi, var_param xi)) ps
       | pre_of (Free (x, T)) ps = constrain T (PFree (x, var_param (x, ~1))) ps
       | pre_of (Const ("_type_constraint_", Type ("fun", [T, _])) $ t) ps =
@@ -397,8 +397,8 @@
 fun basic_infer_types pp tsig const_type used freeze is_param ts Ts =
   let
     (*convert to preterms/typs*)
-    val (Ts', Tps) = fold_map (pretyp_of (K true)) Ts [];
-    val (ts', (vps, ps)) = fold_map (preterm_of const_type is_param) ts ([], Tps);
+    val (Ts', Tps) = fold_map (pretyp_of (K true)) Ts Vartab.empty;
+    val (ts', (vps, ps)) = fold_map (preterm_of const_type is_param) ts (Vartab.empty, Tps);
 
     (*run type inference*)
     val tTs' = ListPair.map Constraint (ts', Ts');
@@ -407,7 +407,7 @@
     (*collect result unifier*)
     fun ch_var (xi, Link (r as ref (Param S))) = (r := PTVar (xi, S); NONE)
       | ch_var xi_T = SOME xi_T;
-    val env = map_filter ch_var Tps;
+    val env = map_filter ch_var (Vartab.dest Tps);
 
     (*convert back to terms/typs*)
     val mk_var =