src/Pure/Tools/compute.ML
changeset 17223 430edc6b7826
parent 16851 551462cc8ca0
child 17412 e26cb20ef0cc
--- a/src/Pure/Tools/compute.ML	Thu Sep 01 18:48:54 2005 +0200
+++ b/src/Pure/Tools/compute.ML	Thu Sep 01 22:15:10 2005 +0200
@@ -44,13 +44,13 @@
 val remove_types =
     let
         fun remove_types_var table invtable ccount vcount ldepth t =
-            (case Termtab.lookup (table, t) of
+            (case Termtab.curried_lookup table t of
                  NONE =>
                  let
                      val a = AbstractMachine.Var vcount
                  in
-                     (Termtab.update ((t, a), table),
-                      AMTermTab.update ((a, t), invtable),
+                     (Termtab.curried_update (t, a) table,
+                      AMTermTab.curried_update (a, t) invtable,
                       ccount,
                       inc vcount,
                       AbstractMachine.Var (add vcount ldepth))
@@ -60,13 +60,13 @@
                | SOME _ => sys_error "remove_types_var: lookup should be a var")
 
         fun remove_types_const table invtable ccount vcount ldepth t =
-            (case Termtab.lookup (table, t) of
+            (case Termtab.curried_lookup table t of
                  NONE =>
                  let
                      val a = AbstractMachine.Const ccount
                  in
-                     (Termtab.update ((t, a), table),
-                      AMTermTab.update ((a, t), invtable),
+                     (Termtab.curried_update (t, a) table,
+                      AMTermTab.curried_update (a, t) invtable,
                       inc ccount,
                       vcount,
                       a)
@@ -114,12 +114,12 @@
     let
         fun infer_types invtable ldepth bounds ty (AbstractMachine.Var v) =
             if v < ldepth then (Bound v, List.nth (bounds, v)) else
-            (case AMTermTab.lookup (invtable, AbstractMachine.Var (v-ldepth)) of
+            (case AMTermTab.curried_lookup invtable (AbstractMachine.Var (v-ldepth)) of
                  SOME (t as Var (_, ty)) => (t, ty)
                | SOME (t as Free (_, ty)) => (t, ty)
                | _ => sys_error "infer_types: lookup should deliver Var or Free")
           | infer_types invtable ldepth _ ty (c as AbstractMachine.Const _) =
-            (case AMTermTab.lookup (invtable, c) of
+            (case AMTermTab.curried_lookup invtable c of
                  SOME (c as Const (_, ty)) => (c, ty)
                | _ => sys_error "infer_types: lookup should deliver Const")
           | infer_types invtable ldepth bounds (n,ty) (AbstractMachine.App (a, b)) =
@@ -176,10 +176,10 @@
 
                 fun make_pattern table invtable n vars (var as AbstractMachine.Var v) =
                     let
-                        val var' = valOf (AMTermTab.lookup (invtable, var))
+                        val var' = valOf (AMTermTab.curried_lookup invtable var)
                         val table = Termtab.delete var' table
                         val invtable = AMTermTab.delete var invtable
-                        val vars = Inttab.update_new ((v, n), vars) handle Inttab.DUP _ =>
+                        val vars = Inttab.curried_update_new (v, n) vars handle Inttab.DUP _ =>
                           raise (Make "no duplicate variable in pattern allowed")
                     in
                         (table, invtable, n+1, vars, AbstractMachine.PVar)
@@ -217,7 +217,7 @@
 
                 fun rename ldepth vars (var as AbstractMachine.Var v) =
                     if v < ldepth then var
-                    else (case Inttab.lookup (vars, v-ldepth) of
+                    else (case Inttab.curried_lookup vars (v - ldepth) of
                               NONE => raise (Make "new variable on right hand side")
                             | SOME n => AbstractMachine.Var ((vcount-n-1)+ldepth))
                   | rename ldepth vars (c as AbstractMachine.Const _) = c
@@ -231,14 +231,12 @@
             end
 
         val (table, invtable, ccount, rules) =
-            List.foldl (fn (th, (table, invtable, ccount, rules)) =>
-                           let
-                               val (table, invtable, ccount, rule) =
-                                   thm2rule table invtable ccount th
-                           in
-                               (table, invtable, ccount, rule::rules)
-                           end)
-                       (Termtab.empty, AMTermTab.empty, 0, []) (List.rev ths)
+          fold_rev (fn th => fn (table, invtable, ccount, rules) =>
+            let
+              val (table, invtable, ccount, rule) =
+                  thm2rule table invtable ccount th
+            in (table, invtable, ccount, rule::rules) end)
+          ths (Termtab.empty, AMTermTab.empty, 0, [])
 
         val prog = AbstractMachine.compile rules