Add tuples (see #1)

1 files changed, 53 insertions, 21 deletions

diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index cad8000..2a6ba54 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -1,5 +1,6 @@
 implementation module Sil.Compile
 
+import StdBool
 import StdEnum
 from StdFunc import const, flip, o
 import StdList
@@ -212,17 +213,17 @@ where
 	invert :: TypeSize -> TypeSize
 	invert ts = {zero & asize=0-ts.asize, bsize=0-ts.bsize}
 
-checkType :: Type Expression -> Gen ()
-checkType t e = getTypeResolver >>= \tr -> case type tr e of
+getType :: Expression -> Gen Type
+getType e = getTypeResolver >>= \tr -> case type tr e of
 	Nothing          -> error $ CouldNotDeduceType e
 	Just (Error err) -> error $ TypeError err e
-	Just (Ok t`)     -> if (t == t`) nop (error $ TypeMisMatch t e)
+	Just (Ok t)      -> pure $ t
+
+checkType :: Type Expression -> Gen ()
+checkType t e = getType e >>= \t` -> if (t == t`) nop (error $ TypeMisMatch t e)
 
 checkTypeName :: Name Expression -> Gen Type
-checkTypeName n e = getTypeResolver >>= \tr -> case type tr n of
-	Nothing          -> error $ CouldNotDeduceType $ Name n
-	Just (Error err) -> error $ TypeError err $ Name n
-	Just (Ok t`)     -> checkType t` e $> t`
+checkTypeName n e = getType (Name n) >>= \t` -> checkType t` e $> t`
 
 class gen a :: a -> Gen ()
 
@@ -254,8 +255,9 @@ where
 		tell [ 'ABC'.Annotation $ toOAnnot` [typeSize a.arg_type \\ a <- f.f_args]
 		     , 'ABC'.Label $ toLabel f.f_name
 		     ] *>
-		tell (repeatn retSize.asize 'ABC'.Create) *> growStack {retSize & bsize=0} *>
+		tell (repeatn retSize.asize 'ABC'.Create) *>
 		mapM_ reserveVar [(a.arg_name, a.arg_type) \\ a <- f.f_args] *>
+		growStack {retSize & bsize=0} *>
 		newReturn cleanup` *>
 		pushTypeResolver typeresolver *>
 		setReturnType f.f_type *>
@@ -448,16 +450,18 @@ where
 				     ] *>
 				growStack (foldl (-~) (typeSize fs.fs_rettype) $ map typeSize fs.fs_argtypes)
 			_ -> liftT $ Error $ UndefinedName n
-	gen (BuiltinApp op arg) = genToBStack arg *> gen op
+	gen (BuiltinApp op arg) =
+		gen arg *>
+		gen op
 	gen (BuiltinApp2 e1 LogOr e2) =
 		checkType TBool e1 *>
 		checkType TBool e2 *>
 		fresh "or_true" >>= \true ->
 		fresh "or_end" >>= \end ->
 		storeStackOffsets *>
-		genToBStack e1 *>
+		gen e1 *>
 		tell [ 'ABC'.JmpTrue true ] *>
-		genToBStack e2 *>
+		gen e2 *>
 		tell [ 'ABC'.Jmp end ] *>
 		restoreStackOffsets *>
 		tell [ 'ABC'.Label true
@@ -470,24 +474,44 @@ where
 		fresh "and_false" >>= \false ->
 		fresh "and_end" >>= \end ->
 		storeStackOffsets *>
-		genToBStack e1 *>
+		gen e1 *>
 		tell [ 'ABC'.JmpFalse false ] *>
-		genToBStack e2 *>
+		gen e2 *>
 		tell [ 'ABC'.Jmp end ] *>
 		restoreStackOffsets *>
 		tell [ 'ABC'.Label false
 		     , 'ABC'.PushB False ] *>
 		growStack {zero & bsize=1} *>
 		tell [ 'ABC'.Label end ]
-	gen (BuiltinApp2 e1 op e2) = mapM genToBStack [e2,e1] *> gen op
+	gen (BuiltinApp2 e1 op e2) =
+		mapM gen [e2,e1] *>
+		gen op
+	gen (Tuple i es) =
+		comment "Building tuple" *>
+		tell [ 'ABC'.Create ] *>
+		growStack {zero & asize=1} *>
+		mapM genToAStack (reverse es) *>
+		tell [ 'ABC'.Raw $ "\tfillh\t_Tuple\t" <+ i <+ "\t" <+ i ] *>
+		shrinkStack {zero & asize=i}
+	gen e=:(Field f e`)
+	| isTuple =
+		getType e` >>= \(TTuple arity tes) ->
+		gen e` *>
+		tell [ 'ABC'.ReplArgs arity arity
+		     , 'ABC'.Pop_a (tupleEl - 1)
+		     , 'ABC'.Update_a 0 (arity - tupleEl)
+		     , 'ABC'.Pop_a (arity - tupleEl)
+		     ] *>
+		case typeSize $ tes!!(tupleEl - 1) of
+			{bsize=0} -> nop
+			{btypes} -> mapM (flip toBStack 1) btypes *> nop
+	| otherwise =
+		error $ UndefinedField f
+	where
+		f` = fromString f
 
-genToBStack :: Expression -> Gen ()
-genToBStack (Name n) = findVar n >>= getLoc
-where
-	getLoc :: Address -> Gen ()
-	getLoc (AAddr i) = tell ['ABC'.PushI_a $ i] *> growStack {zero & bsize=1}
-	getLoc (BAddr i) = tell ['ABC'.Push_b  $ i] *> growStack {zero & bsize=1}
-genToBStack e = gen e
+		isTuple = length f` >= 2 && hd f` == '_' && all isDigit (tl f`)
+		tupleEl = toInt $ toString $ tl f`
 
 instance gen Op1
 where
@@ -539,6 +563,14 @@ where
 		'ABC'.BT_Bool -> 'ABC'.FillB_b
 		'ABC'.BT_Int  -> 'ABC'.FillI_b
 
+genToAStack :: Expression -> Gen ()
+genToAStack (Literal (BLit b)) = tell [ 'ABC'.Raw $ "\tbuildB\t" <+ toABCBool b ] *> growStack {zero & asize=1}
+where toABCBool = toString o map toUpper o fromString o toString
+genToAStack (Literal (ILit i)) = tell [ 'ABC'.Raw $ "\tbuildI\t" <+ i ] *> growStack {zero & asize=1}
+genToAStack e = getType e >>= \t -> case typeSize t of
+	{bsize=0} -> gen e
+	{btypes}  -> gen e <* comment "To A-stack" <* mapM BtoAStack btypes <* comment "Done to A-stack"
+
 comment :: String -> Gen ()
 comment s = tell ['ABC'.Comment s]