From 8c33b3d2c69b6800ca34155d62c000250980e47e Mon Sep 17 00:00:00 2001
From: Matthew Hall <hallmatthew314@gmail.com>
Date: Sat, 18 Feb 2023 16:58:51 +1300
Subject: Introduce stdlib and fix lexing bug

---
 DSL/Interpretation.hs |  3 ++-
 DSL/Parsing.hs        |  2 +-
 DSL/StdLib.hs         | 37 +++++++++++++++++++++++++++++++++++++
 3 files changed, 40 insertions(+), 2 deletions(-)
 create mode 100644 DSL/StdLib.hs

(limited to 'DSL')

diff --git a/DSL/Interpretation.hs b/DSL/Interpretation.hs
index e02bc74..02105f4 100644
--- a/DSL/Interpretation.hs
+++ b/DSL/Interpretation.hs
@@ -5,6 +5,7 @@ import Data.Foldable (foldlM)
 import DSL.Types
 import DSL.Util
 import DSL.Intrinsics
+import DSL.StdLib (stdlib)
 
 newMachine :: Machine
 newMachine = Machine { ok=True, stack=[], pTable=[] }
@@ -103,5 +104,5 @@ evalBlocks (BIfElse c b1 b2:bs) m  = applyIfElse c b1 b2 m >>= evalBlocks bs
 evalBlocks (BWhile c b:bs) m       = applyWhile c b m >>= evalBlocks bs
 
 interpret :: ([ProcSpec], Program) -> IO ()
-interpret (t, p) = evalBlocks p newMachine{ pTable=t } >> return ()
+interpret (t, p) = evalBlocks p newMachine{ pTable=stdlib++t } >> return ()
 
diff --git a/DSL/Parsing.hs b/DSL/Parsing.hs
index d255c35..ba6a5ee 100644
--- a/DSL/Parsing.hs
+++ b/DSL/Parsing.hs
@@ -11,7 +11,7 @@ buildDSLLexer p t = do
   return Token { tStr=str, tTag=t }
 
 fromStringL :: String -> TokenTag -> DSLLexer
-fromStringL s t = buildDSLLexer (list s) t
+fromStringL s t = buildDSLLexer (list s) t <* peek (() <$ satisfy isSpace `alt` eof)
 
 fromTableL :: [(String, TokenTag)] -> DSLLexer
 fromTableL table = firstOf $ map (uncurry fromStringL) table
diff --git a/DSL/StdLib.hs b/DSL/StdLib.hs
new file mode 100644
index 0000000..6483433
--- /dev/null
+++ b/DSL/StdLib.hs
@@ -0,0 +1,37 @@
+module DSL.StdLib (stdlib) where
+
+import DSL.Types
+import DSL.BaseParsers (parse, mult, chain)
+import DSL.Parsing (tokenizer, procP)
+
+stdlib :: [ProcSpec]
+stdlib = procs
+  where
+    p = tokenizer `chain` mult procP
+    procs = case parse p (unlines sources) of
+      Nothing      -> error "Failed to parse standard library"
+      Just (_, ps) -> ps
+
+sources :: [String]
+sources = [ div'
+          , mod'
+          , lteq
+          , gteq
+          , neq
+          ]
+
+div' :: String
+div' = "PROC / /% DROP END"
+
+mod' :: String
+mod' = "PROC % /% SWAP DROP END"
+
+lteq :: String
+lteq = "PROC <= OVER OVER == ROT < || END"
+
+gteq :: String
+gteq = "PROC >= OVER OVER == ROT > || END"
+
+neq :: String
+neq = "PROC != == ! END"
+
-- 
cgit v1.2.1