From 7dbb6e631346cbb790300d823dff6efdf84288d7 Mon Sep 17 00:00:00 2001
From: Jan Tuomi <jans.tuomi@gmail.com>
Date: Thu, 27 Jan 2022 21:49:56 +0200
Subject: Initial commit

---
 src/main.hs  | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 src/utils.hs |  7 +++++++
 2 files changed, 55 insertions(+)
 create mode 100644 src/main.hs
 create mode 100644 src/utils.hs

(limited to 'src')

diff --git a/src/main.hs b/src/main.hs
new file mode 100644
index 0000000..90de59e
--- /dev/null
+++ b/src/main.hs
@@ -0,0 +1,48 @@
+module Main where
+
+import Data.Char
+import System.Environment (getArgs)
+import Utils
+
+getFilename [] = error "empty argument list"
+getFilename (f : fs) = f
+
+data LWord
+  = LSymbol String
+  | LInteger Integer
+  deriving (Show)
+
+reprWord (LSymbol a) = a
+reprWord (LInteger a) = show a
+
+parseWord rawStr
+  | all isDigit rawStr = LInteger (read rawStr)
+  | otherwise = LSymbol rawStr
+
+parseSource source = source $> words .> map parseWord
+
+interpretSource :: [LWord] -> [LWord] -> IO ()
+interpretSource _ [] = putStrLn "done"
+interpretSource stack (word : rest) = do
+  newStack <- interpretWord stack word
+  interpretSource newStack rest
+
+interpretWord :: [LWord] -> LWord -> IO [LWord]
+interpretWord stack word@(LInteger value) = pure $ word : stack
+interpretWord (a : stack) word@(LSymbol ".") = do
+  putStrLn $ reprWord a
+  pure stack
+interpretWord ((LInteger a) : (LInteger b) : stack) word@(LSymbol "+") = pure $ LInteger (a + b) : stack
+interpretWord _ other = error $ "[error] runtime error at " ++ show other
+
+main :: IO ()
+main = do
+  args <- getArgs
+  let filename = getFilename args
+  putStrLn $ "[info] executing file " ++ filename
+  source <- readFile filename
+  putStrLn source
+  let parsed = parseSource source
+  putStrLn $ "[info] parsed words:\n" ++ show parsed
+  putStrLn "[info] interpreter output:"
+  interpretSource [] parsed
diff --git a/src/utils.hs b/src/utils.hs
new file mode 100644
index 0000000..33f3f6e
--- /dev/null
+++ b/src/utils.hs
@@ -0,0 +1,7 @@
+module Utils where
+
+(.>) = flip (.)
+
+($>) = flip ($)
+
+infixr 6 $>
-- 
cgit v1.3