Removed define, added set! & added envs
This commit is contained in:
parent
132b3972a0
commit
7218e4b4fb
|
@ -5,23 +5,21 @@ import ExprType
|
||||||
|
|
||||||
type Env = M.Map String Expr
|
type Env = M.Map String Expr
|
||||||
type Proc = String
|
type Proc = String
|
||||||
type Args = [Expr]
|
|
||||||
|
|
||||||
eval :: Expr -> Expr
|
|
||||||
eval (IntE x) = IntE x
|
|
||||||
eval (VarE v) = VarE v
|
|
||||||
eval (DefinitionE v exp) = NilE
|
|
||||||
eval (ProcedureE p args) = apply p args
|
|
||||||
eval NilE = NilE
|
|
||||||
|
|
||||||
apply :: Proc -> Args -> Expr
|
|
||||||
apply p args
|
|
||||||
| p == "+" = builtinPlus $ map eval args
|
|
||||||
-- TODO: create a separated file for builtinProcs
|
-- TODO: create a separated file for builtinProcs
|
||||||
-- TODO: create a BuiltinProc or something like that in data Expr, and make + a builtin proc
|
-- TODO: create a BuiltinProc or something like that in data Expr, and make + a builtin proc
|
||||||
-- TODO: create enviroments
|
-- TODO: create enviroments
|
||||||
|
|
||||||
builtinPlus :: [Expr] -> Expr
|
base :: Env
|
||||||
builtinPlus [IntE x, IntE y] = IntE $ x + y
|
base = M.fromList [
|
||||||
builtinPlus ((IntE x):xs) = IntE $ x + n
|
("test-var", IntE 10)
|
||||||
where (IntE n) = builtinPlus xs
|
]
|
||||||
|
|
||||||
|
eval :: Env -> Expr -> (Env, Expr)
|
||||||
|
eval env (IntE x) = (env, IntE x)
|
||||||
|
eval env (VarE v) = (env, env M.! v)
|
||||||
|
eval env (SetE v expr) = (M.insert v expr env, NilE)
|
||||||
|
eval env NilE = (env, NilE)
|
||||||
|
|
||||||
|
--apply :: Proc -> Args -> Expr
|
||||||
|
--apply p args
|
||||||
|
|
|
@ -49,11 +49,11 @@ nilE = do
|
||||||
defineE :: GenParser Token st Expr
|
defineE :: GenParser Token st Expr
|
||||||
defineE = do
|
defineE = do
|
||||||
_ <- parseLeftParenT
|
_ <- parseLeftParenT
|
||||||
_ <- parseDefineT
|
_ <- parseSetT
|
||||||
(VarT var) <- parseVarT
|
(VarT var) <- parseVarT
|
||||||
expr <- expressionFromTokens
|
expr <- expressionFromTokens
|
||||||
_ <- parseRightParenT
|
_ <- parseRightParenT
|
||||||
return $ DefinitionE var expr
|
return $ SetE var expr
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
|
|
||||||
|
@ -68,8 +68,8 @@ parseLeftParenT = satisfyT (== LeftParenT)
|
||||||
parseRightParenT :: GenParser Token st Token
|
parseRightParenT :: GenParser Token st Token
|
||||||
parseRightParenT = satisfyT (== RightParenT)
|
parseRightParenT = satisfyT (== RightParenT)
|
||||||
|
|
||||||
parseDefineT :: GenParser Token st Token
|
parseSetT :: GenParser Token st Token
|
||||||
parseDefineT = satisfyT (== DefineT)
|
parseSetT = satisfyT (== SetT)
|
||||||
|
|
||||||
parseNilT :: GenParser Token st Token
|
parseNilT :: GenParser Token st Token
|
||||||
parseNilT = satisfyT (== NilT)
|
parseNilT = satisfyT (== NilT)
|
||||||
|
|
|
@ -3,7 +3,7 @@ module ExprType where
|
||||||
data Expr = IntE Integer
|
data Expr = IntE Integer
|
||||||
| VarE String
|
| VarE String
|
||||||
| ProcedureE String [Expr]
|
| ProcedureE String [Expr]
|
||||||
| DefinitionE String Expr
|
| SetE String Expr
|
||||||
| NilE
|
| NilE
|
||||||
|
|
||||||
instance Show Expr where
|
instance Show Expr where
|
||||||
|
|
27
src/Main.hs
27
src/Main.hs
|
@ -2,7 +2,6 @@ module Main where
|
||||||
|
|
||||||
import Evaluator
|
import Evaluator
|
||||||
import ExprParser
|
import ExprParser
|
||||||
import Text.Parsec.Error
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import System.Console.Haskeline
|
import System.Console.Haskeline
|
||||||
|
@ -10,21 +9,21 @@ import System.Console.Haskeline
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
putStrLn logo
|
putStrLn logo
|
||||||
runInputT defaultSettings loop
|
runInputT defaultSettings repl
|
||||||
where loop = do
|
|
||||||
|
repl :: InputT IO ()
|
||||||
|
repl = do
|
||||||
|
repl' base
|
||||||
|
where repl' env = do
|
||||||
line <- getInputLine "cherry> "
|
line <- getInputLine "cherry> "
|
||||||
unless (isNothing line) $ do
|
unless (isNothing line) $ do
|
||||||
let r = readEval $ fromJust line
|
let expr = parseExpression $ fromJust line
|
||||||
outputStrLn $ case r of
|
let (nEnv, out) = case expr of
|
||||||
Right res -> res
|
(Left err) -> (env, show err)
|
||||||
Left err -> show err
|
(Right expr') -> let (env', nExp) = eval env expr'
|
||||||
loop
|
in (env', show nExp)
|
||||||
|
outputStrLn out
|
||||||
readEval :: String -> Either ParseError String
|
repl' nEnv
|
||||||
readEval s = do
|
|
||||||
expr <- parseExpression s
|
|
||||||
let result = eval expr
|
|
||||||
return $ show result
|
|
||||||
|
|
||||||
logo :: String
|
logo :: String
|
||||||
logo = unlines [""," /\\", " | \\", " @ @",""]
|
logo = unlines [""," /\\", " | \\", " @ @",""]
|
||||||
|
|
|
@ -13,7 +13,7 @@ parseTokens = do
|
||||||
return tokns
|
return tokns
|
||||||
|
|
||||||
anyLispToken :: GenParser Char st Token
|
anyLispToken :: GenParser Char st Token
|
||||||
anyLispToken = leftParenT <|> rightParenT <|> try nilT <|> try defineT <|> varT <|> intT
|
anyLispToken = leftParenT <|> rightParenT <|> try nilT <|> try setT <|> varT <|> intT
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
|
|
||||||
|
@ -28,8 +28,8 @@ leftParenT = char '(' >> return LeftParenT
|
||||||
rightParenT :: GenParser Char st Token
|
rightParenT :: GenParser Char st Token
|
||||||
rightParenT = char ')' >> return RightParenT
|
rightParenT = char ')' >> return RightParenT
|
||||||
|
|
||||||
defineT :: GenParser Char st Token
|
setT :: GenParser Char st Token
|
||||||
defineT = caseInsensitiveString "define" >> return DefineT
|
setT = caseInsensitiveString "set!" >> return SetT
|
||||||
|
|
||||||
nilT :: GenParser Char st Token
|
nilT :: GenParser Char st Token
|
||||||
nilT = caseInsensitiveString "nil" >> return NilT
|
nilT = caseInsensitiveString "nil" >> return NilT
|
||||||
|
|
|
@ -2,7 +2,7 @@ module TokenType where
|
||||||
|
|
||||||
data Token = LeftParenT
|
data Token = LeftParenT
|
||||||
| RightParenT
|
| RightParenT
|
||||||
| DefineT
|
| SetT
|
||||||
| VarT String
|
| VarT String
|
||||||
| IntT Integer
|
| IntT Integer
|
||||||
| NilT
|
| NilT
|
||||||
|
|
Loading…
Reference in New Issue