Instructietellende interpreter

-- 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 data Value = Wrong -- De term was ongeldig | 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 Wrong = "<wrong>" show (Num i) = show i show (Fun f) = "<function>" -- Een eigen monad -------------------------------------------------------------------------------- -- De monad die we nu implementeren is de state monad en we houden nummers bij type State = Int -- De state monad is een functie van state naar een antwoord met een nieuwe state type M a = State -> (a, State) unitM :: a -> M a unitM x = undefined bindM :: M a -> (a -> M b) -> M b m `bindM` k = undefined -- om een berekening af te drukken, voeren we ze uit startende bij 0 showM m = let (a, s1) = m 0 in "Waarde: " ++ show a ++ "; Evaluatiestappen: " ++ show s1 -- Verhoog het aantal evaluatiestappen met 1 tickS :: M () tickS = undefined -- De monadische interpreter -------------------------------------------------------------------------------- -- Zoek een variabele op in de omgeving lookUp :: Name -> Environment -> M Value lookUp x [] = unitM Wrong 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) = undefined -- ^ TODO add _ _ = unitM Wrong -- Pas een functiewaarde toe op een argumentwaarde apply :: Value -> Value -> M Value apply (Fun k) a = undefined -- ^ TODO apply _ _ = unitM Wrong -- 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 [])