Fix some incorrect ABC instructions

4 files changed, 26 insertions, 14 deletions

diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index 4313c0e..495f277 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -17,6 +17,7 @@ from Text import <+
 import qualified ABC.Assembler as ABC
 
 import Sil.Syntax
+import Sil.Util
 
 instance toString CompileError
 where
@@ -62,7 +63,7 @@ fresh = gets labels
 	*> pure (hd labs)
 
 reserveVar :: Int Name -> Gen Int
-reserveVar i n = modify (\cs -> {cs & addresses='M'.put n (StackAddr i) cs.addresses}) *> pure (i + 1)
+reserveVar i n = modify (\cs -> {cs & addresses='M'.put n (StackAddr i) cs.addresses}) *> pure (i+1)
 
 class gen a :: a -> Gen ()
 
@@ -72,7 +73,7 @@ where
 
 instance gen CodeBlock
 where
-	gen cb = foldM reserveVar 1 [i.init_name \\ i <- cb.cb_init] *>
+	gen cb = foldM reserveVar 0 [i.init_name \\ i <- cb.cb_init] *>
 		mapM_ gen cb.cb_init *>
 		mapM_ gen cb.cb_content
 
@@ -82,8 +83,9 @@ where
 
 instance gen Statement
 where
-	gen (Declaration n app) = gets addresses >>= \addrs -> case 'M'.get n addrs of
-		Just (StackAddr i) -> comment "Declaration" *> gen app *> tell ['ABC'.Fill_a 0 i]
+	gen st=:(Declaration n app) = gets addresses >>= \addrs -> case 'M'.get n addrs of
+		Just (StackAddr i) -> comment (toString st) *> gen app *>
+		                      tell ['ABC'.Update_a 0 $ i+1, 'ABC'.Pop_a 1]
 		Just (LabelAddr _) -> liftT $ Error VariableLabel
 		_                  -> liftT $ Error $ UndefinedName n
 	gen (Application app)   = comment "Application" *> gen app
@@ -93,11 +95,11 @@ where
 instance gen Application
 where
 	gen (Name n) = gets addresses >>= \addrs -> case 'M'.get n addrs of
-		Just (StackAddr i) -> comment "Retrieve name" *> tell ['ABC'.Push_a i]
+		Just (StackAddr i) -> tell ['ABC'.Push_a i]
 		Just (LabelAddr _) -> liftT $ Error VariableLabel
 		_                  -> liftT $ Error $ UndefinedName n
-	gen (Literal (BLit b)) = comment "Literal" *> tell ['ABC'.Create, 'ABC'.FillB b 0]
-	gen (Literal (ILit i)) = comment "Literal" *> tell ['ABC'.Create, 'ABC'.FillI i 0]
+	gen (Literal (BLit b)) = tell ['ABC'.Create, 'ABC'.FillB b 0]
+	gen (Literal (ILit i)) = tell ['ABC'.Create, 'ABC'.FillI i 0]
 	gen (App n args) = gets addresses >>= \addrs -> case 'M'.get n addrs of
 		Just (LabelAddr l) ->
 			comment "Retrieve arguments" *> mapM gen args *>
diff --git a/Sil/Util.dcl b/Sil/Util.dcl
index f3d6803..54617ce 100644
--- a/Sil/Util.dcl
+++ b/Sil/Util.dcl
@@ -21,6 +21,7 @@ instance PrettyPrinter CodeBlock
 instance PrettyPrinter Initialisation
 instance PrettyPrinter Statement
 
+instance toString Statement
 instance toString Type
 instance toString Application
 instance toString Literal
diff --git a/Sil/Util.icl b/Sil/Util.icl
index 68d8928..ad7cfac 100644
--- a/Sil/Util.icl
+++ b/Sil/Util.icl
@@ -83,13 +83,15 @@ instance PrettyPrinter Initialisation
 where
 	print st init = st <+ init.init_type <+ " " <+ init.init_name <+ ";"
 
-instance PrettyPrinter Statement
+instance PrettyPrinter Statement where print st stm = st <+ stm <+ ";"
+
+instance toString Statement
 where
-	print st (Declaration n a) = st <+ n <+ " " <+ TAssign <+ " " <+ a <+ ";"
-	print st (Application app) = st <+ app <+ ";"
-	print st (Return Nothing)  = st <+ "return;"
-	print st (Return (Just a)) = st <+ "return " <+ a <+ ";"
-	print st _                 = st <+ "<<unimplemented Statement>>"
+	toString (Declaration n a) = n <+ " " <+ TAssign <+ " " <+ a
+	toString (Application app) = toString app
+	toString (Return Nothing)  = "return"
+	toString (Return (Just a)) = "return " <+ a <+ ""
+	toString _                 = "<<unimplemented Statement>>"
 
 instance toString Type
 where
diff --git a/test.sil b/test.sil
index 8f6b371..db3abaf 100644
--- a/test.sil
+++ b/test.sil
@@ -1,5 +1,12 @@
 Int main () {
 	Int x;
+	Int y;
+	Int z;
 	x := 100;
-	return x;
+	y := 50;
+	z := x;
+	x := y;
+	y := z;
+	z := x;
+	return z;
 }