Implement basic uses of locals

3 files changed, 56 insertions, 26 deletions

diff --git a/snug-clean/src/Snug/Compile.icl b/snug-clean/src/Snug/Compile.icl
index 757b9c3..15e2aa8 100644
--- a/snug-clean/src/Snug/Compile.icl
+++ b/snug-clean/src/Snug/Compile.icl
@@ -13,11 +13,9 @@ import Snug.Compile.ABI
 import Snug.Compile.Simulate
 import Snug.Syntax
 
-:: Locals :== Map SymbolIdent MemoryLocation
+:: Locals :== Map SymbolIdent LocalLocation
 
-:: MemoryLocation
-	= InRegister !Register
-	| Indirect !Register !Offset
+:: LocalLocation = FrontPtrArg !Int
 
 instance == (Namespaced id) | == id
 where
@@ -97,9 +95,9 @@ compileDefinition ns globals (FunDef id args ret expr) =
 where
 	label = functionLabel ns NodeEntry id
 	locals = 'Data.Map'.fromList
-		[ (id, Indirect FrontEvalPtr (offset*4))
+		[ (id, FrontPtrArg offset)
 		\\ (id,_) <- args
-		& offset <- [1..]
+		& offset <- [0..]
 		]
 
 compileConstructor :: !Namespace !Globals !ConstructorDef -> [Line]
@@ -115,7 +113,7 @@ where
 	label = constructorLabel ns id
 
 compileExpr :: !Namespace !Globals !Locals !Expression -> [Instruction]
-compileExpr ns globals locals expr = simulate $
+compileExpr ns globals locals expr = simulate [SVRegOffset FrontEvalPtr 0] $
 	simulator ns globals locals expr >>|
 	indirectAndEval
 
@@ -126,15 +124,19 @@ simulator _ _ _ (BasicValue bv) =
 where
 	label (BVInt _) = "INT"
 	label (BVChar _) = "CHAR"
-simulator ns globals locals (Symbol id) = // TODO include locals
-	case lookupFunction ns id globals of
-		?None -> abort ("unknown symbol: " +++ id +++ "\n") // TODO pass error up
-		?Just info ->
-			case info.arity of
-				0 ->
-					buildThunk (functionLabel ns NodeEntry id) 0
-				_ ->
-					abort "symbol with arity > 0\n" // TODO implement
+simulator ns globals locals (Symbol id) =
+	case 'Data.Map'.get id locals of
+		?Just (FrontPtrArg i) ->
+			stackSize >>= \n ->
+			pushArg (n-1) i
+		?None -> case lookupFunction ns id globals of
+			?None -> abort ("unknown symbol: " +++ id +++ "\n") // TODO pass error up
+			?Just info ->
+				case info.arity of
+					0 ->
+						buildThunk (functionLabel ns NodeEntry id) 0
+					_ ->
+						abort "symbol with arity > 0\n" // TODO implement
 simulator ns globals locals expr=:(ExpApp _ _) =
 	case f of
 		Symbol id -> // TODO include locals
diff --git a/snug-clean/src/Snug/Compile/Simulate.dcl b/snug-clean/src/Snug/Compile/Simulate.dcl
index a36dc0d..bf01675 100644
--- a/snug-clean/src/Snug/Compile/Simulate.dcl
+++ b/snug-clean/src/Snug/Compile/Simulate.dcl
@@ -9,14 +9,24 @@ from Control.Monad.State import :: State, :: StateT,
 	instance pure (StateT s m), instance <*> (StateT s m)
 from Data.Functor import class Functor
 
-from MIPS.MIPS32 import :: Instruction, :: Label
+from MIPS.MIPS32 import :: Immediate, :: Instruction, :: Label, :: Offset,
+	:: Register
 from Snug.Syntax import :: BasicValue
 
 :: Simulator a :== State SimulationState a
 
 :: SimulationState
 
-simulate :: !(Simulator a) -> [Instruction]
+:: StackValue
+	= SVIndirect !Offset !Register //* value stored in reg + offset
+	| SVRegOffset !Register !Offset //* value is reg + offset
+
+	/* for internal use only: */
+	| SVImmediate !Immediate
+
+simulate :: ![StackValue] !(Simulator a) -> [Instruction]
+
+stackSize :: Simulator Int
 
 //* Build a constructor node with *n* arguments and push it to the stack.
 buildCons :: !Label !Int -> Simulator ()
@@ -27,6 +37,13 @@ buildThunk :: !Label !Int -> Simulator ()
 pushBasicValue :: !BasicValue -> Simulator ()
 
 /**
+ * Push the *j*th argument of the *i*th element on the stack onto the stack.
+ * @param *i*
+ * @param *j*
+ */
+pushArg :: !Int !Int -> Simulator ()
+
+/**
  * Overwrite the node currently under evaluation with an indirection to the
  * node on top of the stack, and continue evaluating that node instead.
  */
diff --git a/snug-clean/src/Snug/Compile/Simulate.icl b/snug-clean/src/Snug/Compile/Simulate.icl
index b383936..672b47e 100644
--- a/snug-clean/src/Snug/Compile/Simulate.icl
+++ b/snug-clean/src/Snug/Compile/Simulate.icl
@@ -17,22 +17,20 @@ import Snug.Syntax
 	, stack     :: ![StackValue]
 	}
 
-:: StackValue
-	= SVImmediate !Immediate
-	| SVRegOffset !Register !Offset /* value is reg + offset */
-
-simulate :: !(Simulator a) -> [Instruction]
-simulate sim = flatten (reverse (execState sim initial).instrs)
+simulate :: ![StackValue] !(Simulator a) -> [Instruction]
+simulate stack sim = flatten (reverse (execState sim initial).instrs)
 where
 	// TODO: when finishing:
 	// - check that the stack is empty
-	// - update heap pointer
 	initial =
 		{ instrs = []
 		, hp_offset = 0
-		, stack = []
+		, stack = stack
 		}
 
+stackSize :: Simulator Int
+stackSize = gets \s -> length s.stack
+
 add :: ![Instruction] -> Simulator ()
 add is = modify \s -> {s & instrs=[is:s.instrs]}
 
@@ -80,6 +78,10 @@ storeStackValue (SVRegOffset reg offset) doffset dreg = add
 	[ AddImmediate Signed TempImm reg (Immediate offset)
 	, StoreWord TempImm doffset dreg
 	]
+storeStackValue (SVIndirect offset reg) doffset dreg = add
+	[ LoadWord TempImm offset reg
+	, StoreWord TempImm doffset dreg
+	]
 
 buildCons :: !Label !Int -> Simulator ()
 buildCons cons nargs =
@@ -104,6 +106,15 @@ where
 		BVInt i -> i
 		BVChar c -> toInt c
 
+pushArg :: !Int !Int -> Simulator ()
+pushArg i j =
+	getState >>= \{stack} ->
+	case stack !! i of
+		SVRegOffset reg offset ->
+			push (SVIndirect (offset + (j+1)*4) reg)
+		_ ->
+			abort "unexpected reference in pushArg\n"
+
 indirectAndEval :: Simulator ()
 indirectAndEval =
 	pop >>= \sv ->