Cleaned the code a bit
This commit is contained in:
parent
3f9910f919
commit
be520a67c1
|
@ -3,17 +3,19 @@ module Evaluator where
|
||||||
import Expression
|
import Expression
|
||||||
import Primitives
|
import Primitives
|
||||||
|
|
||||||
|
-- Evals (reduces) an expression
|
||||||
eval :: Expression -> Either String Expression
|
eval :: Expression -> Either String Expression
|
||||||
eval n@(Number _) = Right n
|
eval n@(Number _) = Right n
|
||||||
eval s@(Symbol _) = Right s
|
eval s@(Symbol _) = Right s
|
||||||
eval (SExpr es) = mapM eval es >>= apply . SExpr
|
eval (SExpr es) = apply . SExpr =<< mapM eval es
|
||||||
|
|
||||||
|
-- Applies, in a SExpr, a function to its arguments
|
||||||
apply :: Expression -> Either String Expression
|
apply :: Expression -> Either String Expression
|
||||||
apply (SExpr (f:args)) = case f of
|
apply (SExpr (f:args)) = case f of
|
||||||
Symbol "+" -> Right $ pAdd args
|
Symbol "+" -> Right $ pAdd args
|
||||||
Symbol "-" -> Right $ pSub args
|
Symbol "-" -> Right $ pSub args
|
||||||
Symbol "*" -> Right $ pMul args
|
Symbol "*" -> Right $ pMul args
|
||||||
Symbol "/" -> Right $ pDiv args
|
Symbol "/" -> Right $ pDiv args
|
||||||
Symbol _ -> Left "no primitive functions not supported (only +, -, * and /)"
|
Symbol x -> Left $ show x ++ ": no primitive functions not supported"
|
||||||
_ -> Left "object not applicable"
|
_ -> Left "object not applicable"
|
||||||
apply _ = Left "object not applicable"
|
apply _ = Left "object not applicable"
|
||||||
|
|
|
@ -3,6 +3,7 @@ module Expression where
|
||||||
-- The basic unit of the language are Expressions, so we make an
|
-- The basic unit of the language are Expressions, so we make an
|
||||||
-- Expression data with the primitive expression values as the
|
-- Expression data with the primitive expression values as the
|
||||||
-- constructors
|
-- constructors
|
||||||
|
|
||||||
data Expression = Number Double
|
data Expression = Number Double
|
||||||
| Symbol String
|
| Symbol String
|
||||||
| SExpr [Expression]
|
| SExpr [Expression]
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
module Parser where
|
module Parser where
|
||||||
|
|
||||||
import Text.ParserCombinators.Parsec
|
import Text.ParserCombinators.Parsec
|
||||||
import Data.Char
|
|
||||||
|
|
||||||
import Expression
|
import Expression
|
||||||
|
|
||||||
|
@ -11,11 +10,11 @@ parseExpression s = do
|
||||||
e <- parse anyExpressionParser "" s
|
e <- parse anyExpressionParser "" s
|
||||||
return e
|
return e
|
||||||
|
|
||||||
-- Parser any possible expression
|
-- Parser for any possible expression
|
||||||
anyExpressionParser :: GenParser Char st Expression
|
anyExpressionParser :: GenParser Char st Expression
|
||||||
anyExpressionParser = numberParser <|> symbolParser <|> sexprParser
|
anyExpressionParser = numberParser <|> symbolParser <|> sexprParser
|
||||||
|
|
||||||
-- Parses an S-expr
|
-- Parser for an S-expr
|
||||||
sexprParser :: GenParser Char st Expression
|
sexprParser :: GenParser Char st Expression
|
||||||
sexprParser = do
|
sexprParser = do
|
||||||
_ <- spaces
|
_ <- spaces
|
||||||
|
@ -25,7 +24,7 @@ sexprParser = do
|
||||||
_ <- char ')' >> spaces
|
_ <- char ')' >> spaces
|
||||||
return $ SExpr es
|
return $ SExpr es
|
||||||
|
|
||||||
-- Parses a symbol
|
-- Parser for a symbol
|
||||||
symbolParser :: GenParser Char st Expression
|
symbolParser :: GenParser Char st Expression
|
||||||
symbolParser = Symbol <$> do
|
symbolParser = Symbol <$> do
|
||||||
c <- symbolChar
|
c <- symbolChar
|
||||||
|
@ -33,7 +32,7 @@ symbolParser = Symbol <$> do
|
||||||
return $ c:cs
|
return $ c:cs
|
||||||
where symbolChar = letter <|> oneOf "!#$%&*+-/:<=>?@\\^_`~"
|
where symbolChar = letter <|> oneOf "!#$%&*+-/:<=>?@\\^_`~"
|
||||||
|
|
||||||
-- Parses a number
|
-- Parser for a number
|
||||||
numberParser :: GenParser Char st Expression
|
numberParser :: GenParser Char st Expression
|
||||||
numberParser = do
|
numberParser = do
|
||||||
num <- read <$> many1 digit
|
num <- read <$> many1 digit
|
||||||
|
|
|
@ -1,10 +1,15 @@
|
||||||
module Primitives where
|
module Primitives (pAdd, pSub, pMul, pDiv) where
|
||||||
|
|
||||||
|
-- This module exports the primitve expressions for our language
|
||||||
|
|
||||||
import Expression
|
import Expression
|
||||||
|
|
||||||
pAdd, pSub, pMul, pDiv :: [Expression] -> Expression
|
pArith :: (Double -> Double -> Double) -> [Expression] -> Expression
|
||||||
|
pArith f es = Number . foldr1 f $ map unnum es
|
||||||
|
where unnum = \(Number x) -> x
|
||||||
|
|
||||||
pAdd = foldr1 $ \(Number a) (Number b) -> Number (a+b)
|
pAdd, pSub, pMul, pDiv :: [Expression] -> Expression
|
||||||
pSub = foldr1 $ \(Number a) (Number b) -> Number (a-b)
|
pAdd = pArith (+)
|
||||||
pMul = foldr1 $ \(Number a) (Number b) -> Number (a*b)
|
pSub = pArith (-)
|
||||||
pDiv = foldr1 $ \(Number a) (Number b) -> Number (a/b)
|
pMul = pArith (*)
|
||||||
|
pDiv = pArith (/)
|
||||||
|
|
Loading…
Reference in New Issue