From e656098a35ee9cc0bc86729d2ebbbb13047ad61d Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Fri, 7 Nov 2025 19:26:01 +0100 Subject: fix call-by-value evaluator base on NBE --- lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) (limited to 'lambda-calcul/haskell/src/Minilang/Lambda') 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 -- cgit v1.3.1