diff options
| -rw-r--r-- | snug-clean/src/Snug/Compile.icl | 10 | ||||
| -rw-r--r-- | snug-clean/src/Snug/Compile/Simulate.dcl | 5 | ||||
| -rw-r--r-- | snug-clean/src/Snug/Compile/Simulate.icl | 16 |
3 files changed, 20 insertions, 11 deletions
diff --git a/snug-clean/src/Snug/Compile.icl b/snug-clean/src/Snug/Compile.icl index 15e2aa8..645c9ed 100644 --- a/snug-clean/src/Snug/Compile.icl +++ b/snug-clean/src/Snug/Compile.icl @@ -3,6 +3,7 @@ implementation module Snug.Compile import StdEnv import Control.Monad +import Data.Error import Data.Func import Data.List import qualified Data.Map @@ -113,9 +114,12 @@ where label = constructorLabel ns id compileExpr :: !Namespace !Globals !Locals !Expression -> [Instruction] -compileExpr ns globals locals expr = simulate [SVRegOffset FrontEvalPtr 0] $ - simulator ns globals locals expr >>| - indirectAndEval +compileExpr ns globals locals expr = + case simulate [SVRegOffset FrontEvalPtr 0] expr` of + Error e -> abort ("Compiling an expression failed: " +++ e +++ "\n") + Ok instrs -> instrs +where + expr` = simulator ns globals locals expr >>| indirectAndEval simulator :: !Namespace !Globals !Locals !Expression -> Simulator () simulator _ _ _ (BasicValue bv) = diff --git a/snug-clean/src/Snug/Compile/Simulate.dcl b/snug-clean/src/Snug/Compile/Simulate.dcl index bf01675..b131f34 100644 --- a/snug-clean/src/Snug/Compile/Simulate.dcl +++ b/snug-clean/src/Snug/Compile/Simulate.dcl @@ -7,13 +7,14 @@ from Control.Monad.Identity import :: Identity, instance Functor Identity, from Control.Monad.State import :: State, :: StateT, instance Functor (StateT s m), instance Monad (StateT s m), instance pure (StateT s m), instance <*> (StateT s m) +from Data.Error import :: MaybeError from Data.Functor import class Functor from MIPS.MIPS32 import :: Immediate, :: Instruction, :: Label, :: Offset, :: Register from Snug.Syntax import :: BasicValue -:: Simulator a :== State SimulationState a +:: Simulator a :== StateT SimulationState (MaybeError String) a :: SimulationState @@ -24,7 +25,7 @@ from Snug.Syntax import :: BasicValue /* for internal use only: */ | SVImmediate !Immediate -simulate :: ![StackValue] !(Simulator a) -> [Instruction] +simulate :: ![StackValue] !(Simulator a) -> MaybeError String [Instruction] stackSize :: Simulator Int diff --git a/snug-clean/src/Snug/Compile/Simulate.icl b/snug-clean/src/Snug/Compile/Simulate.icl index 672b47e..af72277 100644 --- a/snug-clean/src/Snug/Compile/Simulate.icl +++ b/snug-clean/src/Snug/Compile/Simulate.icl @@ -3,8 +3,10 @@ implementation module Snug.Compile.Simulate import StdEnv import Control.Monad +import Control.Monad.Fail import Control.Monad.Identity import Control.Monad.State +import Data.Error import Data.Functor import MIPS.MIPS32 @@ -17,11 +19,13 @@ import Snug.Syntax , stack :: ![StackValue] } -simulate :: ![StackValue] !(Simulator a) -> [Instruction] -simulate stack sim = flatten (reverse (execState sim initial).instrs) +simulate :: ![StackValue] !(Simulator a) -> MaybeError String [Instruction] +simulate stack sim = + execStateT sim initial >>= \state -> + if (length state.stack == length stack) + (pure (flatten (reverse state.instrs))) + (fail "stack size changed") where - // TODO: when finishing: - // - check that the stack is empty initial = { instrs = [] , hp_offset = 0 @@ -113,7 +117,7 @@ pushArg i j = SVRegOffset reg offset -> push (SVIndirect (offset + (j+1)*4) reg) _ -> - abort "unexpected reference in pushArg\n" + fail "unexpected reference in pushArg\n" indirectAndEval :: Simulator () indirectAndEval = @@ -136,4 +140,4 @@ indirectAndEval = [ AddImmediate Signed HeapPtr HeapPtr (Immediate hp_offset) ] _ -> - abort "unexpected top of stack in indirect\n" + fail "unexpected top of stack in indirect\n" |