1 module Language.Pointwise.Pretty where
3 import Language.Pointwise.Syntax as Pointwise
4 import Language.Haskell.Exts.Syntax as Exts
7 pw2hs (Pointwise.Var str) = mkVar str
8 pw2hs Unit = mkVar "_L"
9 pw2hs (Const str) = mkVar str
10 pw2hs (t1 :&: t2) = Tuple [pw2hs t1,pw2hs t2]
11 pw2hs (Fst t) = App (mkVar "fst") (mbParen$ pw2hs t)
12 pw2hs (Snd t) = App (mkVar "snd") (mbParen$ pw2hs t)
13 pw2hs (Pointwise.Case t1 (Lam str2 t2) (Lam str3 t3)) =
15 [Alt mkLoc (PApp (UnQual$ Ident "Left") [mkPVar str2])
16 (UnGuardedAlt$ mbParen$ pw2hs t2) (BDecls []),
17 Alt mkLoc (PApp (UnQual$ Ident "Right") [mkPVar str3])
18 (UnGuardedAlt$ mbParen$ pw2hs t3) (BDecls [])]
19 pw2hs (Inl t) = App (mkCon "Left") (mbParen$ pw2hs t)
20 pw2hs (Inr t) = App (mkCon "Right") (mbParen$ pw2hs t)
21 pw2hs (Lam str t) = Lambda mkLoc [mkPVar str] (mbParen (pw2hs t))
22 pw2hs (t1 :@: t2) = App (mbParen$ pw2hs t1) (mbParen$ pw2hs t2)
23 pw2hs (In term) = App (mkVar "inn") (mbParen$ pw2hs term)
24 pw2hs (Out term) = App (mkVar "out") (mbParen$ pw2hs term)
25 pw2hs (Fix term) = App (mkVar "fix") (mbParen$ pw2hs term)
26 pw2hs (Pointwise.Match t alts)= Exts.Case (pw2hs t) (map pw2alt alts)
28 pw2alt (t1,t2) = Alt mkLoc (pw2pat t1) (UnGuardedAlt $ pw2hs t2) $ BDecls []
29 pw2pat (Pointwise.Var s) = mkPVar s
30 pw2pat Unit = PWildCard
31 pw2pat (Const s) = mkPVar s
32 pw2pat (t1 :&: t2) = PTuple [pw2pat t1,pw2pat t2]
33 pw2pat (Inl t) = PApp (UnQual $ Ident "Left") [mbPParen$ pw2pat t]
34 pw2pat (Inr t) = PApp (UnQual $ Ident "Right") [mbPParen$ pw2pat t]
35 pw2pat ((Pointwise.Var str) :@: t2) =
36 PApp (UnQual $ Ident str) [mbPParen$ pw2pat t2]
37 pw2pat t = error $ "not a valid pattern - " ++ show t
41 mkCon = Con . UnQual . Ident
42 mkVar = Exts.Var . UnQual . Ident
44 -- places parentisis only if it is necessary
46 mbParen e@(App _ _) = Paren e
47 mbParen e@(InfixApp _ _ _) = Paren e
48 mbParen e@(Exts.Case _ _) = Paren e
49 mbParen e@(Lambda _ _ _) = Paren e
50 mbParen e@(ExpTypeSig _ _ _) = Paren e
52 mbPParen :: Pat -> Pat
53 mbPParen p@(PApp _ _) = PParen p