From f8726ca2b0b6d1de65e08dc2d68bc6128753c49c Mon Sep 17 00:00:00 2001
From: pimjager <pim@pimjager.nl>
Date: Fri, 20 May 2016 13:08:46 +0200
Subject: [PATCH] Typechecking of fieldselectors

---
 examples/codeGen.spl | 21 ++++++++++++---------
 sem.icl              | 27 +++++++++++++++++++++------
 2 files changed, 33 insertions(+), 15 deletions(-)

diff --git a/examples/codeGen.spl b/examples/codeGen.spl
index e92260f..05773b3 100644
--- a/examples/codeGen.spl
+++ b/examples/codeGen.spl
@@ -18,13 +18,13 @@
 //    return x3 + x1;
 //}
 
-isE(x) :: [a] -> Bool {
-    if (x == []) {
-        return True;
-    } else {
-        return False;
-    }
-}
+//isE(x) :: [a] -> Bool {
+//    if (x == []) {
+//        return True;
+//    } else {
+//        return False;
+//    }
+//}
 
 main() {
  //   [Int] x2 = 0 : x1;
@@ -33,6 +33,9 @@ main() {
  //   //Bool y1 = isEmpty(x2); //gives weird type error, not sure why
 //    isEmpty(x2);
     [Int] x1 = 8 : 2 : [];
-	isE(True).hd;
-    return x1.hd;
+    (Bool, Int) z = (True, 2);
+	var y = z.fst;
+    var x = (True, 5);
+    x.snd = 8;
+    return;
 }
diff --git a/sem.icl b/sem.icl
index 85d3ac1..833d543 100644
--- a/sem.icl
+++ b/sem.icl
@@ -192,9 +192,9 @@ class infer a :: a -> Typing (Substitution, Type)
 
 instance infer Expr where 
  infer e = case e of
-    VarExpr _ (VarDef k fs) = (\t->(zero,t)) <$> lookup k
-    //instantiate is key for the let polymorphism!
-    //TODO: field selectors
+    VarExpr _ (VarDef k fs) = lookup k >>= \t ->
+        foldM foldFieldSelectors t fs >>= \finalT ->
+        pure (zero, finalT)
 
     Op2Expr _ e1 op e2 =
         infer e1 >>= \(s1, t1) -> 
@@ -227,12 +227,20 @@ instance infer Expr where
         fresh >>= \tv->
         let given = foldr (->>) tv argTs in
         lift (unify expected given) >>= \s2->
-        pure (compose s2 s1, subst s2 tv)
+        let fReturnType = subst s2 tv in
+        foldM foldFieldSelectors fReturnType fs >>= \returnType ->
+        pure (compose s2 s1, returnType)
 
     IntExpr _ _ = pure $ (zero, IntType)
     BoolExpr _ _ = pure $ (zero, BoolType)
     CharExpr _ _ = pure $ (zero, CharType)
 
+foldFieldSelectors :: Type FieldSelector -> Typing Type 
+foldFieldSelectors (ListType t) (FieldHd) = pure t
+foldFieldSelectors t=:(ListType _) (FieldTl) = pure t 
+foldFieldSelectors (TupleType (t1, _)) (FieldFst) = pure t1
+foldFieldSelectors (TupleType (_, t2)) (FieldSnd) = pure t2
+foldFieldSelectors t fs = liftT $ Left $ FieldSelectorError zero t fs
 
 op2Type :: Op2 -> Typing Type
 op2Type op
@@ -278,10 +286,11 @@ instance infer Stmt where
     AssStmt (VarDef k fs) e =
         lookup k >>= \expected ->
         infer e >>= \(s1, given)->
-        lift (unify expected given) >>= \s2->
+        foldM reverseFs given (reverse fs) >>= \varType->
+        lift (unify expected varType) >>= \s2->
         let s = compose s2 s1 in
         applySubst s >>|
-        changeGamma (extend k (Forall [] given)) >>| //todo: fieldselectors
+        changeGamma (extend k (Forall [] (subst s varType))) >>| 
         pure (s, VoidType)
 
     FunStmt f es _ = pure (zero, VoidType) 
@@ -289,6 +298,12 @@ instance infer Stmt where
     ReturnStmt Nothing = pure (zero, VoidType)
     ReturnStmt (Just e) = infer e
 
+reverseFs :: Type FieldSelector -> Typing Type 
+reverseFs t FieldHd = pure $ ListType t
+reverseFs t FieldTl = pure $ ListType t 
+reverseFs t FieldFst = fresh >>= \tv -> pure $ TupleType (t, tv)
+reverseFs t FieldSnd = fresh >>= \tv -> pure $ TupleType (tv, t)
+
 //The type of a list of statements is either an encountered
 //return, or VoidType
 instance infer [a] | infer a where
-- 
2.20.1