Mercurial > urweb

comparison src/cjr_print.sml @ 101:717b6f8d8505

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First executable generated
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 11:13:49 -0400
parents 4f641f8fddaa
children 5f04adf47f48
comparison
equal deleted inserted replaced
100:f0f59e918cac 101:717b6f8d8505
41 41
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 => 46 TTop => string "void*"
47 (EM.errorAt loc "Undetermined type";
48 string "?")
49 | TFun => 47 | TFun =>
50 (EM.errorAt loc "Undetermined function type"; 48 (EM.errorAt loc "Undetermined function type";
51 string "?->") 49 string "?->")
52 | TCode (t1, t2) => parenIf par (box [p_typ' true env t2, 50 | TCode (t1, t2) => parenIf par (box [p_typ' true env t2,
53 space, 51 space,
186 space, 184 space,
187 string "{", 185 string "{",
188 newline, 186 newline,
189 box[string "return(", 187 box[string "return(",
190 p_exp env' e, 188 p_exp env' e,
191 string ")"], 189 string ");"],
192 newline, 190 newline,
193 string "}"] 191 string "}"]
194 end 192 end
195 193
196 fun p_file env file = 194 fun p_page env (xts, (e, loc)) =
195 case e of
196 ERecord (_, xes) =>
197 let
198 fun read x = ListUtil.search (fn (x', e) => if x' = x then SOME e else NONE) xes
199 in
200 case (read "code", read "env") of
201 (SOME code, SOME envx) =>
202 (case #1 code of
203 ECode i =>
204 let
205 val (_, (dom, _), _) = E.lookupF env i
206 in
207 case dom of
208 TRecord ri =>
209 let
210 val axts = E.lookupStruct env ri
211 fun read x = ListUtil.search (fn (x', t) => if x' = x then SOME t else NONE) axts
212 in
213 case read "arg" of
214 NONE => string "Page handler is too complicated! [5]"
215 | SOME (at, _) =>
216 case at of
217 TRecord ari =>
218 let
219 val r = (ERecord (ri, [("env", envx),
220 ("arg", (ERecord (ari, []), loc))]), loc)
221 in
222 box [string "return",
223 space,
224 p_exp env (EApp (code, r), loc),
225 string ";"]
226 end
227 | _ => string "Page handler is too complicated! [6]"
228 end
229 | _ => string "Page handler is too complicated! [4]"
230 end
231 | _ => string "Page handler is too complicated! [3]")
232
233 | _ => string "Page handler is too complicated! [1]"
234 end
235 | _ => string "Page handler is too complicated! [2]"
236
237 fun p_file env (ds, ps) =
197 let 238 let
198 val (pds, _) = ListUtil.foldlMap (fn (d, env) => 239 val (pds, env) = ListUtil.foldlMap (fn (d, env) =>
199 (p_decl env d, 240 (p_decl env d,
200 E.declBinds env d)) 241 E.declBinds env d))
201 env file 242 env ds
243 val pds' = map (p_page env) ps
202 in 244 in
203 p_list_sep newline (fn x => x) pds 245 box [string "#include \"lacweb.h\"",
246 newline,
247 newline,
248 p_list_sep newline (fn x => x) pds,
249 newline,
250 string "char *lw_handle(void) {",
251 newline,
252 p_list_sep newline (fn x => x) pds',
253 newline,
254 string "}",
255 newline]
204 end 256 end
205 257
206 end 258 end