|
adamc@1
|
1 (* Copyright (c) 2008, Adam Chlipala
|
|
adamc@1
|
2 * All rights reserved.
|
|
adamc@1
|
3 *
|
|
adamc@1
|
4 * Redistribution and use in source and binary forms, with or without
|
|
adamc@1
|
5 * modification, are permitted provided that the following conditions are met:
|
|
adamc@1
|
6 *
|
|
adamc@1
|
7 * - Redistributions of source code must retain the above copyright notice,
|
|
adamc@1
|
8 * this list of conditions and the following disclaimer.
|
|
adamc@1
|
9 * - Redistributions in binary form must reproduce the above copyright notice,
|
|
adamc@1
|
10 * this list of conditions and the following disclaimer in the documentation
|
|
adamc@1
|
11 * and/or other materials provided with the distribution.
|
|
adamc@1
|
12 * - The names of contributors may not be used to endorse or promote products
|
|
adamc@1
|
13 * derived from this software without specific prior written permission.
|
|
adamc@1
|
14 *
|
|
adamc@1
|
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
|
adamc@1
|
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
adamc@1
|
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
adamc@1
|
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
|
adamc@1
|
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
|
adamc@1
|
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
|
adamc@1
|
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
|
adamc@1
|
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
|
adamc@1
|
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
|
adamc@1
|
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
|
adamc@1
|
25 * POSSIBILITY OF SUCH DAMAGE.
|
|
adamc@1
|
26 *)
|
|
adamc@1
|
27
|
|
adamc@1
|
28 (* Pretty-printing Laconic/Web *)
|
|
adamc@1
|
29
|
|
adamc@4
|
30 structure SourcePrint :> SOURCE_PRINT = struct
|
|
adamc@1
|
31
|
|
adamc@1
|
32 open Print.PD
|
|
adamc@1
|
33 open Print
|
|
adamc@1
|
34
|
|
adamc@4
|
35 open Source
|
|
adamc@1
|
36
|
|
adamc@1
|
37 fun p_kind' par (k, _) =
|
|
adamc@1
|
38 case k of
|
|
adamc@1
|
39 KType => string "Type"
|
|
adamc@1
|
40 | KArrow (k1, k2) => parenIf par (box [p_kind' true k1,
|
|
adamc@1
|
41 space,
|
|
adamc@1
|
42 string "->",
|
|
adamc@1
|
43 space,
|
|
adamc@1
|
44 p_kind k2])
|
|
adamc@1
|
45 | KName => string "Name"
|
|
adamc@1
|
46 | KRecord k => box [string "{", p_kind k, string "}"]
|
|
adamc@1
|
47
|
|
adamc@1
|
48 and p_kind k = p_kind' false k
|
|
adamc@1
|
49
|
|
adamc@1
|
50 fun p_explicitness e =
|
|
adamc@1
|
51 case e of
|
|
adamc@1
|
52 Explicit => string "::"
|
|
adamc@1
|
53 | Implicit => string ":::"
|
|
adamc@1
|
54
|
|
adamc@1
|
55 fun p_con' par (c, _) =
|
|
adamc@1
|
56 case c of
|
|
adamc@1
|
57 CAnnot (c, k) => box [string "(",
|
|
adamc@1
|
58 p_con c,
|
|
adamc@1
|
59 space,
|
|
adamc@1
|
60 string "::",
|
|
adamc@1
|
61 space,
|
|
adamc@1
|
62 p_kind k,
|
|
adamc@1
|
63 string ")"]
|
|
adamc@1
|
64
|
|
adamc@1
|
65 | TFun (t1, t2) => parenIf par (box [p_con' true t1,
|
|
adamc@1
|
66 space,
|
|
adamc@1
|
67 string "->",
|
|
adamc@1
|
68 space,
|
|
adamc@1
|
69 p_con t2])
|
|
adamc@1
|
70 | TCFun (e, x, k, c) => parenIf par (box [string x,
|
|
adamc@1
|
71 space,
|
|
adamc@1
|
72 p_explicitness e,
|
|
adamc@1
|
73 space,
|
|
adamc@1
|
74 p_kind k,
|
|
adamc@1
|
75 space,
|
|
adamc@1
|
76 string "->",
|
|
adamc@1
|
77 space,
|
|
adamc@1
|
78 p_con c])
|
|
adamc@1
|
79 | TRecord (CRecord xcs, _) => box [string "{",
|
|
adamc@1
|
80 p_list (fn (x, c) =>
|
|
adamc@1
|
81 box [p_con x,
|
|
adamc@1
|
82 space,
|
|
adamc@1
|
83 string ":",
|
|
adamc@1
|
84 space,
|
|
adamc@1
|
85 p_con c]) xcs,
|
|
adamc@1
|
86 string "}"]
|
|
adamc@1
|
87 | TRecord c => box [string "$",
|
|
adamc@1
|
88 p_con' true c]
|
|
adamc@1
|
89
|
|
adamc@1
|
90 | CVar s => string s
|
|
adamc@1
|
91 | CApp (c1, c2) => parenIf par (box [p_con c1,
|
|
adamc@1
|
92 space,
|
|
adamc@1
|
93 p_con' true c2])
|
|
adamc@1
|
94 | CAbs (e, x, k, c) => parenIf par (box [string "fn",
|
|
adamc@1
|
95 space,
|
|
adamc@1
|
96 string x,
|
|
adamc@1
|
97 space,
|
|
adamc@1
|
98 p_explicitness e,
|
|
adamc@1
|
99 space,
|
|
adamc@1
|
100 p_kind k,
|
|
adamc@1
|
101 space,
|
|
adamc@1
|
102 string "=>",
|
|
adamc@1
|
103 space,
|
|
adamc@1
|
104 p_con c])
|
|
adamc@1
|
105
|
|
adamc@1
|
106 | CName s => box [string "#", string s]
|
|
adamc@1
|
107
|
|
adamc@1
|
108 | CRecord xcs => box [string "[",
|
|
adamc@1
|
109 p_list (fn (x, c) =>
|
|
adamc@1
|
110 box [p_con x,
|
|
adamc@1
|
111 space,
|
|
adamc@1
|
112 string "=",
|
|
adamc@1
|
113 space,
|
|
adamc@1
|
114 p_con c]) xcs,
|
|
adamc@1
|
115 string "]"]
|
|
adamc@1
|
116 | CConcat (c1, c2) => parenIf par (box [p_con' true c1,
|
|
adamc@1
|
117 space,
|
|
adamc@1
|
118 string "++",
|
|
adamc@1
|
119 space,
|
|
adamc@1
|
120 p_con c2])
|
|
adamc@1
|
121
|
|
adamc@1
|
122 and p_con c = p_con' false c
|
|
adamc@1
|
123
|
|
adamc@1
|
124 fun p_decl ((d, _) : decl) =
|
|
adamc@1
|
125 case d of
|
|
adamc@1
|
126 DCon (x, NONE, c) => box [string "con",
|
|
adamc@1
|
127 space,
|
|
adamc@1
|
128 string x,
|
|
adamc@1
|
129 space,
|
|
adamc@1
|
130 string "=",
|
|
adamc@1
|
131 space,
|
|
adamc@1
|
132 p_con c]
|
|
adamc@1
|
133 | DCon (x, SOME k, c) => box [string "con",
|
|
adamc@1
|
134 space,
|
|
adamc@1
|
135 string x,
|
|
adamc@1
|
136 space,
|
|
adamc@1
|
137 string "::",
|
|
adamc@1
|
138 space,
|
|
adamc@1
|
139 p_kind k,
|
|
adamc@1
|
140 space,
|
|
adamc@1
|
141 string "=",
|
|
adamc@1
|
142 space,
|
|
adamc@1
|
143 p_con c]
|
|
adamc@1
|
144
|
|
adamc@1
|
145 val p_file = p_list_sep newline p_decl
|
|
adamc@1
|
146
|
|
adamc@1
|
147 end
|
