diff options
Diffstat (limited to 'snug-clean/src/Snug/Compile.icl')
| -rw-r--r-- | snug-clean/src/Snug/Compile.icl | 67 |
1 files changed, 15 insertions, 52 deletions
diff --git a/snug-clean/src/Snug/Compile.icl b/snug-clean/src/Snug/Compile.icl index 2a9d9e4..26fd5af 100644 --- a/snug-clean/src/Snug/Compile.icl +++ b/snug-clean/src/Snug/Compile.icl @@ -2,12 +2,15 @@ implementation module Snug.Compile import StdEnv +import Control.Monad +import Data.Func import Data.List import qualified Data.Map from Data.Map import :: Map -import Text import MIPS.MIPS32 +import Snug.Compile.ABI +import Snug.Compile.Simulate import Snug.Syntax :: Locals :== Map SymbolIdent MemoryLocation @@ -16,15 +19,6 @@ import Snug.Syntax = InRegister !Register | Indirect !Register !Offset -:: EntryPoint - = NodeEntry - -BackPrintPtr :== S 0 -FrontPrintPtr :== S 1 -BackEvalPtr :== S 2 -FrontEvalPtr :== S 3 -HeapPtr :== GP - instance == (Namespaced id) | == id where (==) x y = x.id == y.id && x.ns == y.ns @@ -79,52 +73,21 @@ compileConstructor ns _ (ConstructorDef id args) = ] compileExpr :: !Namespace !Globals !Locals !Expression -> [Instruction] -compileExpr _ _ _ (BasicValue bv) = - // Build new node - [ LoadAddress (T 0) (Address 2 (constructorLabel "" (label bv))) - , StoreWord (T 0) 0 HeapPtr - ] ++ - loadImmediate bv ++ - [ StoreWord (T 0) 4 HeapPtr - // Overwrite old node with indirection - , LoadAddress (T 0) (Address 0 (functionLabel "" NodeEntry "indir")) - , StoreWord (T 0) 0 FrontEvalPtr - , StoreWord HeapPtr 4 FrontEvalPtr - // Update front and heap pointers; return - , Move FrontEvalPtr HeapPtr - , Jump NoLink (Direct (Address 0 "eval")) - , AddImmediate Signed GP GP (Immediate 8) - ] +compileExpr ns globals locals expr = simulate $ + simulator ns globals locals expr >>| + indirectAndEval + +simulator :: !Namespace !Globals !Locals !Expression -> Simulator () +simulator _ _ _ (BasicValue bv) = + pushBasicValue bv >>| + buildCons (constructorLabel "" (label bv)) 1 where label (BVInt _) = "INT" label (BVChar _) = "CHAR" - - loadImmediate (BVInt i) - | 0 <= i && i < 0x10000 = - [ OrImmediate (T 0) R0 (Immediate i) - ] - | 0 > i && i >= -0x8000 = - [ AddImmediate Signed (T 0) R0 (Immediate i) - ] - | otherwise = - [ LoadUpperImmediate (T 0) (Immediate (i >> 16)) - , OrImmediate (T 0) (T 0) (Immediate (i bitand 0xffff)) - ] -compileExpr _ _ _ _ = [Nop]// TODO +simulator _ _ _ _ = // TODO + pushBasicValue (BVInt 0) >>| + buildCons (constructorLabel "" "INT") 1 // | Symbol !SymbolIdent // | Constructor !ConstructorIdent // | Case !Expression ![CaseAlternative] // | ExpApp !Expression !Expression - -constructorLabel :: !Namespace !ConstructorIdent -> Label -constructorLabel "" id = "_c" +++ id // for built-in constructors -constructorLabel ns id = concat4 "__" ns "_c" id // TODO escaping - -functionLabel :: !Namespace !EntryPoint !ConstructorIdent -> Label -functionLabel ns entry_point id // TODO escaping - | size ns == 0 - = {#'_',e} +++ id - = concat4 "__" ns {#'_',e} id -where - e = case entry_point of - NodeEntry -> 'n' |