summaryrefslogtreecommitdiff
path: root/lambda-calcul/haskell/src
diff options
context:
space:
mode:
Diffstat (limited to 'lambda-calcul/haskell/src')
-rw-r--r--lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs19
1 files changed, 13 insertions, 6 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs
index 9d56c49..e5530eb 100644
--- a/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs
+++ b/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs
@@ -4,7 +4,8 @@
module Minilang.Lambda.Eval where
import Data.Aeson (FromJSON, ToJSON)
-import Data.Text (Text)
+import Data.String (IsString (..))
+import Data.Text (Text, pack)
import GHC.Generics (Generic)
data Term
@@ -13,6 +14,9 @@ data Term
| App Term Term
deriving (Show, Read, Eq, Generic, ToJSON, FromJSON)
+instance IsString Term where
+ fromString = Var . pack
+
data Value = Clos EnvValue Text Term | VNeut Neutral
deriving (Show, Read, Eq)
@@ -26,15 +30,21 @@ type EnvValue = [(Text, Value)]
newEnv :: Env
newEnv = []
+normalise :: Term -> Term
+normalise term = readBack (eval [] term)
+
-- call-by-value evaluator
-- from https://davidchristiansen.dk/tutorials/nbe/#%28part._untyped-eval%29
eval :: EnvValue -> Term -> Value
eval env = \case
Var x -> case lookup x env of
Just term -> term
- Nothing -> error $ "Unbound variable: " ++ show x
+ Nothing -> VNeut (NVar x)
Lam x body -> Clos env x body
- App f a -> apply (eval env f) (eval env a)
+ App f a ->
+ let f' = eval env f
+ a' = eval env a
+ in f' `seq` a' `seq` apply f' a'
apply :: Value -> Value -> Value
apply f a =
@@ -56,9 +66,6 @@ readBack = go []
VNeut (NVar n) -> Var n
VNeut (NApp f a) -> App (go names (VNeut f)) (go names a)
-normalise :: Term -> Term
-normalise term = readBack (eval [] term)
-
freshName :: Text -> [Text] -> Text
freshName x names
| x `elem` names = freshName (x <> "'") names