diff options
Diffstat (limited to 'DSL')
| -rw-r--r-- | DSL/Interpretation.hs | 1 | ||||
| -rw-r--r-- | DSL/Intrinsics.hs | 17 | ||||
| -rw-r--r-- | DSL/Parsing.hs | 1 | ||||
| -rw-r--r-- | DSL/StdLib.hs | 4 | ||||
| -rw-r--r-- | DSL/Types.hs | 2 |
5 files changed, 23 insertions, 2 deletions
diff --git a/DSL/Interpretation.hs b/DSL/Interpretation.hs index 34137a9..e92ae8b 100644 --- a/DSL/Interpretation.hs +++ b/DSL/Interpretation.hs @@ -50,6 +50,7 @@ applyIntrinsic i m = do I_EQUAL -> equal I_LESSTHAN -> lessThan I_GREATERTHAN -> greaterThan + I_PUT -> put applyCall :: ProcName -> Machine -> IO Machine applyCall _ m@Machine{ ok=False } = return m diff --git a/DSL/Intrinsics.hs b/DSL/Intrinsics.hs index 930a8a0..f3784a8 100644 --- a/DSL/Intrinsics.hs +++ b/DSL/Intrinsics.hs @@ -10,8 +10,9 @@ dump = StackModifier { smName="DUMP", smTypes=ts, smFunc=f } f (x:xs) = putStrLn x' >> return (Right $ xs) where x' = case x of - StackString s -> s - _ -> show x + StackString s -> "String:" ++ show s + StackInt i -> "Integer:" ++ show i + StackBool b -> "Boolean:" ++ show b f _ = unreachable drop' :: StackModifier @@ -119,3 +120,15 @@ greaterThan = StackModifier { smName="GREATERTHAN", smTypes=ts, smFunc=f } f (StackInt x:StackInt y:xs) = return $ Right $ StackBool(x > y):xs f _ = unreachable +put :: StackModifier +put = StackModifier { smName="PUT", smTypes=[tAny], smFunc=f } + where + f (x:xs) = putStr x' >> return (Right xs) + where + x' = case x of + StackBool True -> "true" + StackBool False -> "false" + StackInt i -> show i + StackString s -> s + f _ = unreachable + diff --git a/DSL/Parsing.hs b/DSL/Parsing.hs index 028b738..6097be6 100644 --- a/DSL/Parsing.hs +++ b/DSL/Parsing.hs @@ -92,6 +92,7 @@ intrinsicL = prependError "intrinsicL:" $ fromTableL t , ("==", T_INTRINSIC I_EQUAL) , ("<", T_INTRINSIC I_LESSTHAN) , (">", T_INTRINSIC I_GREATERTHAN) + , ("PUT", T_INTRINSIC I_PUT) ] lexemeL :: DSLLexer diff --git a/DSL/StdLib.hs b/DSL/StdLib.hs index 09c5338..748825e 100644 --- a/DSL/StdLib.hs +++ b/DSL/StdLib.hs @@ -21,6 +21,7 @@ sources = [ div' , lteq , gteq , neq + , putLn ] div' :: String @@ -38,3 +39,6 @@ gteq = "PROC >= OVER OVER == ROT > || END" neq :: String neq = "PROC != == ! END" +putLn :: String +putLn = "PROC PUTLN PUT \"\n\" PUT END" + diff --git a/DSL/Types.hs b/DSL/Types.hs index 2faacc4..d0ded59 100644 --- a/DSL/Types.hs +++ b/DSL/Types.hs @@ -45,6 +45,8 @@ data Intrinsic | I_EQUAL | I_LESSTHAN | I_GREATERTHAN + -- core IO operations + | I_PUT deriving (Show, Eq) type ProcName = String |