No title

lyxia 2018-03-06 18:51:07.950061 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 ValSyntax r = ValSyntax
12 { numV :: Int -> r
13 , funV :: (r -> r) -> r
14 }
15
16type Exp a = forall r. Syntax a r -> r
17
18type Val' r = ValSyntax r -> r
19
20evalDict :: Syntax (Val' r) (Val' r)
21evalDict = Syntax
22 { var = id
23 , lam = \f dict -> funV dict $ \r -> f (\_ -> r) dict
24 , app = \a b dict ->
25 a (ValSyntax
26 { numV = error "Not a function."
27 , funV = \f -> f (b dict)
28 })
29 , num = \i dict -> numV dict i
30 }
31
32eval :: Exp (Val' r) -> Val' r
33eval e = e evalDict
34
35pprintDict :: Syntax String String
36pprintDict = Syntax
37 { var = id
38 , lam = \f -> "\\ x -> " ++ f "x"
39 , app = \a b -> "(" ++ a ++ ") (" ++ b ++ ")"
40 , num = show
41 }
42
43pprint :: Exp String -> String
44pprint e = e pprintDict
45
46exampleExp :: Exp a
47exampleExp Syntax{..} = lam $ \f -> app (var f) (num 14)
48
49main = putStrLn $ pprint exampleExp