From 0775dea2bc79cb1b5ee56f74f8076fc30a394127 Mon Sep 17 00:00:00 2001
From: Akshay <nerdy@peppe.rs>
Date: Thu, 8 Oct 2020 10:53:41 +0530
Subject: init

---
 src/Evaluator.hs |  22 ++++++++++++
 src/Operators.hs |  22 ++++++++++++
 src/Parser.hs    | 101 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 145 insertions(+)
 create mode 100644 src/Evaluator.hs
 create mode 100644 src/Operators.hs
 create mode 100644 src/Parser.hs

(limited to 'src')

diff --git a/src/Evaluator.hs b/src/Evaluator.hs
new file mode 100644
index 0000000..f264ee0
--- /dev/null
+++ b/src/Evaluator.hs
@@ -0,0 +1,22 @@
+module Evaluator (
+    eval
+    ) where
+
+import           Operators
+import           Parser
+import           Text.ParserCombinators.Parsec
+
+apply :: String -> [Expr] -> Expr
+apply fn args =
+    case lookup fn primitives of
+      Just f -> f args
+      _      -> BoolLiteral False -- TODO: error out instead
+
+eval :: Expr -> Expr
+eval v@(StringLiteral s)     = v
+eval v@(IntLiteral i)        = v
+eval v@(BoolLiteral b)       = v
+-- handle quotes as literals
+eval (List[Id "quote", val]) = val
+eval (List (Id fn : args))   = apply fn $ map eval args
+
diff --git a/src/Operators.hs b/src/Operators.hs
new file mode 100644
index 0000000..e57f885
--- /dev/null
+++ b/src/Operators.hs
@@ -0,0 +1,22 @@
+module Operators (
+    primitives
+    ) where
+
+import           Parser
+
+primitives :: [(String, [Expr] -> Expr)]
+primitives =
+    [
+    ("+", arithmetic (+))
+    , ("-", arithmetic (-))
+    , ("*", arithmetic (*))
+    , ("/", arithmetic div)
+    ]
+
+arithmetic :: (Integer -> Integer -> Integer) -> [Expr] -> Expr
+arithmetic op args = IntLiteral $ foldl1 op $ map unwrapNum args
+
+unwrapNum :: Expr -> Integer
+unwrapNum (IntLiteral n) = n
+unwrapNum _              = undefined
+
diff --git a/src/Parser.hs b/src/Parser.hs
new file mode 100644
index 0000000..dcbfdb1
--- /dev/null
+++ b/src/Parser.hs
@@ -0,0 +1,101 @@
+module Parser ( parseLispValue
+              , Expr(..)
+              , parseString
+              , parseInt
+              , parseFloat
+              , parseAtom
+              , parseList
+              , parseQuote
+              , parseDottedList
+              ) where
+
+import           Control.Applicative           ((<$>))
+import           Control.Monad                 (liftM)
+import           Text.ParserCombinators.Parsec
+
+
+type Ident = String
+
+data Expr = List [Expr]
+          | DottedList [Expr] Expr
+          | StringLiteral String
+          | IntLiteral Integer
+          | FloatLiteral Double
+          | BoolLiteral Bool
+          | Id Ident
+          deriving (Eq)
+
+parseString :: Parser Expr
+parseString = do
+    char '"'
+    innards <- many (noneOf "\"")
+    char '"'
+    return (StringLiteral innards)
+
+parseInt :: Parser Expr
+parseInt = IntLiteral . read <$> many1 digit
+
+parseFloat :: Parser Expr
+parseFloat = do
+    characteristic <- many digit
+    char '.'
+    mantissa <- many1 digit
+    return $ (FloatLiteral . read) $ characteristic ++ "." ++ mantissa
+
+symbol :: Parser Char
+symbol = oneOf "!#$%&|*+:/-=<?>@^_~"
+
+parseAtom :: Parser Expr
+parseAtom = do
+    first <- letter <|> symbol
+    rest <- many (letter <|> symbol <|> digit)
+    let atom = first:rest
+    return $ case atom of
+               "#t" -> BoolLiteral True
+               "#f" -> BoolLiteral False
+               _    -> Id atom
+
+whiteSpace :: Parser ()
+whiteSpace = skipMany1 space
+
+parseList :: Parser Expr
+parseList = List <$> sepBy parseLispValue whiteSpace
+
+parseDottedList :: Parser Expr
+parseDottedList = do
+    head <- endBy parseLispValue whiteSpace
+    char '.'
+    whiteSpace
+    DottedList head <$> parseLispValue
+
+parseQuote :: Parser Expr
+parseQuote = do
+    char '\''
+    x <- parseLispValue
+    return $ List [Id "quote", x]
+
+
+parseLispValue :: Parser Expr
+parseLispValue =
+    try parseAtom
+    <|> parseString
+    <|> parseInt
+    <|> parseQuote
+    -- TODO: figure out a way to have floats and dotted lists
+    -- <|> parseFloat
+    <|> do
+        char '('
+        x <- try parseList <|> parseDottedList
+        char ')'
+        return x
+    <?> "expected lisp value!"
+
+instance Show Expr where
+    show (DottedList xs x)   = "(" ++ unwords (map show xs) ++ " . " ++ show x ++ ")"
+    show (List xs)           = "(" ++ unwords (map show xs) ++ ")"
+    show (StringLiteral s)   = "\"" ++ s ++ "\""
+    show (IntLiteral n)      = show n
+    show (FloatLiteral n)    = show n
+    show (BoolLiteral True)  = "#t"
+    show (BoolLiteral False) = "#f"
+    show (Id i) = i
-- 
cgit v1.2.3