From ea4794ccdc9d0d8709ba22e43494e392b48be768 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Thu, 27 Jul 2017 13:05:23 +0200
Subject: Resolve #4: mandatory initial values for basic locals

---
 Sil/Compile.icl | 44 ++++++++++++++++++++++++++------------------
 1 file changed, 26 insertions(+), 18 deletions(-)

(limited to 'Sil/Compile.icl')

diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index 9bfd4f5..254cc67 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -28,13 +28,14 @@ import Sil.Util.Printer
 
 instance toString CompileError
 where
-	toString (UndefinedName n)      = "Undefined name '" <+ n <+ "'."
-	toString VariableLabel          = "Variable stored at label."
-	toString FunctionOnStack        = "Function stored on the stack."
-	toString (TypeError err e)      = "Type error in '" <+ e <+ "': " <+ err
-	toString (CouldNotDeduceType e) = "Could not deduce type of '" <+ e <+ "'."
-	toString (TypeMisMatch t e)     = "Type mismatch: expected " <+ t <+ " for '" <+ e <+ "'."
-	toString UnknownError           = "Unknown error."
+	toString (UndefinedName n)         = "Undefined name '" <+ n <+ "'."
+	toString VariableLabel             = "Variable stored at label."
+	toString FunctionOnStack           = "Function stored on the stack."
+	toString (TypeError err e)         = "Type error in '" <+ e <+ "': " <+ err
+	toString (CouldNotDeduceType e)    = "Could not deduce type of '" <+ e <+ "'."
+	toString (TypeMisMatch t e)        = "Type mismatch: expected " <+ t <+ " for '" <+ e <+ "'."
+	toString (BasicInitWithoutValue n) = "Basic value '" <+ n <+ "' must have an initial value."
+	toString UnknownError              = "Unknown error."
 
 error :: CompileError -> RWST r w s (MaybeError CompileError) a
 error e = RWST \_ _ -> Error e
@@ -164,8 +165,8 @@ getTypeResolver = gets typeresolvers >>= \trs -> pure $ \n ->
 		[t:_] -> Just t
 		[]    -> Nothing
 
-reserveVar :: Bool (Name, Type) -> Gen Address
-reserveVar canBeOnBStack (n,t) = gets stackoffsets >>= put
+reserveVar :: (Name, Type) -> Gen Address
+reserveVar (n,t) = gets stackoffsets >>= put
 where
 	put :: (Int, Int) -> Gen Address
 	put (aso, bso) =
@@ -173,10 +174,9 @@ where
 		comment ("Reserved " <+ addr <+ " for " <+ n) $>
 		addr
 	where
-		(so`, addr) = case (canBeOnBStack, typeSize t) of
-			(False, _)        -> ((aso+1, bso), AAddr $ aso+1)
-			(True, {bsize=0}) -> ((aso+1, bso), AAddr $ aso+1)
-			(True, {btypes})  -> ((aso, bso + length btypes), BAddr $ bso+1)
+		(so`, addr) = case typeSize t of
+			{asize,bsize=0} -> ((aso + asize, bso), AAddr $ aso + asize)
+			{asize=0,bsize} -> ((aso, bso + bsize), BAddr $ bso + bsize)
 
 findVar :: Name -> Gen Address
 findVar n = gets stackoffsets >>= \(aso, bso) ->
@@ -253,7 +253,7 @@ where
 		     , 'ABC'.Label $ toLabel f.f_name
 		     ] *>
 		tell (repeatn retSize.asize 'ABC'.Create) *> growStack {retSize & bsize=0} *>
-		mapM_ (reserveVar True) [(a.arg_name, a.arg_type) \\ a <- f.f_args] *>
+		mapM_ reserveVar [(a.arg_name, a.arg_type) \\ a <- f.f_args] *>
 		newReturn cleanup` *>
 		pushTypeResolver typeresolver *>
 		setReturnType f.f_type *>
@@ -303,7 +303,7 @@ where
 	gen cb =
 		storeStackOffsets *>
 		gets stackoffsets >>= \so ->
-		mapM_ (reserveVar False) [(i.init_name, i.init_type) \\ i <- cb.cb_init] *>
+		mapM_ reserveVar [(i.init_name, i.init_type) \\ i <- cb.cb_init] *>
 		mapM_ gen cb.cb_init *>
 		addToReturn cleanup` *>
 		pushTypeResolver typeresolver *>
@@ -315,13 +315,21 @@ where
 	where
 		cleanup` = case cb.cb_init of
 			[] -> []
-			_  -> [ 'ABC'.Pop_a locals ]
-		locals = length cb.cb_init
+			_  -> [ 'ABC'.Pop_a locals.asize
+			      , 'ABC'.Pop_b locals.bsize
+			      ]
+		locals = foldr (+~) zero [typeSize i.init_type \\ i <- cb.cb_init]
 
 		typeresolver :: Name -> Maybe (MaybeError TypeError Type)
 		typeresolver n = listToMaybe [Ok i.init_type \\ i <- cb.cb_init | i.init_name == n]
 
-instance gen Initialisation where gen init = tell ['ABC'.Create]
+instance gen Initialisation
+where
+	gen init = case typeSize init.init_type of
+		s=:{bsize=0} -> tell $ repeatn s.asize 'ABC'.Create
+		s=:{asize=0} -> case init.init_value of
+			Nothing -> error $ BasicInitWithoutValue init.init_name
+			Just v  -> gen v *> shrinkStack s
 
 instance gen Statement
 where
-- 
cgit v1.2.3