-- Een lambdacalculus -------------------------------------------------------------------------------- -- Een variabelenaam type Name = String -- Een term in de lambdacalculus data Term = Var Name | Con Int | Add Term Term | Lam Name Term | App Term Term -- Een waarde in de lambdacalculus (geen Wrong) data Value = Num Int -- Een getal | Fun (Value -> M Value) -- Een monadische functie -- De evaluatieomgeving: variabelenamen gecombineerd met hun waarde type Environment = [(Name,Value)] -- Een waarde afdrukken instance Show Value where show (Num i) = show i show (Fun f) = "<function>" -- Een eigen monad -------------------------------------------------------------------------------- -- Een datatype voor foutlopende uitkomsten data E a = Success a | Error String -- M is de identity monad type M a = E a unitM :: a -> M a unitM x = undefined bindM :: M a -> (a -> M b) -> M b x `bindM` k = undefined showM :: (Show a) => M a -> String showM = undefined -- De monadische interpreter -------------------------------------------------------------------------------- -- Zoek een variabele op in de omgeving lookUp :: Name -> Environment -> M Value -- aangepast ten opzichte van de vorige versie lookUp x [] = Error $ "Variable " ++ show x ++ " niet gevonden in de omgeving" lookUp x ((y,b):e) = if x == y then unitM b else lookUp x e -- Tel twee getalwaarden op add :: Value -> Value -> M Value add (Num i) (Num j) = unitM (Num (i+j)) -- aangepast ten opzicht van de vorige versie add a b = Error $ "Kan: '" ++ show a ++ "' niet optellen bij '" ++ show b ++ "'" -- Pas een functiewaarde toe op een argumentwaarde apply :: Value -> Value -> M Value apply (Fun k) x = k x -- aangepast ten opzicht van de vorige versie apply f _ = Error $ "Waarde '" ++ show f ++ "' kan niet gebruikt worden als functie" -- Bereken de waarde van een term gegeven een omgeving interp :: Term -> Environment -> M Value interp (Var x) e = lookUp x e interp (Con i) e = unitM (Num i) interp (Add u v) e = interp u e `bindM` (\a -> interp v e `bindM` (\b -> add a b)) interp (Lam x v) e = unitM (Fun (\a -> interp v ((x,a):e))) interp (App t u) e = interp t e `bindM` (\f -> interp u e `bindM` (\a -> apply f a)) -- Een term uitrekenen en afdrukken test :: Term -> String test t = showM (interp t [])