Mercurial > urweb

comparison src/cjr_print.sml @ 181:31dfab1d4050

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Cjrize ECon
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 11:17:33 -0400
parents 25b169416ea8
children d11754ffe252
comparison
equal deleted inserted replaced
180:c7a5c8e0a0e0 181:31dfab1d4050
88 fun p_exp' par env (e, _) = 88 fun p_exp' par env (e, _) =
89 case e of 89 case e of
90 EPrim p => Prim.p_t p 90 EPrim p => Prim.p_t p
91 | ERel n => p_rel env n 91 | ERel n => p_rel env n
92 | ENamed n => p_enamed env n 92 | ENamed n => p_enamed env n
93 | ECon (n, eo) =>
94 let
95 val (x, _, dn) = E.lookupConstructor env n
96 val (dx, _) = E.lookupDatatype env dn
97 in
98 box [string "{(",
99 newline,
100 string "struct",
101 space,
102 string "__lwd_",
103 string dx,
104 string "_",
105 string (Int.toString dn),
106 space,
107 string "*tmp",
108 space,
109 string "=",
110 space,
111 string "lw_malloc(ctx, sizeof(struct __lwd_",
112 string dx,
113 string "_",
114 string (Int.toString dn),
115 string "));",
116 newline,
117 string "tmp->tag",
118 space,
119 string "=",
120 space,
121 string ("__lwc_" ^ x ^ "_" ^ Int.toString n),
122 string ";",
123 newline,
124 case eo of
125 NONE => box []
126 | SOME e => box [string "tmp->data.",
127 string x,
128 space,
129 string "=",
130 space,
131 p_exp env e,
132 string ";",
133 newline],
134 string "tmp;",
135 newline,
136 string "})"]
137 end
93 138
94 | EFfi (m, x) => box [string "lw_", string m, string "_", string x] 139 | EFfi (m, x) => box [string "lw_", string m, string "_", string x]
95 | EFfiApp (m, x, es) => box [string "lw_", 140 | EFfiApp (m, x, es) => box [string "lw_",
96 string m, 141 string m,
97 string "_", 142 string "_",
119 space, 164 space,
120 string "struct", 165 string "struct",
121 space, 166 space,
122 string ("__lws_" ^ Int.toString i), 167 string ("__lws_" ^ Int.toString i),
123 space, 168 space,
124 string "__lw_tmp", 169 string "tmp",
125 space, 170 space,
126 string "=", 171 string "=",
127 space, 172 space,
128 string "{", 173 string "{",
129 p_list (fn (_, e) => 174 p_list (fn (_, e) =>
130 p_exp env e) xes, 175 p_exp env e) xes,
131 string "};", 176 string "};",
132 space, 177 space,
133 string "__lw_tmp;", 178 string "tmp;",
134 space, 179 space,
135 string "})" ] 180 string "})" ]
136 | EField (e, x) => 181 | EField (e, x) =>
137 box [p_exp' true env e, 182 box [p_exp' true env e,
138 string ".", 183 string ".",
139 string x] 184 string x]
185
186 | ECase _ => raise Fail "CjrPrint ECase"
140 187
141 | EWrite e => box [string "(lw_write(ctx, ", 188 | EWrite e => box [string "(lw_write(ctx, ",
142 p_exp env e, 189 p_exp env e,
143 string "), lw_unit_v)"] 190 string "), lw_unit_v)"]
144 191
428 string "struct", 475 string "struct",
429 space, 476 space,
430 string "__lws_", 477 string "__lws_",
431 string (Int.toString i), 478 string (Int.toString i),
432 space, 479 space,
433 string "__lw_tmp", 480 string "tmp",
434 space, 481 space,
435 string "=", 482 string "=",
436 space, 483 space,
437 string "{", 484 string "{",
438 space, 485 space,
439 p_list_sep (box [string ",", space]) (fn (x, _) => string x) xts, 486 p_list_sep (box [string ",", space]) (fn (x, _) => string x) xts,
440 space, 487 space,
441 string "};", 488 string "};",
442 newline, 489 newline,
443 string "__lw_tmp;", 490 string "tmp;",
444 newline, 491 newline,
445 string "})"] 492 string "})"]
446 end 493 end
447 494
448 | TDatatype (i, _) => 495 | TDatatype (i, _) =>
465 newline, 512 newline,
466 string "struct", 513 string "struct",
467 space, 514 space,
468 string ("__lwd_" ^ x ^ "_" ^ Int.toString i), 515 string ("__lwd_" ^ x ^ "_" ^ Int.toString i),
469 space, 516 space,
470 string "*__lw_tmp = lw_malloc(ctx, sizeof(struct __lwd_", 517 string "*tmp = lw_malloc(ctx, sizeof(struct __lwd_",
471 string x, 518 string x,
472 string "_", 519 string "_",
473 string (Int.toString i), 520 string (Int.toString i),
474 string "));", 521 string "));",
475 newline, 522 newline,
476 string "__lw_tmp->tag", 523 string "tmp->tag",
477 space, 524 space,
478 string "=", 525 string "=",
479 space, 526 space,
480 string ("__lwc_" ^ x' ^ "_" ^ Int.toString n), 527 string ("__lwc_" ^ x' ^ "_" ^ Int.toString n),
481 string ";", 528 string ";",
489 newline, 536 newline,
490 string "if (request[0] == '/') ++request;", 537 string "if (request[0] == '/') ++request;",
491 newline, 538 newline,
492 case to of 539 case to of
493 NONE => box [] 540 NONE => box []
494 | SOME t => box [string "__lw_tmp->data.", 541 | SOME t => box [string "tmp->data.",
495 string x', 542 string x',
496 space, 543 space,
497 string "=", 544 string "=",
498 space, 545 space,
499 unurlify t, 546 unurlify t,
500 string ";", 547 string ";",
501 newline], 548 newline],
502 string "__lw_tmp;", 549 string "tmp;",
503 newline, 550 newline,
504 string "})", 551 string "})",
505 space, 552 space,
506 string ":", 553 string ":",
507 space, 554 space,