Mercurial > urweb

comparison src/cjr_print.sml @ 109:813e5a52063d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove closure conversion in favor of zany fun with modules, which also replaces 'page'
author Adam Chlipala <adamc@hcoop.net>
date Sun, 13 Jul 2008 10:17:06 -0400
parents d101cb1efe55
children ff13d390ec60
comparison
equal deleted inserted replaced
108:f59553dc1b6a 109:813e5a52063d
42 val dummyTyp = (TNamed 0, ErrorMsg.dummySpan) 42 val dummyTyp = (TNamed 0, ErrorMsg.dummySpan)
43 43
44 fun p_typ' par env (t, loc) = 44 fun p_typ' par env (t, loc) =
45 case t of 45 case t of
46 TTop => string "void*" 46 TTop => string "void*"
47 | TFun => 47 | TFun (t1, t2) => parenIf par (box [p_typ' true env t2,
48 (EM.errorAt loc "Undetermined function type"; 48 space,
49 string "?->") 49 string "(*)",
50 | TCode (t1, t2) => parenIf par (box [p_typ' true env t2, 50 space,
51 space, 51 string "(",
52 string "(*)", 52 p_typ env t1,
53 space, 53 string ")"])
54 string "(",
55 p_typ env t1,
56 string ")"])
57 | TRecord i => box [string "struct", 54 | TRecord i => box [string "struct",
58 space, 55 space,
59 string "__lws_", 56 string "__lws_",
60 string (Int.toString i)] 57 string (Int.toString i)]
61 | TNamed n => 58 | TNamed n =>
66 and p_typ env = p_typ' false env 63 and p_typ env = p_typ' false env
67 64
68 fun p_rel env n = string ("__lwr_" ^ #1 (E.lookupERel env n) ^ "_" ^ Int.toString (E.countERels env - n - 1)) 65 fun p_rel env n = string ("__lwr_" ^ #1 (E.lookupERel env n) ^ "_" ^ Int.toString (E.countERels env - n - 1))
69 handle CjrEnv.UnboundRel _ => string ("__lwr_UNBOUND_" ^ Int.toString (E.countERels env - n - 1)) 66 handle CjrEnv.UnboundRel _ => string ("__lwr_UNBOUND_" ^ Int.toString (E.countERels env - n - 1))
70 67
68 fun p_enamed env n =
69 string ("__lwn_" ^ #1 (E.lookupENamed env n) ^ "_" ^ Int.toString n)
70 handle CjrEnv.UnboundNamed _ => string ("__lwn_UNBOUND_" ^ Int.toString n)
71
71 fun p_exp' par env (e, _) = 72 fun p_exp' par env (e, _) =
72 case e of 73 case e of
73 EPrim p => Prim.p_t p 74 EPrim p => Prim.p_t p
74 | ERel n => p_rel env n 75 | ERel n => p_rel env n
75 | ENamed n => 76 | ENamed n => p_enamed env n
76 (string ("__lwn_" ^ #1 (E.lookupENamed env n) ^ "_" ^ Int.toString n) 77
77 handle CjrEnv.UnboundNamed _ => string ("__lwn_UNBOUND_" ^ Int.toString n))
78 | EFfi (m, x) => box [string "lw_", string m, string "_", string x] 78 | EFfi (m, x) => box [string "lw_", string m, string "_", string x]
79 | EFfiApp (m, x, es) => box [string "lw_", 79 | EFfiApp (m, x, es) => box [string "lw_",
80 string m, 80 string m,
81 string "_", 81 string "_",
82 string x, 82 string x,
83 string "(", 83 string "(",
84 p_list (p_exp env) es, 84 p_list (p_exp env) es,
85 string ")"] 85 string ")"]
86 | ECode n => string ("__lwc_" ^ Int.toString n)
87 | EApp (e1, e2) => parenIf par (box [p_exp' true env e1, 86 | EApp (e1, e2) => parenIf par (box [p_exp' true env e1,
88 string "(", 87 string "(",
89 p_exp env e2, 88 p_exp env e2,
90 string ")"]) 89 string ")"])
91 90
109 string "})" ] 108 string "})" ]
110 | EField (e, x) => 109 | EField (e, x) =>
111 box [p_exp' true env e, 110 box [p_exp' true env e,
112 string ".", 111 string ".",
113 string x] 112 string x]
114
115 | ELet (xes, e) =>
116 let
117 val (env, pps) = foldl (fn ((x, t, e), (env, pps)) =>
118 let
119 val env' = E.pushERel env x t
120 in
121 (env',
122 List.revAppend ([p_typ env t,
123 space,
124 p_rel env' 0,
125 space,
126 string "=",
127 space,
128 p_exp env e,
129 string ";",
130 newline],
131 pps))
132 end)
133 (env, []) xes
134 in
135 box [string "({",
136 newline,
137 box (rev pps),
138 p_exp env e,
139 space,
140 string ";",
141 newline,
142 string "})"]
143 end
144 113
145 | EWrite e => box [string "(lw_write(", 114 | EWrite e => box [string "(lw_write(",
146 p_exp env e, 115 p_exp env e,
147 string "), lw_unit_v)"] 116 string "), lw_unit_v)"]
148 117
178 space, 147 space,
179 string "=", 148 string "=",
180 space, 149 space,
181 p_exp env e, 150 p_exp env e,
182 string ";"] 151 string ";"]
183 | DFun (n, x, dom, ran, e) => 152 | DFun (fx, n, x, dom, ran, e) =>
184 let 153 let
185 val env' = E.pushERel env x dom 154 val env' = E.pushERel env x dom
186 in 155 in
187 box [string "static", 156 box [string "static",
188 space, 157 space,
189 p_typ env ran, 158 p_typ env ran,
190 space, 159 space,
191 string ("__lwc_" ^ Int.toString n), 160 string ("__lwn_" ^ fx ^ "_" ^ Int.toString n),
192 string "(", 161 string "(",
193 p_typ env dom, 162 p_typ env dom,
194 space, 163 space,
195 p_rel env' 0, 164 p_rel env' 0,
196 string ")", 165 string ")",
202 string ");"], 171 string ");"],
203 newline, 172 newline,
204 string "}"] 173 string "}"]
205 end 174 end
206 175
207 fun p_page env (xts, (e, loc)) = 176 fun p_page env n = box [p_enamed env n,
208 case e of 177 string "(lw_unit_v);"]
209 ERecord (_, xes) =>
210 let
211 fun read x = ListUtil.search (fn (x', e) => if x' = x then SOME e else NONE) xes
212 in
213 case (read "code", read "env") of
214 (SOME code, SOME envx) =>
215 (case #1 code of
216 ECode i =>
217 let
218 val (_, (dom, _), _) = E.lookupF env i
219 in
220 case dom of
221 TRecord ri =>
222 let
223 val axts = E.lookupStruct env ri
224 fun read x = ListUtil.search (fn (x', t) => if x' = x then SOME t else NONE) axts
225 in
226 case read "arg" of
227 NONE => string "Page handler is too complicated! [5]"
228 | SOME (at, _) =>
229 case at of
230 TRecord ari =>
231 let
232 val r = (ERecord (ri, [("env", envx),
233 ("arg", (ERecord (ari, []), loc))]), loc)
234 in
235 box [p_exp env (EApp (code, r), loc),
236 string ";"]
237 end
238 | _ => string "Page handler is too complicated! [6]"
239 end
240 | _ => string "Page handler is too complicated! [4]"
241 end
242 | _ => string "Page handler is too complicated! [3]")
243
244 | _ => string "Page handler is too complicated! [1]"
245 end
246 | _ => string "Page handler is too complicated! [2]"
247 178
248 fun p_file env (ds, ps) = 179 fun p_file env (ds, ps) =
249 let 180 let
250 val (pds, env) = ListUtil.foldlMap (fn (d, env) => 181 val (pds, env) = ListUtil.foldlMap (fn (d, env) =>
251 (p_decl env d, 182 (p_decl env d,