mirror of
https://github.com/sdiehl/write-you-a-haskell.git
synced 2024-09-11 11:46:57 +03:00
fix partiality for evaluation
This commit is contained in:
parent
456dde3faa
commit
534f229626
@ -1,7 +1,10 @@
|
||||
module Eval where
|
||||
module Eval (
|
||||
runEval,
|
||||
) where
|
||||
|
||||
import Syntax
|
||||
|
||||
import Control.Monad.Identity
|
||||
import Control.Monad.Except
|
||||
import qualified Data.Map as Map
|
||||
|
||||
data Value
|
||||
@ -14,10 +17,11 @@ instance Show Value where
|
||||
show (VBool x) = show x
|
||||
show VClosure{} = "<<closure>>"
|
||||
|
||||
type Evaluate t = Identity t
|
||||
type Eval t = Except String t
|
||||
|
||||
type Scope = Map.Map String Value
|
||||
|
||||
eval :: Eval.Scope -> Expr -> Identity Value
|
||||
eval :: Eval.Scope -> Expr -> Eval Value
|
||||
eval env expr = case expr of
|
||||
Lit (LInt x) -> return $ VInt (fromIntegral x)
|
||||
Lit (LBool x) -> return $ VBool x
|
||||
@ -41,12 +45,12 @@ binop Eql (VInt a) (VInt b) = VBool (a==b)
|
||||
extend :: Scope -> String -> Value -> Scope
|
||||
extend env v t = Map.insert v t env
|
||||
|
||||
apply :: Value -> Value -> Evaluate Value
|
||||
apply :: Value -> Value -> Eval Value
|
||||
apply (VClosure v t0 e) t1 = eval (extend e v t1) t0
|
||||
apply _ _ = error "Tried to apply closure"
|
||||
apply _ _ = throwError "Tried to apply closure"
|
||||
|
||||
emptyScope :: Scope
|
||||
emptyScope = Map.empty
|
||||
|
||||
runEval :: Expr -> Value
|
||||
runEval x = runIdentity (eval emptyScope x)
|
||||
runEval :: Expr -> Either String Value
|
||||
runEval x = runExcept (eval emptyScope x)
|
||||
|
@ -5,6 +5,9 @@ module Lexer (
|
||||
) where
|
||||
|
||||
import Syntax
|
||||
|
||||
import Control.Monad.Except
|
||||
|
||||
}
|
||||
|
||||
%wrapper "basic"
|
||||
@ -58,6 +61,7 @@ data Token
|
||||
| TokenEOF
|
||||
deriving (Eq,Show)
|
||||
|
||||
scanTokens :: String -> [Token]
|
||||
scanTokens = alexScanTokens
|
||||
|
||||
}
|
||||
|
@ -1,4 +1,5 @@
|
||||
import Eval
|
||||
import Syntax (Expr)
|
||||
import Eval (runEval)
|
||||
import Parser (parseExpr, parseTokens)
|
||||
|
||||
import Control.Monad.Trans
|
||||
@ -7,13 +8,23 @@ import System.Console.Haskeline
|
||||
process :: String -> IO ()
|
||||
process input = do
|
||||
let tokens = parseTokens input
|
||||
print tokens
|
||||
putStrLn ("Tokens: " ++ show tokens)
|
||||
let ast = parseExpr input
|
||||
putStrLn ("Syntax: " ++ show ast)
|
||||
case ast of
|
||||
Left err -> do
|
||||
putStrLn "Parser Error:"
|
||||
putStrLn "Parse Error:"
|
||||
print err
|
||||
Right ast -> print $ runEval ast
|
||||
Right ast -> exec ast
|
||||
|
||||
exec :: Expr -> IO ()
|
||||
exec ast = do
|
||||
let result = runEval ast
|
||||
case result of
|
||||
Left err -> do
|
||||
putStrLn "Runtime Error:"
|
||||
putStrLn err
|
||||
Right res -> print res
|
||||
|
||||
main :: IO ()
|
||||
main = runInputT defaultSettings loop
|
||||
|
@ -13,16 +13,14 @@ Usage:
|
||||
|
||||
```ocaml
|
||||
Happy> 42
|
||||
[TokenNum 42]
|
||||
Tokens: [TokenNum 42]
|
||||
Syntax: Right (Lit (LInt 42))
|
||||
42
|
||||
|
||||
Happy> (\x -> x) 1
|
||||
[TokenLParen,TokenLambda,TokenSym "x",TokenArrow,TokenSym "x",TokenRParen,TokenNum 1]
|
||||
Tokens: [TokenLParen,TokenLambda,TokenSym "x",TokenArrow,TokenSym "x",TokenRParen,TokenNum 1]
|
||||
Syntax: Right (App (Lam "x" (Var "x")) (Lit (LInt 1)))
|
||||
1
|
||||
|
||||
Happy> \x -> x*x*x*x*x - x + 1
|
||||
[TokenLambda,TokenSym "x",TokenArrow,TokenSym "x",TokenMul,TokenSym "x",TokenMul,TokenSym "x",TokenMul,TokenSym "x",TokenMul,TokenSym "x",TokenSub,TokenSym "x",TokenAdd,TokenNum 1]
|
||||
<<closure>>
|
||||
```
|
||||
|
||||
License
|
||||
|
Loading…
Reference in New Issue
Block a user