*Anonymous Coward*
2018-03-07 17:39:53.783393 UTC

1 | newtype Eval a = E { eval :: a } |

2 | newtype (Show a) => PPrint a = PP { pprint :: String } |

3 | newtype Desugar repr a = D { desugar :: repr a } |

4 | |

5 | |

6 | type family Var (repr :: * -> *) a |

7 | type instance Var Eval a = a |

8 | type instance Var PPrint a = String |

9 | type instance Var (Desugar repr) a = Var repr a |

10 | |

11 | |

12 | class PHOAS (repr :: * -> *) where |

13 | varP :: Var repr a -> repr a |

14 | lamP :: (Var repr a -> repr b) -> repr (a -> b) |

15 | appP :: repr (a -> b) -> repr a -> repr b |

16 | liftP :: a -> repr a |

17 | |

18 | |

19 | instance (PHOAS repr) => PHOAS (Desugar repr) where |

20 | varP = varP |

21 | lamP = lamP |

22 | appP = appP |

23 | liftP = liftP |

24 | |

25 | |

26 | instance PHOAS Eval where |

27 | varP = E |

28 | lamP f = E (eval . f) |

29 | appP x y = E . eval x $ eval y |

30 | liftP = E |

31 | |

32 | foo = lamP $ \x -> varP x |

33 | |

34 | x = eval foo 10 |

35 | y = eval (desugar foo) 10 |

36 | |

37 | -- x evaluates |

38 | -- y loops forever |