Instantiate asdf

1 files changed, 43 insertions, 40 deletions

diff --git a/Types.sml b/Types.sml
index 2722063..4406796 100644
--- a/Types.sml
+++ b/Types.sml
@@ -69,30 +69,51 @@ structure Types = struct
     structs = structs
   }
 
+  fun genericVars (env : env) (TyVar a) : unit TyVarMap.map =
+        if isSome (TyVarMap.lookup a (#boundVars env))
+        then TyVarMap.empty
+        else TyVarMap.fromList [(a, ())]
+    | genericVars env (TyCon (_, tys)) =
+       foldl (fn (x, acc) => TyVarMap.union acc (genericVars env x)) TyVarMap.empty tys
+    | genericVars _ (TyStruct _) = TyVarMap.empty
+
+  fun instantiate (env : env) (t : ty) : ty =
+    let
+      val genericVars = genericVars env t
+      val newVars = TyVarMap.fromList (map (fn (a, _) => (a, GenSym.new ())) (TyVarMap.toList genericVars))
+      fun replace (TyVar a) =
+            TyVar (getOpt (TyVarMap.lookup a newVars, a))
+        | replace (TyCon (n, tys)) = TyCon (n, map replace tys)
+        | replace (TyStruct structType) = TyStruct structType
+    in replace t end
+
   val userTypeVariables : tyvar StringMap.map ref = ref StringMap.empty
 
-  fun etypeToTy (_ : env) (Syntax.Tyvar "int") = TyCon (Int, [])
-    | etypeToTy _ (Syntax.Tyvar "bool") = TyCon (Bool, [])
-    | etypeToTy _ (Syntax.Tyvar "string") = TyCon (Str, [])
-    | etypeToTy env (Syntax.Tyvar v) =
-        if String.isPrefix "'" v then
-          case StringMap.lookup v (!userTypeVariables) of
-            SOME v => TyVar v
-          | NONE =>
-              let val t = GenSym.new () in
-                userTypeVariables := StringMap.insert v t (!userTypeVariables);
-                TyVar t
-              end
-        else
-          (case StringMap.lookup v (#typesByName env) of
-            SOME t => TyCon (t, [])
-          | NONE => raise Fail "unknown type")
-    | etypeToTy env (Syntax.Tycon (tys, ty)) =
-        (case StringMap.lookup ty (#typesByName env) of
-          SOME t => TyCon (t, map (etypeToTy env) tys)
-        | NONE => raise Fail ("unknown type " ^ ty))
-    | etypeToTy env (Syntax.TyTuple tys) = TyCon (Tuple, map (etypeToTy env) tys)
-    | etypeToTy env (Syntax.Tyfun (arg, result)) = TyCon (Fun, [etypeToTy env arg, etypeToTy env result])
+  fun etypeToTy (env : env) (t : Syntax.etype) : ty =
+    let
+      fun go (Syntax.Tyvar "int") = TyCon (Int, [])
+        | go (Syntax.Tyvar "bool") = TyCon (Bool, [])
+        | go (Syntax.Tyvar "string") = TyCon (Str, [])
+        | go (Syntax.Tyvar v) =
+            if String.isPrefix "'" v then
+              case StringMap.lookup v (!userTypeVariables) of
+                SOME v => TyVar v
+              | NONE =>
+                  let val t = GenSym.new () in
+                    userTypeVariables := StringMap.insert v t (!userTypeVariables);
+                    TyVar t
+                  end
+            else
+              (case StringMap.lookup v (#typesByName env) of
+                SOME t => TyCon (t, [])
+              | NONE => raise Fail "unknown type")
+        | go (Syntax.Tycon (tys, ty)) =
+            (case StringMap.lookup ty (#typesByName env) of
+              SOME t => TyCon (t, map go tys)
+            | NONE => raise Fail ("unknown type " ^ ty))
+        | go (Syntax.TyTuple tys) = TyCon (Tuple, map go tys)
+        | go (Syntax.Tyfun (arg, result)) = TyCon (Fun, [go arg, go result])
+    in instantiate env (go t) end
 
   fun bindType ((vars, name, constructors) : string list * string * (string * Syntax.etype option) list) (env as {bindings, boundVars, typesByName, structs} : env) : env =
     let
@@ -136,24 +157,6 @@ structure Types = struct
     | bindPat makeBinding (Syntax.PCon (_, pat)) env = bindPat makeBinding pat env
     | bindPat _ _ env = env
 
-  fun genericVars (env : env) (TyVar a) : unit TyVarMap.map =
-        if isSome (TyVarMap.lookup a (#boundVars env))
-        then TyVarMap.empty
-        else TyVarMap.fromList [(a, ())]
-    | genericVars env (TyCon (_, tys)) =
-       foldl (fn (x, acc) => TyVarMap.union acc (genericVars env x)) TyVarMap.empty tys
-    | genericVars _ (TyStruct _) = TyVarMap.empty
-
-  fun instantiate (env : env) (t : ty) : ty =
-    let
-      val genericVars = genericVars env t
-      val newVars = TyVarMap.fromList (map (fn (a, _) => (a, GenSym.new ())) (TyVarMap.toList genericVars))
-      fun replace (TyVar a) =
-            TyVar (getOpt (TyVarMap.lookup a newVars, a))
-        | replace (TyCon (n, tys)) = TyCon (n, map replace tys)
-        | replace (TyStruct structType) = TyStruct structType
-    in replace t end
-
   fun lookupBinding (name : string) (env : env) : ty =
     case StringMap.lookup name (#bindings env) of
       SOME (Let t) => instantiate env (find (TyVar t))