diff options
| -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 | ||||
| -rw-r--r-- | examples/factors-of-n.dsl | 12 | ||||
| -rw-r--r-- | examples/fizzbuzz.dumb | 2 |
7 files changed, 31 insertions, 8 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 diff --git a/examples/factors-of-n.dsl b/examples/factors-of-n.dsl index a5ef2fc..9c6608f 100644 --- a/examples/factors-of-n.dsl +++ b/examples/factors-of-n.dsl @@ -5,15 +5,17 @@ PROC factors ''' find the smallest number that divides n ''' 2 WHILE OVER OVER SWAP % 0 != DO 1 + END ''' print it and find the next factor ''' - DUP . + DUP PUT " " PUT OVER OVER SWAP / factors + ELSE + "" PUTLN END END PROC MAIN - "Prime factors of 12:" . 12 factors - "Prime factors of 5:" . 5 factors - "Prime factors of 60:" . 60 factors - "Prime factors of 97:" . 97 factors + "Prime factors of 12:" PUTLN 12 factors + "Prime factors of 5:" PUTLN 5 factors + "Prime factors of 60:" PUTLN 60 factors + "Prime factors of 97:" PUTLN 97 factors END diff --git a/examples/fizzbuzz.dumb b/examples/fizzbuzz.dumb index f9aa648..3cd0dba 100644 --- a/examples/fizzbuzz.dumb +++ b/examples/fizzbuzz.dumb @@ -10,6 +10,6 @@ PROC MAIN ''' concat the two strings and copy the inc., if the string is empty, swap them ''' ++ OVER SWAP IF DUP "" == DO SWAP END ''' print the top of the stack, drop the next item, add 1 to inc. ''' - . DROP 1 + + PUTLN DROP 1 + END END |