From cd0bd63e34320d315e442e341274e83a232d5f77 Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Tue, 5 Mar 2019 15:14:43 +0100
Subject: [PATCH] cleanup

---
 check.dcl | 10 ++++------
 check.icl | 42 ++++++++++++++++++------------------------
 main.icl  |  6 +++---
 3 files changed, 25 insertions(+), 33 deletions(-)

diff --git a/check.dcl b/check.dcl
index a26c31b..322bd4a 100644
--- 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
--- 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
--- 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
-- 
2.20.1