From b1eb5d0dd99ad0449b0808cdc1e6857404e49186 Mon Sep 17 00:00:00 2001
From: Jan Tuomi <jans.tuomi@gmail.com>
Date: Fri, 28 Jan 2022 14:47:37 +0200
Subject: Implement definitions

---
 src/main.hs | 93 +++++++++++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 72 insertions(+), 21 deletions(-)

(limited to 'src/main.hs')

diff --git a/src/main.hs b/src/main.hs
index cfa5f65..950a93e 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -4,6 +4,7 @@ import Data.Char
 import Data.List (isPrefixOf)
 import Data.Map (Map, (!))
 import qualified Data.Map as M
+import Debug.Trace (trace, traceShow)
 import System.Environment (getArgs)
 import Utils
 
@@ -14,12 +15,21 @@ data LWord
   = LSymbol String
   | LInteger Integer
   | LVariable String
-  deriving (Show)
+  deriving (Show, Eq)
 
 reprWord (LSymbol a) = a
 reprWord (LInteger a) = show a
 reprWord (LVariable a) = a
 
+data LState = LState
+  { lDict :: Map String LWord,
+    lStack :: [LWord],
+    lEvalMode :: Bool,
+    lDefs :: Map String [LWord],
+    lSource :: [LWord]
+  }
+  deriving (Show)
+
 parseWord rawStr
   | all isDigit rawStr = LInteger (read rawStr)
   | "$" `isPrefixOf` rawStr = LVariable $ tail rawStr
@@ -27,32 +37,65 @@ parseWord rawStr
 
 parseSource source = source $> words .> map parseWord
 
-interpretSource _ _ [] = putStrLn "done"
-interpretSource stack dict (word : rest) = do
-  (newStack, newDict) <- interpretWord stack dict word
-  interpretSource newStack newDict rest
+interpretSource :: LState -> IO ()
+interpretSource LState {lSource = []} = putStrLn "done"
+interpretSource state@LState {lSource = (word : rest)} = do
+  newState <- interpretWord state {lSource = rest} word
+  -- putStrLn $ "[debug] processed " ++ show word ++ ", newState = " ++ show newState
+  interpretSource newState
 
--- no ops
-interpretWord stack dict word@(LInteger value) = pure (word : stack, dict)
-interpretWord stack dict word@(LVariable value) = pure (word : stack, dict)
+-- basics
+interpretWord :: LState -> LWord -> IO LState
+interpretWord state@LState {lStack = stack} word@(LSymbol "define") =
+  pure $
+    state
+      { lEvalMode = False,
+        lStack = word : stack
+      }
+interpretWord state@LState {lDefs = defs, lStack = stack} word@(LSymbol ";") =
+  let defineSpan = takeWhile (\word -> word /= LSymbol "define") stack
+      newStack = dropWhile (\word -> word /= LSymbol "define") stack $> tail
+      ((LSymbol identifier) : body) = reverse defineSpan
+      newDefs = M.insert identifier body defs
+   in pure $
+        state
+          { lEvalMode = True,
+            lDefs = newDefs,
+            lStack = newStack
+          }
+interpretWord state@LState {lStack = stack, lEvalMode = False} word = pure $ state {lStack = word : stack}
+interpretWord state@LState {lStack = stack} word@(LInteger value) = pure $ state {lStack = word : stack}
+interpretWord state@LState {lStack = stack} word@(LVariable value) = pure $ state {lStack = word : stack}
+interpretWord state@LState {lStack = stack} word@(LSymbol "dup") =
+  let (stackHead : stack') = stack
+   in pure $ state {lStack = stackHead : stackHead : stack}
 -- variables & printing
-interpretWord ((LVariable a) : b : stack) dict word@(LSymbol "!") =
+interpretWord state@LState {lStack = (LVariable a) : b : stack, lDict = dict} word@(LSymbol "!") =
   let newDict = M.insert a b dict
-   in pure (stack, newDict)
-interpretWord ((LVariable a) : stack) dict word@(LSymbol "@") =
+   in pure $ state {lDict = newDict, lStack = stack}
+interpretWord state@LState {lStack = (LVariable a) : stack, lDict = dict} word@(LSymbol "@") =
   let lookupWord = dict ! a
-   in pure (lookupWord : stack, dict)
-interpretWord (a : stack) dict word@(LSymbol ".") = do
+   in pure $ state {lStack = lookupWord : stack}
+interpretWord state@LState {lStack = a : stack} word@(LSymbol ".") = do
   putStrLn $ reprWord a
-  pure (stack, dict)
-interpretWord ((LVariable a) : stack) dict word@(LSymbol "?") = do
+  pure $ state {lStack = stack}
+interpretWord state@LState {lStack = ((LVariable a) : stack), lDict = dict} word@(LSymbol "?") = do
   let lookupWord = dict ! a
   putStrLn $ reprWord lookupWord
-  pure (stack, dict)
+  pure $ state {lStack = stack}
 -- math
-interpretWord ((LInteger a) : (LInteger b) : stack) dict word@(LSymbol "+") = pure $ (LInteger (a + b) : stack, dict)
+interpretWord state@LState {lStack = stack, lDict = dict} word@(LSymbol "+") =
+  let ((LInteger a) : (LInteger b) : stack') = stack
+   in pure $ state {lStack = LInteger (a + b) : stack'}
+-- def lookup
+interpretWord state@LState {lDefs = defs, lSource = source} word@(LSymbol other) =
+  let defM = M.lookup other defs
+   in case defM of
+        Just body -> pure $ state {lSource = body ++ source}
+        Nothing -> error $ "[error] not defined: " ++ other
+
 -- error
-interpretWord stack _ other = error $ "[error] runtime error at " ++ show other ++ "\nstack at time of error:\n" ++ show stack
+-- interpretWord state other = error $ "[error] runtime error at " ++ show other ++ "\ninterpreter state at time of error:\n" ++ show state
 
 main :: IO ()
 main = do
@@ -60,9 +103,17 @@ main = do
   let filename = getFilename args
   putStrLn $ "[info] executing file " ++ filename
   source <- readFile filename
-  putStrLn source
+  -- putStrLn source
   let sourceWoComments = source $> lines .> filter (\line -> not ("--" `isPrefixOf` line)) .> unlines
   let parsed = parseSource sourceWoComments
-  putStrLn $ "[info] parsed words:\n" ++ show parsed
+  -- putStrLn $ "[info] parsed words:\n" ++ show parsed
   putStrLn "[info] interpreter output:"
-  interpretSource [] M.empty parsed
+  let initialState =
+        LState
+          { lDict = M.empty,
+            lStack = [],
+            lEvalMode = True,
+            lDefs = M.empty,
+            lSource = parsed
+          }
+  interpretSource initialState
-- 
cgit v1.3