Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
-- The meta-circular interpreter from section 5 of Reynolds's Definitional
-- Interpreters for Higher Order Programming Languages
-- (http://www.cs.uml.edu/~giam/91.531/Textbooks/definterp.pdf)
data EXP
= CONST Const
| VAR Var
| APPL Appl
| LAMBDA Lambda
| COND Cond
| LETREC LetRec
deriving (Show)
newtype Const = Const { evcon :: Val }
deriving (Show)
data Val = ValInt Integer | ValBool Bool | ValFun (Val -> Val)
instance Eq Val where
ValInt i == ValInt j = i == j
ValBool b == ValBool b' = b == b'
_ == _ = False
instance Show Val where
show (ValInt i) = "ValInt " ++ show i
show (ValBool b) = "ValBool " ++ show b
show (ValFun _) = "ValFun undefined"
data Var = Var String
deriving (Show, Eq)
data Appl = Appl { opr :: EXP, opnd :: EXP }
deriving (Show)
data Lambda = Lambda { fp :: Var, lambdaBody :: EXP }
deriving (Show)
data Cond = Cond { prem :: EXP, conc :: EXP, altr :: EXP }
deriving (Show)
data LetRec = LetRec { dvar :: Var, dexp :: Lambda, letRecBody :: EXP }
deriving (Show)
type Env = Var -> Val
eval :: EXP -> Env -> Val
eval r e = case r of
CONST c -> evcon c
VAR v -> e v
APPL a -> case (eval (opr a) e) of
ValFun f -> f (eval (opnd a) e)
_ -> error "APPL operator is not a function"
LAMBDA l -> evlambda l e
COND c -> case eval (prem c) e of
ValBool True -> eval (conc c) e
ValBool False -> eval (altr c) e
_ -> error "COND premise is not boolean"
LETREC lrc ->
let e' = \x -> if x == dvar lrc
then evlambda (dexp lrc) e'
else e x
in eval (letRecBody lrc) e'
where
evlambda :: Lambda -> Env -> Val
evlambda l e = ValFun (\a -> eval (lambdaBody l) (ext (fp l) a e))
ext :: Var -> Val -> Env -> Env
ext z a e = \x -> if x == z then a else e z
interpret r = eval r initenv
where
initenv :: Env
initenv x = case x of
Var "succ" -> ValFun (\(ValInt i) -> ValInt (succ i))
Var "equal" -> ValFun (\a -> ValFun (\b -> ValBool (a == b)))
main = print $ interpret $ APPL (Appl (VAR (Var "succ")) (CONST (Const (ValInt 1))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.