diff options
Diffstat (limited to 'DSL.hs')
| -rw-r--r-- | DSL.hs | 35 |
1 files changed, 30 insertions, 5 deletions
@@ -21,12 +21,13 @@ instance Show StackData where type Stack = [StackData] data Intrinsic + -- core/stack operations = I_DUMP - | I_DROP {- + | I_DROP | I_SWAP | I_DUP | I_OVER - | I_ROT -} + | I_ROT deriving (Show, Eq) data Operation @@ -79,8 +80,12 @@ mainLexer = phrase $ mult1 $ firstOf subLexers subLexers = [wsL] ++ literals ++ intrinsics literals = [ intLiteralL ] - intrinsics = map (uncurry intrinsicL) [ (".", I_DUMP) + intrinsics = map (uncurry intrinsicL) [ (".", I_DUMP) , ("DROP", I_DROP) + , ("SWAP", I_SWAP) + , ("DUP", I_DUP) + , ("OVER", I_OVER) + , ("ROT", I_ROT) ] ------------------------------------------------------------------------------ @@ -135,12 +140,28 @@ stringToProgram str = do ------------------------------------------------------------------------------ dump :: Machine -> IO Machine -dump m@Machine{ stack=[] } = hcf m "DUMP: stack underflow" dump m@Machine{ stack=x:xs } = putStrLn (show x) >> return m{ stack=xs } +dump m = hcf m "DUMP: stack underflow" drop' :: Machine -> IO Machine -drop' m@Machine{ stack=[] } = hcf m "DROP: stack underflow" drop' m@Machine{ stack=_:xs } = return m{ stack=xs } +drop' m = hcf m "DROP: stack underflow" + +swap :: Machine -> IO Machine +swap m@Machine{ stack=x:y:xs } = return m{ stack=y:x:xs } +swap m = hcf m "SWAP: stack underflow" + +dup :: Machine -> IO Machine +dup m@Machine{ stack=x:xs } = return m{ stack=x:x:xs } +dup m = hcf m "DUP: stack underflow" + +over :: Machine -> IO Machine +over m@Machine{ stack=x:y:xs } = return m{ stack=y:x:y:xs } +over m = hcf m "OVER: stack underflow" + +rot :: Machine -> IO Machine +rot m@Machine{ stack=x:y:z:xs } = return m{ stack=y:z:x:xs } +rot m = hcf m "ROT: stack underflow" ------------------------------------------------------------------------------ -- Core operations @@ -156,6 +177,10 @@ pushData m@Machine{ stack=xs } x = m{ stack=x:xs } applyIntrinsic :: Intrinsic -> Machine -> IO Machine applyIntrinsic I_DUMP = dump applyIntrinsic I_DROP = drop' +applyIntrinsic I_SWAP = swap +applyIntrinsic I_DUP = dup +applyIntrinsic I_OVER = over +applyIntrinsic I_ROT = rot ------------------------------------------------------------------------------ -- Interpretation |