cleanup

diff --git a/check.dcl b/check.dcl
index a26c31b..322bd4a 100644 (file)
--- a/check.dcl
+++ b/check.dcl
@@ -5,10 +5,8 @@ from Data.Either import :: Either
 from ast import :: Function, :: Expression
 
 :: Scheme = Forall [[Char]] Type
-:: Type
-       = TVar [Char]
-       | TInt
-       | TBool
-       | TFun Type Type
+:: Type = TVar [Char] | TInt | TBool | TFun Type Type
+
 instance toString Scheme, Type
-check :: [Function] -> Either [String] Expression
+
+check :: [Function] -> Either [String] (Expression, Scheme)

diff --git a/check.icl b/check.icl
index 7ed87b2..3800632 100644 (file)
--- a/check.icl
+++ b/check.icl
@@ -2,23 +2,19 @@ implementation module check
 
 import StdEnv
 
+import Control.Monad => qualified join
+import Control.Monad.State
+import Control.Monad.Trans
 import Data.Either
-import Data.List
-import Data.Functor
 import Data.Func
+import Data.List
+import Data.Map => qualified put, union, difference, find, updateAt
 import Data.Maybe
-import Data.Tuple
-import Control.Monad => qualified join
-import Control.Monad.Trans
-import Control.Monad.State
 import Text
 
-import qualified Data.Map
-from Data.Map import :: Map(..), newMap, get, instance Functor (Map k)
-
 import ast
 
-check :: [Function] -> Either [String] Expression
+check :: [Function] -> Either [String] (Expression, Scheme)
 check fs
        # dups = filter (\x->length x > 1) (groupBy (\(Function i _ _) (Function j _ _)->i == j) fs)
        | length dups > 0 = Left ["Duplicate functions: ":[toString n\\[(Function n _ _):_]<-dups]]
@@ -26,9 +22,7 @@ check fs
                ([], _) = Left ["No start function defined"]
                ([Function _ [] e], fs)
                        # e = foldr (\(Function i a e)->Let i (foldr ((o) o Lambda) id a e)) e fs
-                       = case runInfer (infer newMap e) of
-                               Left e = Left e
-                               Right s = Left [toString s]
+                       = (\x->(e, x)) <$> runInfer (infer newMap e)
                ([Function _ _ _], _) = Left ["Start cannot have arguments"]
 
 instance toString Scheme where
@@ -68,12 +62,12 @@ instance Substitutable Type where
        ftv _ = []
 
 instance Substitutable Scheme where
-       apply s (Forall as t) = Forall as $ apply (foldr 'Data.Map'.del s as) t
+       apply s (Forall as t) = Forall as $ apply (foldr del s as) t
        ftv (Forall as t) = difference (ftv t) (removeDup as)
 
 instance Substitutable TypeEnv where
        apply s env = apply s <$> env
-       ftv env = ftv ('Data.Map'.elems env)
+       ftv env = ftv (elems env)
 
 instance Substitutable [a] | Substitutable a where
        apply s l = apply s <$>  l
@@ -89,30 +83,30 @@ unify (TFun l r) (TFun l` r`)
        >>= \s2->pure (compose s1 s2)
 unify (TVar a) t = bind a t
 unify t (TVar a) = bind a t
-unify TInt TInt = pure 'Data.Map'.newMap
-unify TBool TBool = pure 'Data.Map'.newMap
+unify TInt TInt = pure newMap
+unify TBool TBool = pure newMap
 unify t1 t2 = liftT (Left ["Cannot unify: ", toString t1, " with ", toString t2])
 
 bind :: [Char] Type -> Infer Subst
-bind a (TVar t) | a == t = pure 'Data.Map'.newMap
+bind a (TVar t) | a == t = pure newMap
 bind a t
        | occursCheck a t = liftT (Left ["Infinite type: ", toString a, " and ", toString t])
-       = pure ('Data.Map'.singleton a t)
+       = pure (singleton a t)
 
 instantiate :: Scheme -> Infer Type
 instantiate (Forall as t)
        =         sequence [fresh\\_<-as]
-       >>= \as`->pure (apply ('Data.Map'.fromList $ zip2 as as`) t)
+       >>= \as`->pure (apply (fromList $ zip2 as as`) t)
 
 generalize :: TypeEnv Type -> Scheme
 generalize env t = Forall (difference (ftv t) (ftv env)) t
 
 infer :: TypeEnv Expression -> Infer (Subst, Type)
-infer env (Lit (Int _)) = pure ('Data.Map'.newMap, TInt)
-infer env (Lit (Bool _)) = pure ('Data.Map'.newMap, TBool)
-infer env (Var x) = case 'Data.Map'.get x env of
+infer env (Lit (Int _)) = pure (newMap, TInt)
+infer env (Lit (Bool _)) = pure (newMap, TBool)
+infer env (Var x) = case get x env of
        Nothing = liftT (Left ["Unbound variable: ", toString x])
-       Just s = tuple 'Data.Map'.newMap <$> instantiate s
+       Just s = (\x->(newMap, x)) <$> instantiate s
 infer env (App e1 e2)
        =              fresh
        >>= \tv->      infer env e1

diff --git a/main.icl b/main.icl
index e533a4e..a13f267 100644 (file)
--- a/main.icl
+++ b/main.icl
@@ -46,6 +46,6 @@ Start w
                MHelp = Left [usageInfo ("Usage: " +++ argv0 +++ " [opts]\n") opts]
                MLex = map (\x->toString x +++ "\n") <$> lex cs
                MParse = map (\x->toString x +++ "\n") <$> (lex cs >>= parse)
-               MType = (\x->[toString x]) <$> (lex cs >>= parse >>= check)
-               MInterpret = (\x->[toString x]) <$> (lex cs >>= parse >>= check >>= int)
-               MGen = lex cs >>= parse >>= check >>= gen
+               MType = (\(e, x)->[toString x, "\n", toString e]) <$> (lex cs >>= parse >>= check)
+               MInterpret = (\x->[toString x]) <$> (lex cs >>= parse >>= check >>= int o fst)
+               MGen = lex cs >>= parse >>= check >>= gen o fst