diff options
Diffstat (limited to 'snug-clean/src/Snug/Compile.icl')
| -rw-r--r-- | snug-clean/src/Snug/Compile.icl | 34 |
1 files changed, 18 insertions, 16 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 |