Resolve #1: implement lists (tuples have been done earlier)

1 files changed, 29 insertions, 0 deletions

diff --git a/Sil/Types.icl b/Sil/Types.icl
index e314342..ba13cba 100644
--- a/Sil/Types.icl
+++ b/Sil/Types.icl
@@ -33,6 +33,7 @@ where
 	toString TVoid         = "Void"
 	toString (at --> rt)   = "(" <+ at <+ " -> " <+ rt <+ ")"
 	toString (TTuple _ ts) = "(" <+ printersperse ", " ts <+ ")"
+	toString (TList t)     = "[" <+ t <+ "]"
 
 instance zero TypeSize where zero = {asize=0, bsize=0, btypes=[]}
 
@@ -41,6 +42,7 @@ typeSize TVoid        = zero
 typeSize TBool        = {zero & bsize=1, btypes=[BT_Bool]}
 typeSize TInt         = {zero & bsize=1, btypes=[BT_Int]}
 typeSize (TTuple _ _) = {zero & asize=1}
+typeSize (TList _)    = {zero & asize=1}
 
 (+~) infixl 6 :: TypeSize TypeSize -> TypeSize
 (+~) a b =
@@ -78,6 +80,13 @@ where
 		type res op >>= \top -> pure
 		( top >>= \top ->
 		  te  >>= \te  -> tryApply top te)
+	type res (BuiltinApp2 e1 Cons e2) =
+		type res e1 >>= \te1 ->
+		type res e2 >>= \te2 -> pure
+		( te1 >>= \te1 ->
+		  te2 >>= \te2 ->
+		  let top = te1 --> TList te1 --> TList te1 in
+		  foldM tryApply top [te1,te2])
 	type res (BuiltinApp2 e1 op e2) =
 		type res e1 >>= \te1 ->
 		type res e2 >>= \te2 ->
@@ -85,6 +94,17 @@ where
 		( top >>= \top ->
 		  te1 >>= \te1 ->
 		  te2 >>= \te2 -> foldM tryApply top [te1,te2])
+	type res e=:(List (Just t) es) =
+		mapM (type res) es >>= \tes -> pure
+		(sequence tes >>= \tes -> case [(e,t`) \\ e <- es & t` <- tes | t <> t`] of
+			[(e`,t`):_] -> Error $ C_TypeMisMatch t e` t`
+			[]          -> Ok $ TList t)
+	type res (List Nothing []) = Nothing
+	type res e=:(List Nothing es) =
+		mapM (type res) es >>= \tes -> pure
+		(sequence tes >>= \tes -> case removeDup tes of
+			[t]    -> Ok $ TList t
+			[_:_]  -> Error $ C_CouldNotDeduceType e)
 	type res (Tuple n es)
 	| n > 32 = Just $ Error $ T_TooHighTupleArity n
 	| otherwise =
@@ -95,6 +115,15 @@ where
 			(Ok $ es!!(tupleEl - 1))
 			(Error $ T_IllegalField f te)
 		_ -> Error $ T_IllegalField f te)
+	| f == "hd" = type res e >>= \te -> pure (te >>= \te -> case te of
+		TList t -> Ok t
+		_       -> Error $ T_IllegalField f te)
+	| f == "tl" = type res e >>= \te -> pure (te >>= \te -> case te of
+		t=:(TList _) -> Ok t
+		_            -> Error $ T_IllegalField f te)
+	| f == "nil" = type res e >>= \te -> pure (te >>= \te -> case te of
+		(TList _) -> Ok TBool
+		_         -> Error $ T_IllegalField f te)
 	| otherwise = type res e >>= \te -> pure (te >>= Error o T_IllegalField f)
 	where
 		f` = fromString f