String literals, fizzbuzz, other tweaks

3 files changed, 31 insertions, 16 deletions

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)