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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
|
----------------------------------------------------------------------
-- |
-- Maintainer : PL
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/16 05:40:49 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Pretty-printing
-----------------------------------------------------------------------------
module GF.Infra.Print
(Print(..),
prtBefore, prtAfter, prtSep,
prtBeforeAfter, prtPairList,
prIO
) where
-- haskell modules:
import List (intersperse)
import Char (toUpper)
-- gf modules:
import Operations (Err(..))
import Ident (Ident(..))
import AbsGFC
import CF
import CFIdent
import qualified PrintGFC as P
------------------------------------------------------------
prtBefore :: Print a => String -> [a] -> String
prtBefore before = prtBeforeAfter before ""
prtAfter :: Print a => String -> [a] -> String
prtAfter after = prtBeforeAfter "" after
prtSep :: Print a => String -> [a] -> String
prtSep sep = concat . intersperse sep . map prt
prtBeforeAfter :: Print a => String -> String -> [a] -> String
prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ]
prtPairList :: (Print a, Print b) => String -> String -> [(a,b)] -> String
prtPairList comma sep xys = prtSep sep [ prt x ++ comma ++ prt y | (x,y) <- xys ]
prIO :: Print a => a -> IO ()
prIO = putStr . prt
class Print a where
prt :: a -> String
prtList :: [a] -> String
prtList as = "[" ++ prtSep "," as ++ "]"
instance Print a => Print [a] where
prt = prtList
instance (Print a, Print b) => Print (a, b) where
prt (a, b) = "(" ++ prt a ++ "," ++ prt b ++ ")"
instance (Print a, Print b, Print c) => Print (a, b, c) where
prt (a, b, c) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ ")"
instance (Print a, Print b, Print c, Print d) => Print (a, b, c, d) where
prt (a, b, c, d) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ "," ++ prt d ++ ")"
instance Print Char where
prt = return
prtList = id
instance Print Int where
prt = show
instance Print Integer where
prt = show
instance Print a => Print (Maybe a) where
prt (Just a) = prt a
prt Nothing = "Nothing"
instance Print a => Print (Err a) where
prt (Ok a) = prt a
prt (Bad str) = str
----------------------------------------------------------------------
instance Print Ident where
prt = P.printTree
instance Print Term where
prt (Arg arg) = prt arg
prt (con `Con` []) = prt con
prt (con `Con` terms) = prt con ++ "(" ++ prtSep ", " terms ++ ")"
prt (LI ident) = "$" ++ prt ident
prt (R record) = "{" ++ prtSep "; " record ++ "}"
prt (term `P` lbl) = prt term ++ "." ++ prt lbl
prt (T _ table) = "table{" ++ prtSep "; " table ++ "}"
prt (V _ terms) = "values{" ++ prtSep "; " terms ++ "}"
prt (term `S` sel) = "(" ++ prt term ++ " ! " ++ prt sel ++ ")"
prt (FV terms) = "variants{" ++ prtSep " | " terms ++ "}"
prt (term `C` term') = prt term ++ " " ++ prt term'
prt (EInt n) = prt n
prt (K tokn) = show (prt tokn)
prt (E) = show ""
instance Print Patt where
prt (con `PC` []) = prt con
prt (con `PC` pats) = prt con ++ "(" ++ prtSep "," pats ++ ")"
prt (PV ident) = "$" ++ prt ident
prt (PW) = "_"
prt (PR record) = "{" ++ prtSep ";" record ++ "}"
instance Print Label where
prt (L ident) = prt ident
prt (LV nr) = "$" ++ show nr
instance Print Tokn where
prt (KS str) = str
prt tokn@(KP _ _) = show tokn
instance Print ArgVar where
prt (A cat argNr) = prt cat ++ "#" ++ show argNr
instance Print CIdent where
prt (CIQ _ ident) = prt ident
instance Print Case where
prt (pats `Cas` term) = prtSep "|" pats ++ "=>" ++ prt term
instance Print Assign where
prt (lbl `Ass` term) = prt lbl ++ "=" ++ prt term
instance Print PattAssign where
prt (lbl `PAss` pat) = prt lbl ++ "=" ++ prt pat
instance Print Atom where
prt (AC c) = prt c
prt (AD c) = "<" ++ prt c ++ ">"
prt (AV i) = "$" ++ prt i
prt (AM n) = "?" ++ show n
prt atom = show atom
instance Print CType where
prt (RecType rtype) = "{" ++ prtSep "; " rtype ++ "}"
prt (Table ptype vtype) = "(" ++ prt ptype ++ " => " ++ prt vtype ++ ")"
prt (Cn cn) = prt cn
prt (TStr) = "Str"
instance Print Labelling where
prt (lbl `Lbg` ctype) = prt lbl ++ ":" ++ prt ctype
instance Print CFItem where
prt (CFTerm regexp) = prt regexp
prt (CFNonterm cat) = prt cat
instance Print RegExp where
prt (RegAlts words) = "("++prtSep "|" words ++ ")"
prt (RegSpec tok) = prt tok
instance Print CFTok where
prt (TS str) = str
prt (TC (c:str)) = '(' : toUpper c : ')' : str
prt (TL str) = show str
prt (TI n) = "#" ++ show n
prt (TV x) = "$" ++ prt x
prt (TM n s) = "?" ++ show n ++ s
instance Print CFCat where
prt (CFCat (cid,lbl)) = prt cid ++ "-" ++ prt lbl
instance Print CFFun where
prt (CFFun fun) = prt (fst fun)
instance Print Exp where
prt = P.printTree
|
