From 28ab4a097fb73a138850a3fb7f6e480765c702ee Mon Sep 17 00:00:00 2001
From: Matthew Hall <hallmatthew314@gmail.com>
Date: Sat, 18 Feb 2023 17:19:09 +1300
Subject: Add STRCAT, update fizzbuzz

---
 DSL/Interpretation.hs  |  1 +
 DSL/Intrinsics.hs      |  7 +++++++
 DSL/Parsing.hs         |  1 +
 DSL/Types.hs           |  2 ++
 DSL/Util.hs            |  4 ++++
 examples/fizzbuzz.dumb | 13 ++++---------
 6 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/DSL/Interpretation.hs b/DSL/Interpretation.hs
index 02105f4..02f741d 100644
--- a/DSL/Interpretation.hs
+++ b/DSL/Interpretation.hs
@@ -40,6 +40,7 @@ applyIntrinsic i m = do
       I_AND         -> and'
       I_OR          -> or'
       I_XOR         -> xor
+      I_STRCAT      -> strcat
       I_EQUAL       -> equal
       I_LESSTHAN    -> lessThan
       I_GREATERTHAN -> greaterThan
diff --git a/DSL/Intrinsics.hs b/DSL/Intrinsics.hs
index 72bee4f..ecb0fad 100644
--- a/DSL/Intrinsics.hs
+++ b/DSL/Intrinsics.hs
@@ -91,6 +91,13 @@ or' = binBoolean "OR" $ \ x y -> [x || y]
 xor :: StackModifier
 xor = binBoolean "XOR" $ \ x y -> [x /= y]
 
+strcat :: StackModifier
+strcat = StackModifier { smName="STRCAT", smTypes=ts, smFunc=f }
+  where
+    ts = [tString, tString]
+    f (StackString x:StackString y:xs) = return $ StackString (x ++ y):xs
+    f _                                = unreachable
+
 equal :: StackModifier
 equal = StackModifier { smName="EQUAL", smTypes=ts, smFunc=f }
   where
diff --git a/DSL/Parsing.hs b/DSL/Parsing.hs
index ba6a5ee..fad68f1 100644
--- a/DSL/Parsing.hs
+++ b/DSL/Parsing.hs
@@ -74,6 +74,7 @@ intrinsicL = fromTableL [ (".",    T_INTRINSIC I_DUMP)
                         , ("&&",   T_INTRINSIC I_AND)
                         , ("||",   T_INTRINSIC I_OR)
                         , ("^",    T_INTRINSIC I_XOR)
+                        , ("++",   T_INTRINSIC I_STRCAT)
                         , ("==",   T_INTRINSIC I_EQUAL)
                         , ("<",    T_INTRINSIC I_LESSTHAN)
                         , (">",    T_INTRINSIC I_GREATERTHAN)
diff --git a/DSL/Types.hs b/DSL/Types.hs
index 0a4de3f..7bd9f56 100644
--- a/DSL/Types.hs
+++ b/DSL/Types.hs
@@ -36,6 +36,8 @@ data Intrinsic
   | I_AND
   | I_OR
   | I_XOR
+  -- core string operations
+  | I_STRCAT
   -- core logical operations
   | I_EQUAL
   | I_LESSTHAN
diff --git a/DSL/Util.hs b/DSL/Util.hs
index 67435a2..7767b4b 100644
--- a/DSL/Util.hs
+++ b/DSL/Util.hs
@@ -13,6 +13,10 @@ tInt :: TypeCheck
 tInt (StackInt _) = True
 tInt _            = False
 
+tString :: TypeCheck
+tString (StackString _) = True
+tString _               = False
+
 runChecks :: [TypeCheck] -> Stack -> Maybe String
 runChecks fs s
   | length fs > length s        = Just "stack underflow"
diff --git a/examples/fizzbuzz.dumb b/examples/fizzbuzz.dumb
index 692402a..43b4d82 100644
--- a/examples/fizzbuzz.dumb
+++ b/examples/fizzbuzz.dumb
@@ -1,13 +1,8 @@
 1
 WHILE 100 OVER <= DO
-  3 OVER %
-  OVER 5 SWAP %
-  IF 0 ==
-  DO
-    IF 0 == DO "Fizzbuzz" ELSE "Buzz" END
-  ELSE
-    IF 0 == DO "Fizz" ELSE DUP END
-  END
-  . 1 +
+  5 OVER % IF 0 == DO "Buzz" ELSE "" END
+  OVER 3 SWAP % IF 0 == DO "Fizz" ELSE "" END
+  ++ OVER SWAP IF DUP "" == DO SWAP END
+  . DROP 1 +
 END
 
-- 
cgit v1.2.1