-
Notifications
You must be signed in to change notification settings - Fork 2
/
PrettyPrinter.hs
94 lines (88 loc) · 6.5 KB
/
PrettyPrinter.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
module PrettyPrinter where
import Expression
import Data.Maybe
import System.Console.ANSI
setSGRAbbrev :: IO ()
setSGRAbbrev = setSGR [SetColor Foreground Vivid Green]
setSGRFunCall :: IO ()
setSGRFunCall = setSGR [SetColor Foreground Vivid Red]
setSGRFunArg :: IO ()
setSGRFunArg = setSGR [SetColor Foreground Vivid Blue]
setSGREta :: IO ()
setSGREta = setSGR [SetColor Foreground Vivid Yellow]
prettyPrint :: Expression -> IO ()
prettyPrint term = do aux False term
setSGR []
putStrLn ""
where aux plbd t = case t of
Variable abb s -> do (if isJust abb then setSGRAbbrev else return ())
putStr s
setSGR []
Abstraction eta x f -> do (if eta then setSGREta else return ())
case (x, f) of
(_, Abstraction _ _ _) -> do putStr (if plbd then " " else "\\")
putStr x
aux True f
(_, _) -> do putStr (if plbd then " " else "\\")
putStr x
putStr ". "
aux True f
setSGR []
Application beta f x -> if beta
then do (case (f, x) of
(Abstraction _ _ _, Application _ _ _) -> do putStr "("
setSGRFunCall
putStr $ show f
setSGR []
putStr ") ("
setSGRFunArg
putStr $ show x
setSGR []
putStr ")"
(Abstraction _ _ _, Abstraction _ _ _) -> do putStr "("
setSGRFunCall
putStr $ show f
setSGR []
putStr ") ("
setSGRFunArg
putStr $ show x
setSGR []
putStr ")"
(Abstraction _ _ _, _) -> do putStr "("
setSGRFunCall
putStr $ show f
setSGR []
putStr ") "
setSGRFunArg
putStr $ show x
setSGR []
(_, Variable _ _) -> do putStr $ show f
putStr " "
putStr $ show x
(_, _) -> do putStr $ show f
putStr " ("
putStr $ show x
putStr ")")
setSGR []
else case (f, x) of
(Abstraction _ _ _, Application _ _ _) -> do putStr "("
aux False f
putStr ") ("
aux False x
putStr ")"
(Abstraction _ _ _, Abstraction _ _ _) -> do putStr "("
aux False f
putStr ") ("
aux False x
putStr ")"
(Abstraction _ _ _, _) -> do putStr "("
aux False f
putStr ") "
aux False x
(_, Variable _ _) -> do aux False f
putStr " "
aux False x
(_, _) -> do aux False f
putStr " ("
aux False x
putStr ")"