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 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 BuiltinProc or something like that in data Expr, and make + a builtin proc
|
||||
-- TODO: create enviroments
|
||||
|
||||
builtinPlus :: [Expr] -> Expr
|
||||
builtinPlus [IntE x, IntE y] = IntE $ x + y
|
||||
builtinPlus ((IntE x):xs) = IntE $ x + n
|
||||
where (IntE n) = builtinPlus xs
|
||||
base :: Env
|
||||
base = M.fromList [
|
||||
("test-var", IntE 10)
|
||||
]
|
||||
|
||||
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 = do
|
||||
_ <- parseLeftParenT
|
||||
_ <- parseDefineT
|
||||
_ <- parseSetT
|
||||
(VarT var) <- parseVarT
|
||||
expr <- expressionFromTokens
|
||||
_ <- parseRightParenT
|
||||
return $ DefinitionE var expr
|
||||
return $ SetE var expr
|
||||
|
||||
------------------------------------------------------------
|
||||
|
||||
|
@ -68,8 +68,8 @@ parseLeftParenT = satisfyT (== LeftParenT)
|
|||
parseRightParenT :: GenParser Token st Token
|
||||
parseRightParenT = satisfyT (== RightParenT)
|
||||
|
||||
parseDefineT :: GenParser Token st Token
|
||||
parseDefineT = satisfyT (== DefineT)
|
||||
parseSetT :: GenParser Token st Token
|
||||
parseSetT = satisfyT (== SetT)
|
||||
|
||||
parseNilT :: GenParser Token st Token
|
||||
parseNilT = satisfyT (== NilT)
|
||||
|
|
|
@ -3,7 +3,7 @@ module ExprType where
|
|||
data Expr = IntE Integer
|
||||
| VarE String
|
||||
| ProcedureE String [Expr]
|
||||
| DefinitionE String Expr
|
||||
| SetE String Expr
|
||||
| NilE
|
||||
|
||||
instance Show Expr where
|
||||
|
|
27
src/Main.hs
27
src/Main.hs
|
@ -2,7 +2,6 @@ module Main where
|
|||
|
||||
import Evaluator
|
||||
import ExprParser
|
||||
import Text.Parsec.Error
|
||||
import Control.Monad
|
||||
import Data.Maybe
|
||||
import System.Console.Haskeline
|
||||
|
@ -10,21 +9,21 @@ import System.Console.Haskeline
|
|||
main :: IO ()
|
||||
main = do
|
||||
putStrLn logo
|
||||
runInputT defaultSettings loop
|
||||
where loop = do
|
||||
runInputT defaultSettings repl
|
||||
|
||||
repl :: InputT IO ()
|
||||
repl = do
|
||||
repl' base
|
||||
where repl' env = do
|
||||
line <- getInputLine "cherry> "
|
||||
unless (isNothing line) $ do
|
||||
let r = readEval $ fromJust line
|
||||
outputStrLn $ case r of
|
||||
Right res -> res
|
||||
Left err -> show err
|
||||
loop
|
||||
|
||||
readEval :: String -> Either ParseError String
|
||||
readEval s = do
|
||||
expr <- parseExpression s
|
||||
let result = eval expr
|
||||
return $ show result
|
||||
let expr = parseExpression $ fromJust line
|
||||
let (nEnv, out) = case expr of
|
||||
(Left err) -> (env, show err)
|
||||
(Right expr') -> let (env', nExp) = eval env expr'
|
||||
in (env', show nExp)
|
||||
outputStrLn out
|
||||
repl' nEnv
|
||||
|
||||
logo :: String
|
||||
logo = unlines [""," /\\", " | \\", " @ @",""]
|
||||
|
|
|
@ -13,7 +13,7 @@ parseTokens = do
|
|||
return tokns
|
||||
|
||||
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 = char ')' >> return RightParenT
|
||||
|
||||
defineT :: GenParser Char st Token
|
||||
defineT = caseInsensitiveString "define" >> return DefineT
|
||||
setT :: GenParser Char st Token
|
||||
setT = caseInsensitiveString "set!" >> return SetT
|
||||
|
||||
nilT :: GenParser Char st Token
|
||||
nilT = caseInsensitiveString "nil" >> return NilT
|
||||
|
|
|
@ -2,7 +2,7 @@ module TokenType where
|
|||
|
||||
data Token = LeftParenT
|
||||
| RightParenT
|
||||
| DefineT
|
||||
| SetT
|
||||
| VarT String
|
||||
| IntT Integer
|
||||
| NilT
|
||||
|
|
Loading…
Reference in New Issue