1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006, Adam Chlipala
4 * This program is free software
; you can redistribute it
and/or
5 * modify it under the terms
of the GNU General Public License
6 * as published by the Free Software Foundation
; either version
2
7 * of the License
, or (at your option
) any later version
.
9 * This program is distributed
in the hope that it will be useful
,
10 * but WITHOUT ANY WARRANTY
; without even the implied warranty
of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
. See the
12 * GNU General Public License for more details
.
14 * You should have received a copy
of the GNU General Public License
15 * along
with this program
; if not
, write to the Free Software
16 * Foundation
, Inc
., 51 Franklin Street
, Fifth Floor
, Boston
, MA
02110-1301, USA
.
19 (* Pretty
-printing Domtool configuration file ASTs
*)
21 structure Print
:> PRINT
= struct
25 structure SM
= TextIOPP
27 structure PD
= PPDescFn(SM
)
30 fun dBox ds
= hovBox (PPS
.Rel
1, ds
)
31 fun dvBox ds
= vBox (PPS
.Rel
0, ds
)
32 fun ivBox ds
= vBox (PPS
.Rel
1, ds
)
36 dBox (string "(" :: ds @
[string ")"])
40 fun p_pred
' pn (p
, _
) =
42 CRoot
=> string "Root"
43 | CConst s
=> string s
44 | CPrefix p
=> dBox
[string "^", p_pred
' true p
]
45 | CNot p
=> dBox
[string "!", p_pred
' true p
]
47 parenIf pn
[p_pred
' true p1
, space
1, string "&", space
1, p_pred
' true p2
]
49 val p_pred
= p_pred
' false
51 fun p_predBoxed p
= dBox
[string "[", p_pred p
, string "]"]
53 fun p_typ
' pn (t
, _
) =
56 | TList t
=> dBox
[string "[", p_typ
' false t
, string "]"]
58 parenIf pn
[p_typ
' true t1
, space
1, string "->", space
1, p_typ
' true t2
]
59 |
TAction (p
, r1
, r2
) =>
60 parenIf pn
[p_predBoxed p
, space
1, p_record r1
, space
1,
61 string "=>", space
1, p_record r2
]
63 parenIf pn
[p_pred
' false p
, space
1, string "=>", space
1, p_typ
' false t
]
65 | TError
=> string "<error>"
66 |
TUnif (_
, ref (SOME t
)) => p_typ
' pn t
67 |
TUnif (name
, ref NONE
) => string ("<" ^ name ^
">")
70 case StringMap
.foldri (fn (name
, t
, d
) =>
72 NONE
=> dBox
[string name
, space
1,
73 string ":", space
1, p_typ t
]
74 | SOME d
=> dBox
[dBox
[string name
, space
1,
75 string ":", space
1, p_typ t
],
76 string ",", space
1, d
]))
79 | SOME d
=> dBox
[string "{", d
, string "}"]
81 and p_typ t
= p_typ
' false t
85 EInt n
=> string (Int.toString n
)
86 | EString s
=> string (String.concat
["\"", String.toString s
, "\""])
88 (case foldr (fn (e
, d
) =>
91 | SOME d
=> dBox
[p_exp e
, string ",", space
1, d
]))
94 | SOME d
=> dBox
[string "[", d
, string "]"])
96 |
ELam (x
, NONE
, e
) => dBox
[string "(\\", space
1, string x
, space
1,
97 string "->", space
1, p_exp e
, string ")"]
98 |
ELam (x
, SOME t
, e
) => dBox
[string "(\\", space
1, string x
, space
1,
100 dBox
[string "(", p_typ t
, string ")"],
101 space
1, string "->", space
1, p_exp e
, string ")"]
104 |
EApp (e1
, e2
) => dBox
[string "(", p_exp e1
, break
{nsp
= 1, offset
= 0}, p_exp e2
, string ")"]
106 | ESkip
=> string "_"
107 |
ESet (x
, e
) => dBox
[string x
, space
1, string "=", space
1, p_exp e
]
108 |
EGet (x1
, x2
, e
) => dBox
[dBox
[string x1
, space
1, string "<-",
109 space
1, string x2
, string ";", space
1],
111 | ESeq es
=> dBox (valOf (foldr (fn (e
, NONE
) => SOME
[p_exp e
]
112 |
(e
, SOME ds
) => SOME (dBox
[p_exp e
, string ";", newline
] :: ds
))
114 |
ELocal (e1
, e2
) => dBox
[string "let", space
1,
116 string "in", space
1,
119 |
EWith (e1
, (ESkip
, _
)) => dBox
[p_exp e1
, space
1, string "with", space
1, string "end"]
120 |
EWith (e1
, e2
) => dBox
[p_exp e1
, space
1, string "with", p_exp e2
, space
1, string "end"]
124 val myStream
= SM
.openOut
{dst
= TextIO.stdOut
,
127 description (myStream
, d
);
129 SM
.closeStream myStream
132 fun preface (s
, d
) = printd (PD
.hovBox (PD
.PPS
.Rel
0,
133 [PD
.string s
, PD
.space
1, d
]))