Finally tagless PHOAS

lyxia 2018-03-06 18:28:35.711251 UTC

1{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE RecordWildCards #-}
3
4data Syntax a r = Syntax
5 { var :: a -> r
6 , lam :: (a -> r) -> r
7 , app :: r -> r -> r
8 , num :: Int -> r
9 }
10
11data Val
12 = NumV Int
13 | FunV (Val -> Val)
14
15type Exp a = forall r. Syntax a r -> r
16
17evalDict :: Syntax Val Val
18evalDict = Syntax
19 { var = id
20 , lam = FunV
21 , app = \e -> case e of
22 FunV f -> f
23 _ -> error "Not a function."
24 , num = NumV
25 }
26
27eval :: Exp Val -> Val
28eval e = e evalDict
29
30pprintDict :: Syntax String String
31pprintDict = Syntax
32 { var = id
33 , lam = \f -> "\\ x -> " ++ f "x"
34 , app = \a b -> "(" ++ a ++ ") (" ++ b ++ ")"
35 , num = show
36 }
37
38pprint :: Exp String -> String
39pprint e = e pprintDict
40
41exampleExp :: Exp a
42exampleExp Syntax{..} = lam $ \f -> app (var f) (num 14)
43
44main = putStrLn $ pprint exampleExp