something something tuples

[minfp.git] / check.icl

diff --git a/check.icl b/check.icl
index a18a378..574c178 100644 (file)
--- a/check.icl
+++ b/check.icl
@@ -14,7 +14,7 @@ import Data.Map => qualified put, union, difference, find, updateAt
 import Data.Maybe
 import Text
 
-import ast, scc, builtin
+import ast, scc
 
 check :: [Function] -> Either [String] (Expression, [([Char], Scheme)])
 check fs
@@ -26,6 +26,16 @@ check fs
                        # e = makeExpression fs e
                        = (\x->(e, x)) <$> runInfer (infer (fromList builtin) e)
                ([Function _ _ _:_], _) = Left ["Start cannot have arguments"]
+where
+       builtin =
+               [(['_if'],  Forall [['a']] $ TBool --> TVar ['a'] --> TVar ['a'] --> TVar ['a'])
+               ,(['_fst'], Forall [['a'], ['b']] $ TTuple (TVar ['a']) (TVar ['b']) --> TVar ['a'])
+               ,(['_snd'], Forall [['a'], ['b']] $ TTuple (TVar ['a']) (TVar ['b']) --> TVar ['b'])
+               ,(['_eq'],  Forall [] $ TInt --> TInt --> TBool)
+               ,(['_mul'], Forall [] $ TInt --> TInt --> TInt)
+               ,(['_add'], Forall [] $ TInt --> TInt --> TInt)
+               ,(['_sub'], Forall [] $ TInt --> TInt --> TInt)
+               ]
 
 makeExpression :: [Function] Expression -> Expression
 makeExpression fs start = foldr mkExpr start $ scc [(l, vars e [])\\(l, e)<-nicefuns]
@@ -51,6 +61,7 @@ instance toString Scheme where
 
 instance toString Type where
        toString (TVar a) = toString a
+       toString (TTuple a b) = concat ["(", toString a, ",", toString b, ")"]
        toString TInt = "Int"
        toString TBool = "Bool"
        toString (a --> b) = concat ["(", toString a, " -> ", toString b, ")"]
@@ -115,6 +126,10 @@ unify (TVar a) t
 unify t (TVar a) = unify (TVar a) t
 unify TInt TInt = pure newMap
 unify TBool TBool = pure newMap
+unify (TTuple l r) (TTuple l` r`)
+       = unify l l`
+       >>= \s1->on unify (apply s1) r r`
+       >>= \s2->pure (s1 oo s2)
 unify t1 t2 = err ["Cannot unify: ", toString t1, " with ", toString t2]
 
 unifyl :: [Type] -> Infer Subst
@@ -140,6 +155,10 @@ infer env (App e1 e2)
        >>= \(s1, t1)->infer (apply s1 env) e2
        >>= \(s2, t2)->unify (apply s2 t1) (t2 --> tv)
        >>= \s3->      pure (s3 oo s2 oo s1, apply s3 tv)
+infer env (Tuple a b)
+       =              infer env a
+       >>= \(s1, t1)->infer env b
+       >>= \(s2, t2)->pure (s1 oo s2, TTuple t1 t2)
 infer env (Lambda x b)
        =              fresh
        >>= \tv->      infer ('Data.Map'.put x (Forall [] tv) env) b