Mercurial > urweb

comparison src/cjr_print.sml @ 196:890a61991263

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Lists all the way through
author Adam Chlipala <adamc@hcoop.net>
date Sat, 09 Aug 2008 16:48:32 -0400
parents 3eb53c957d10
children b1b9bcfd8c42
comparison
equal deleted inserted replaced
195:85b5f663bb86 196:890a61991263
51 val compare = Char.compare 51 val compare = Char.compare
52 end) 52 end)
53 53
54 val debug = ref false 54 val debug = ref false
55 55
56 val dummyTyp = (TDatatype (Enum, 0, []), ErrorMsg.dummySpan) 56 val dummyTyp = (TDatatype (Enum, 0, ref []), ErrorMsg.dummySpan)
57 57
58 fun p_typ' par env (t, loc) = 58 fun p_typ' par env (t, loc) =
59 case t of 59 case t of
60 TTop => string "void*" 60 TTop => string "void*"
61 | TFun (t1, t2) => parenIf par (box [p_typ' true env t2, 61 | TFun (t1, t2) => parenIf par (box [p_typ' true env t2,
104 string x, 104 string x,
105 string "_", 105 string "_",
106 string (Int.toString (E.countERels env)), 106 string (Int.toString (E.countERels env)),
107 string ";", 107 string ";",
108 newline], 108 newline],
109 env) 109 E.pushERel env x t)
110 | PPrim _ => (box [], env) 110 | PPrim _ => (box [], env)
111 | PCon (_, _, NONE) => (box [], env) 111 | PCon (_, _, NONE) => (box [], env)
112 | PCon (_, _, SOME p) => p_pat_preamble env p 112 | PCon (_, _, SOME p) => p_pat_preamble env p
113 | PRecord xps => 113 | PRecord xps =>
114 foldl (fn ((_, p, _), (pp, env)) => 114 foldl (fn ((_, p, _), (pp, env)) =>
178 val (x, to) = case pc of 178 val (x, to) = case pc of
179 PConVar n => 179 PConVar n =>
180 let 180 let
181 val (x, to, _) = E.lookupConstructor env n 181 val (x, to, _) = E.lookupConstructor env n
182 in 182 in
183 ("__lwc_" ^ x, to) 183 ("lw_" ^ x, to)
184 end 184 end
185 | PConFfi {mod = m, con, arg, ...} => 185 | PConFfi {mod = m, con, arg, ...} =>
186 ("lw_" ^ m ^ "_" ^ con, arg) 186 ("lw_" ^ m ^ "_" ^ con, arg)
187 187
188 val t = case to of 188 val t = case to of
245 space, 245 space,
246 string "=", 246 string "=",
247 space, 247 space,
248 string "disc", 248 string "disc",
249 string (Int.toString depth), 249 string (Int.toString depth),
250 string ".", 250 string ".__lwf_",
251 string x, 251 string x,
252 string ";", 252 string ";",
253 newline, 253 newline,
254 p, 254 p,
255 newline, 255 newline,
280 let 280 let
281 val (x, _, dn) = E.lookupConstructor env n 281 val (x, _, dn) = E.lookupConstructor env n
282 val (dx, _) = E.lookupDatatype env dn 282 val (dx, _) = E.lookupDatatype env dn
283 in 283 in
284 ("__lwd_" ^ dx ^ "_" ^ Int.toString dn, 284 ("__lwd_" ^ dx ^ "_" ^ Int.toString dn,
285 "__lwc_" ^ x ^ "_" ^ Int.toString n) 285 "__lwc_" ^ x ^ "_" ^ Int.toString n,
286 "lw_" ^ x)
286 end 287 end
287 | PConFfi {mod = m, datatyp, con, ...} => 288 | PConFfi {mod = m, datatyp, con, ...} =>
288 ("lw_" ^ m ^ "_" ^ datatyp, 289 ("lw_" ^ m ^ "_" ^ datatyp,
289 "lw_" ^ m ^ "_" ^ con) 290 "lw_" ^ m ^ "_" ^ con,
291 "lw_" ^ con)
290 292
291 fun p_exp' par env (e, loc) = 293 fun p_exp' par env (e, loc) =
292 case e of 294 case e of
293 EPrim p => Prim.p_t p 295 EPrim p => Prim.p_t p
294 | ERel n => p_rel env n 296 | ERel n => p_rel env n
295 | ENamed n => p_enamed env n 297 | ENamed n => p_enamed env n
296 | ECon (Enum, pc, _) => p_patCon env pc 298 | ECon (Enum, pc, _) => p_patCon env pc
297 | ECon (Default, pc, eo) => 299 | ECon (Default, pc, eo) =>
298 let 300 let
299 val (xd, xc) = patConInfo env pc 301 val (xd, xc, xn) = patConInfo env pc
300 in 302 in
301 box [string "({", 303 box [string "({",
302 newline, 304 newline,
303 string "struct", 305 string "struct",
304 space, 306 space,
320 string ";", 322 string ";",
321 newline, 323 newline,
322 case eo of 324 case eo of
323 NONE => box [] 325 NONE => box []
324 | SOME e => box [string "tmp->data.", 326 | SOME e => box [string "tmp->data.",
325 string xd, 327 string xn,
326 space, 328 space,
327 string "=", 329 string "=",
328 space, 330 space,
329 p_exp env e, 331 p_exp env e,
330 string ";", 332 string ";",
491 end 493 end
492 494
493 fun p_decl env (dAll as (d, _) : decl) = 495 fun p_decl env (dAll as (d, _) : decl) =
494 case d of 496 case d of
495 DStruct (n, xts) => 497 DStruct (n, xts) =>
496 box [string "struct", 498 let
497 space, 499 val env = E.declBinds env dAll
498 string ("__lws_" ^ Int.toString n), 500 in
499 space, 501 box [string "struct",
500 string "{", 502 space,
501 newline, 503 string ("__lws_" ^ Int.toString n),
502 p_list_sep (box []) (fn (x, t) => box [p_typ env t, 504 space,
503 space, 505 string "{",
504 string "__lwf_", 506 newline,
505 string x, 507 p_list_sep (box []) (fn (x, t) => box [p_typ env t,
506 string ";", 508 space,
507 newline]) xts, 509 string "__lwf_",
508 string "};"] 510 string x,
511 string ";",
512 newline]) xts,
513 string "};"]
514 end
509 | DDatatype (Enum, x, n, xncs) => 515 | DDatatype (Enum, x, n, xncs) =>
510 box [string "enum", 516 box [string "enum",
511 space, 517 space,
512 string ("__lwe_" ^ x ^ "_" ^ Int.toString n), 518 string ("__lwe_" ^ x ^ "_" ^ Int.toString n),
513 space, 519 space,
550 space, 556 space,
551 string "{", 557 string "{",
552 newline, 558 newline,
553 p_list_sep newline (fn (x, n, t) => box [p_typ env t, 559 p_list_sep newline (fn (x, n, t) => box [p_typ env t,
554 space, 560 space,
555 string ("__lwc_" ^ x), 561 string ("lw_" ^ x),
556 string ";"]) xncsArgs, 562 string ";"]) xncsArgs,
557 newline, 563 newline,
558 string "}", 564 string "}",
559 space, 565 space,
560 string "data;", 566 string "data;",
561 newline]), 567 newline]),
562 string "};"] 568 string "};"]
563 end 569 end
570
571 | DDatatypeForward _ => box []
564 572
565 | DVal (x, n, t, e) => 573 | DVal (x, n, t, e) =>
566 box [p_typ env t, 574 box [p_typ env t,
567 space, 575 space,
568 string ("__lwn_" ^ x ^ "_" ^ Int.toString n), 576 string ("__lwn_" ^ x ^ "_" ^ Int.toString n),
1001 string ";", 1009 string ";",
1002 newline, 1010 newline,
1003 newline, 1011 newline,
1004 string "int lw_input_num(char *name) {", 1012 string "int lw_input_num(char *name) {",
1005 newline, 1013 newline,
1006 string "if",
1007 space,
1008 string "(name[0]",
1009 space,
1010 string "==",
1011 space,
1012 string "0)",
1013 space,
1014 string "return",
1015 space,
1016 string "-1;",
1017 newline,
1018 makeSwitch (fnums, 0), 1014 makeSwitch (fnums, 0),
1019 string "}", 1015 string "}",
1020 newline, 1016 newline,
1021 newline, 1017 newline,
1022 string "void lw_handle(lw_context ctx, char *request) {", 1018 string "void lw_handle(lw_context ctx, char *request) {",