String literals, fizzbuzz, other tweaks

5 files changed, 44 insertions, 18 deletions

diff --git a/DSL.hs b/DSL.hs
index 50d8ca3..1a86c34 100644
--- a/DSL.hs
+++ b/DSL.hs
@@ -1,7 +1,5 @@
 module DSL where
 
-import DSL.Types
-import DSL.Util
 import DSL.Parsing
 import DSL.Interpretation
 
diff --git a/DSL/Intrinsics.hs b/DSL/Intrinsics.hs
index 11b37f3..72bee4f 100644
--- a/DSL/Intrinsics.hs
+++ b/DSL/Intrinsics.hs
@@ -7,7 +7,11 @@ dump :: StackModifier
 dump = StackModifier { smName="DUMP", smTypes=ts, smFunc=f }
   where
     ts = [tAny]
-    f (x:xs) = putStrLn (show x) >> return xs
+    f (x:xs) = putStrLn x' >> return xs
+      where
+        x' = case x of
+          StackString s -> s
+          _             -> show x
     f _      = unreachable
 
 drop' :: StackModifier
diff --git a/DSL/Parsing.hs b/DSL/Parsing.hs
index ef7da9e..76acacd 100644
--- a/DSL/Parsing.hs
+++ b/DSL/Parsing.hs
@@ -19,11 +19,13 @@ fromTableL table = firstOf $ map (uncurry fromStringL) table
 wsL :: DSLLexer
 wsL = buildDSLLexer (mult1 $ satisfy isSpace) T_WHITESPACE
 
-boolLiteralL :: DSLLexer
-boolLiteralL = t `alt` f
-  where
-    t = buildDSLLexer (list "true") T_BOOL_LITERAL
-    f = buildDSLLexer (list "false") T_BOOL_LITERAL
+keywordL :: DSLLexer
+keywordL = fromTableL [ ("IF",    T_IF)
+                      , ("ELSE",  T_ELSE)
+                      , ("WHILE", T_WHILE)
+                      , ("DO",    T_DO)
+                      , ("END",   T_END)
+                      ]
 
 intLiteralL :: DSLLexer
 intLiteralL = buildDSLLexer go T_INT_LITERAL
@@ -33,17 +35,22 @@ intLiteralL = buildDSLLexer go T_INT_LITERAL
       digits <- mult1 $ satisfy isDigit
       result $ maybe digits (:digits) sign
 
-keywordL :: DSLLexer
-keywordL = fromTableL [ ("IF",    T_IF)
-                      , ("ELSE",  T_ELSE)
-                      , ("WHILE", T_WHILE)
-                      , ("DO",    T_DO)
-                      , ("END",   T_END)
-                      ]
+boolLiteralL :: DSLLexer
+boolLiteralL = f "true" `alt` f "false"
+  where
+    f s = fromStringL s T_BOOL_LITERAL
+
+stringLiteralL :: DSLLexer
+stringLiteralL = buildDSLLexer go T_STRING_LITERAL
+  where
+    go = token '"' *> strChars <* token '"'
+    strChars = concat <$> mult strChar
+    strChar = list ['\\', '"'] `alt` (pure <$> satisfy (/='"'))
 
 literalL :: DSLLexer
-literalL = firstOf [ boolLiteralL
-                   , intLiteralL
+literalL = firstOf [ intLiteralL
+                   , boolLiteralL
+                   , stringLiteralL
                    ]
 
 intrinsicL :: DSLLexer
@@ -92,6 +99,7 @@ dataLiteralP = do
     (T_BOOL_LITERAL, "true")  -> result $ StackBool True
     (T_BOOL_LITERAL, "false") -> result $ StackBool False
     (T_INT_LITERAL, _)        -> result $ StackInt $ read s
+    (T_STRING_LITERAL, _)     -> result $ StackString s
     _                         -> flunk
 
 pushDataP :: DSLParser Operation
diff --git a/DSL/Types.hs b/DSL/Types.hs
index 8d59a06..bb1f862 100644
--- a/DSL/Types.hs
+++ b/DSL/Types.hs
@@ -5,12 +5,14 @@ import DSL.BaseParsers (Parser(..))
 data StackData
   = StackInt Integer
   | StackBool Bool
+  | StackString String
     deriving (Eq)
 
 instance Show StackData where
   show (StackInt x)      = show x
   show (StackBool True)  = "true"
   show (StackBool False) = "false"
+  show (StackString s)   = show s
 
 type TypeCheck = StackData -> Bool
 
@@ -70,8 +72,9 @@ data TokenTag
   | T_WHILE
   | T_DO
   | T_END
-  | T_BOOL_LITERAL
   | T_INT_LITERAL
+  | T_BOOL_LITERAL
+  | T_STRING_LITERAL
   | T_INTRINSIC Intrinsic
     deriving (Show, Eq)
 
diff --git a/examples/fizzbuzz.dumb b/examples/fizzbuzz.dumb
new file mode 100644
index 0000000..c96563f
--- /dev/null
+++ b/examples/fizzbuzz.dumb
@@ -0,0 +1,13 @@
+1
+WHILE 101 OVER < DO
+  3 OVER /% SWAP DROP
+  OVER 5 SWAP /% SWAP DROP
+  IF 0 ==
+  DO
+    IF 0 == DO "Fizzbuzz" ELSE "Buzz" END
+  ELSE
+    IF 0 == DO "Fizz" ELSE DUP END
+  END
+  . 1 +
+END
+