Skip to content

Instantly share code, notes, and snippets.

@nobsun nobsun/SLang.hs
Last active Nov 3, 2018

Embed
What would you like to do?
Eagerな(おもちゃ)言語
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TupleSections #-}
module SLang where
import Control.Monad.State
import Data.Bool
import Data.Maybe
-- Abstract Syntax
data Term a = Lam a (Term a)
| App (Term a) (Term a)
| Var a
| Let [Bnd a] (Term a)
| Con Int
| Div (Term a) (Term a)
deriving Show
type Bnd a = (a, Term a)
type Alt a = (Term a, Term a)
-- Expression
type Expr = Term Name
type Name = String
-- Expression normalizer
normalize :: Expr -> Expr
normalize expr = case expr of
Lam v body -> Lam v (normalize body)
Var x -> Var x
App e1 e2 -> App (normalize e1) (normalize e2)
Let bs e -> case bs of
[] -> normalize e
(x,e'):bs -> App (Lam x (normalize (Let bs e))) (normalize e')
Con n -> Con n
Div e1 e2 -> Div (normalize e1) (normalize e2)
-- Value
data Value = Val {val_ :: !Int}
| Fun {fun_ :: Value -> Value}
instance Show Value where
show (Val n) = show n
show (Fun _) = "<Function>"
-- Environment
type Bind a = (a, Value)
type Env = [Bind Name]
type Rho = Name -> Value
rho :: Env -> Rho
rho = foldr expand rho0
rho0 :: Rho
rho0 name = error ("Variable unbound : " ++ name)
expand :: (Name, Value) -> Rho -> Rho
expand (var, val) pho var' = bool (pho var') val (var == var')
interp :: Expr -> Env -> Value
interp expr env = case expr of
Lam x e -> Fun (\ !val -> interp e ((x,val) : env))
App e v -> fun_ (interp e env) (interp v env)
Var x -> rho env x
Con n -> Val n
Div e1 e2 -> case interp e1 env of
Val m -> case interp e2 env of
Val n -> Val (m `div` n)
Let bs e -> interp e (expandEnv bs env)
expandEnv :: [(Name, Expr)] -> Env -> Env
expandEnv bnds env = env'
where
env' = foldr f env bnds
f (name, exp) = ((name, interp exp env') :)
--
{- |
評価器
>>> three
Lam "x" (Div (Con 6) (Con 2))
>>> eval three
<Function>
>>> div0
Div (Con 1) (Con 0)
>>> eval div0
*** Exception: divide by zero
>>> bot -- let bot = bot in bot
Let [("bot",Var "bot")] (Var "bot")
>>> ex
App (Lam "x" (Div (Con 6) (Con 2))) (Div (Con 1) (Con 0))
>>> eval ex
*** Exception: divide by zero
>>> ex'
App (Lam "x" (Div (Con 6) (Con 2))) (Let [("bot",Var "bot")] (Var "bot"))
>>> ex''
Let [("bot",Div (Con 1) (Con 0))] (Con 0)
-}
eval :: Expr -> Value
eval = flip interp [] . normalize
--
three :: Expr -- 非正格関数にならない
three = Lam "x" (Div (Con 6) (Con 2))
div0 :: Expr
div0 = Div (Con 1) (Con 0) -- Haskellの例外が発生
bot :: Expr
bot = Let [("bot", Var "bot")] (Var "bot") -- ⊥値をもつ式(評価しようとする無限ループ)
ex :: Expr
ex = App three div0
ex' :: Expr
ex' = App three bot
ex'' :: Expr
ex'' = Let [("bot", div0)] (Con 0)
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.