From 5d2f367ea59f5813b95800fcaab1e4d5e16d4a88 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Wed, 1 Feb 2023 21:24:05 +0100
Subject: Implement basic uses of locals
---
snug-clean/src/Snug/Compile.icl | 34 +++++++++++++++++---------------
snug-clean/src/Snug/Compile/Simulate.dcl | 21 ++++++++++++++++++--
snug-clean/src/Snug/Compile/Simulate.icl | 27 +++++++++++++++++--------
3 files changed, 56 insertions(+), 26 deletions(-)
(limited to 'snug-clean/src/Snug')
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 ()
@@ -26,6 +36,13 @@ buildThunk :: !Label !Int -> Simulator ()
//* Push a basic value to the stack.
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 ->
--
cgit v1.2.3