Total (non-error-throwing) lambda-calculus evaluators.
Last active
November 8, 2020 09:49
-
-
Save chrisdone/0621e8395b7f0367a18e190df2f2935a to your computer and use it in GitHub Desktop.
total-eval.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- https://scm.iis.sinica.edu.tw/home/2008/typed-lambda-calculus-interprete/ | |
-- and http://okmij.org/ftp/tagless-final/course/lecture.pdf which mentions this trick | |
-- | |
-- this approach is inspectable; you can print the AST and manipulate it; count variable references, etc. | |
{-# LANGUAGE GADTs #-} | |
data Exp env t where | |
C :: a -> Exp env a | |
V :: Var env t -> Exp env t | |
L :: Exp (a,env) b -> Exp env (a-> b) | |
A :: Exp env (a-> b) -> Exp env a -> Exp env b | |
data Var env t where | |
VZ :: Var (t, env) t | |
VS :: Var env t -> Var (a, env) t | |
eval :: env -> Exp env t -> t | |
eval env (V v) = lookp v env | |
eval _ (C c) = c | |
eval env (L e) = \x -> eval (x, env) e | |
eval env (A e1 e2) = (eval env e1) (eval env e2) | |
lookp :: Var env t -> env -> t | |
lookp VZ (x,_) = x | |
lookp (VS v) (_, env) = lookp v env | |
{- | |
Example: | |
> eval () (A (L (V VZ)) (C 'a')) | |
'a' | |
-- const | |
> eval () (A (A (L (L (V (VS VZ)))) (C 'a')) (C 123)) | |
'a' | |
-} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- this HOAS approach is total but not inspectable, so is of limited utility | |
-- λ> eval (A (L (\(C i) -> C (i * 2))) (C 2)) | |
-- 4 | |
{-# LANGUAGE GADTs #-} | |
data E a where | |
C :: a -> E a | |
L :: (E a -> E b) -> E (a -> b) | |
A :: E (a -> b) -> E a -> E b | |
eval :: E a -> a | |
eval (L f) = \x -> eval (f (C x)) | |
eval (A e1 e2) = (eval e1) (eval e2) | |
eval (C v) = v | |
-- see also https://gist.github.com/chrisdone/24e47c2952e4ad78c246 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment