From a02176ee18a72a43d8b575dd242ae0153abe9f81 Mon Sep 17 00:00:00 2001
From: Suguivy <suguivy@riseup.net>
Date: Wed, 24 Feb 2021 18:50:53 +0100
Subject: [PATCH] Now works as a simple calculator of s-exprs, with + - * / and
 numbers

---
 picolisp.cabal    |  8 +++++++-
 src/Evaluator.hs  | 19 +++++++++++++++++++
 src/Expression.hs | 14 ++++++++++++++
 src/Main.hs       | 20 ++++++++++++++++++--
 src/Parser.hs     | 40 ++++++++++++++++++++++++++++++++++++++++
 src/Primitives.hs | 10 ++++++++++
 6 files changed, 108 insertions(+), 3 deletions(-)
 create mode 100644 src/Evaluator.hs
 create mode 100644 src/Expression.hs
 create mode 100644 src/Parser.hs
 create mode 100644 src/Primitives.hs

diff --git a/picolisp.cabal b/picolisp.cabal
index ff88caa..aad7967 100644
--- a/picolisp.cabal
+++ b/picolisp.cabal
@@ -17,4 +17,10 @@ executable picolisp
   hs-source-dirs:      src
   main-is:             Main.hs
   default-language:    Haskell2010
-  build-depends:       base >= 4.7 && < 5
+  other-modules:       Parser,
+                       Evaluator,
+                       Expression,
+                       Primitives
+  build-depends:       base >= 4.7 && < 5,
+                       parsec,
+                       haskeline
diff --git a/src/Evaluator.hs b/src/Evaluator.hs
new file mode 100644
index 0000000..3efc942
--- /dev/null
+++ b/src/Evaluator.hs
@@ -0,0 +1,19 @@
+module Evaluator where
+
+import Expression
+import Primitives
+
+eval :: Expression -> Expression
+eval n@(Number _) = n
+eval s@(Symbol _) = s
+eval (SExpr es)   = apply $ SExpr (map eval es)
+
+apply :: Expression -> Expression
+apply (SExpr (f:args)) = case f of
+  Symbol "+" -> pAdd args
+  Symbol "-" -> pSub args
+  Symbol "*" -> pMul args
+  Symbol "/" -> pDiv args
+  Symbol _     -> error "no primitive functions not supported"
+  _            -> error "object not applicable"
+apply _                = error "Object not applicable"
diff --git a/src/Expression.hs b/src/Expression.hs
new file mode 100644
index 0000000..e5e009a
--- /dev/null
+++ b/src/Expression.hs
@@ -0,0 +1,14 @@
+module Expression where
+
+-- The basic unit of the language are Expressions, so we make an
+-- Expression data with the primitive expression values as the
+-- constructors
+data Expression = Number Double
+                | Symbol String
+                | SExpr [Expression]
+                deriving (Eq)
+
+instance Show Expression where
+  show (Number n) = show n
+  show (Symbol s) = show s
+  show (SExpr es) = "(" ++ unwords (map show es) ++ ")"
diff --git a/src/Main.hs b/src/Main.hs
index 9cd992d..8c72125 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,5 +1,21 @@
 module Main where
 
+import Parser
+import Evaluator
+import System.Console.Haskeline
+
 main :: IO ()
-main = do
-  putStrLn "hello world"
+main = runInputT defaultSettings repl
+  where repl = do
+          line <- getInputLine "picolisp> "
+          case line of
+            Nothing -> return ()
+            Just s -> do
+              let eithE = parseExpression s
+              case eithE of
+                Left err -> do
+                  outputStrLn $ show err
+                  repl
+                Right e -> do
+                  outputStrLn . show $ eval e
+                  repl
diff --git a/src/Parser.hs b/src/Parser.hs
new file mode 100644
index 0000000..2ba71f0
--- /dev/null
+++ b/src/Parser.hs
@@ -0,0 +1,40 @@
+module Parser where
+
+import Text.ParserCombinators.Parsec
+import Data.Char
+
+import Expression
+
+-- Receives a string, parses it, and returns an expression
+parseExpression :: String -> Either ParseError Expression
+parseExpression s = do
+  e <- parse anyExpressionParser "" s
+  return e
+
+-- Parser any possible expression
+anyExpressionParser :: GenParser Char st Expression
+anyExpressionParser = numberParser <|> symbolParser <|> sexprParser
+
+-- Parses an S-expr
+sexprParser :: GenParser Char st Expression
+sexprParser = do
+  _ <- spaces
+  _ <- char '('
+  es <- many1 (try $ spaces >> anyExpressionParser)
+  _ <- spaces
+  _ <- char ')' >> spaces
+  return $ SExpr es
+
+-- Parses a symbol
+symbolParser :: GenParser Char st Expression
+symbolParser = Symbol <$> do
+  c <- symbolChar
+  cs <- many (symbolChar <|> digit)
+  return $ c:cs
+    where symbolChar = letter <|> oneOf "!#$%&*+-/:<=>?@\\^_`~"
+
+-- Parses a number
+numberParser :: GenParser Char st Expression
+numberParser = do
+  num <- read <$> many1 digit
+  return $ Number num
diff --git a/src/Primitives.hs b/src/Primitives.hs
new file mode 100644
index 0000000..b85d213
--- /dev/null
+++ b/src/Primitives.hs
@@ -0,0 +1,10 @@
+module Primitives where
+
+import Expression
+
+pAdd, pSub, pMul, pDiv :: [Expression] -> Expression
+
+pAdd = foldr1 $ \(Number a) (Number b) -> Number (a+b)
+pSub = foldr1 $ \(Number a) (Number b) -> Number (a-b)
+pMul = foldr1 $ \(Number a) (Number b) -> Number (a*b)
+pDiv = foldr1 $ \(Number a) (Number b) -> Number (a/b)