Mercurial > urweb
comparison src/cjr_print.sml @ 167:2be573fec9a6
Unurlifying a datatype; longjmp-based error signaling mechanism
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 29 Jul 2008 15:25:42 -0400 |
parents | a991431b77eb |
children | 25b169416ea8 |
comparison
equal
deleted
inserted
replaced
166:a991431b77eb | 167:2be573fec9a6 |
---|---|
209 string "};", | 209 string "};", |
210 newline, | 210 newline, |
211 newline, | 211 newline, |
212 string "struct", | 212 string "struct", |
213 space, | 213 space, |
214 string ("_lwd_" ^ x ^ "_" ^ Int.toString n), | 214 string ("__lwd_" ^ x ^ "_" ^ Int.toString n), |
215 space, | 215 space, |
216 string "{", | 216 string "{", |
217 newline, | 217 newline, |
218 string "enum", | 218 string "enum", |
219 space, | 219 space, |
449 let | 449 let |
450 val (x, xncs) = E.lookupDatatype env i | 450 val (x, xncs) = E.lookupDatatype env i |
451 | 451 |
452 fun doEm xncs = | 452 fun doEm xncs = |
453 case xncs of | 453 case xncs of |
454 [] => string "Uh oh" | 454 [] => string ("(lw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x ^ "\"), NULL)") |
455 | (x, n, to) :: rest => | 455 | (x', n, to) :: rest => |
456 box [string "(!strcmp(request, \"", | 456 box [string "((!strncmp(request, \"", |
457 string x', | |
458 string "\", ", | |
459 string (Int.toString (size x')), | |
460 string ") && (request[", | |
461 string (Int.toString (size x')), | |
462 string "] == 0 || request[", | |
463 string (Int.toString (size x')), | |
464 string "] == '/')) ? ({", | |
465 newline, | |
466 string "struct", | |
467 space, | |
468 string ("__lwd_" ^ x ^ "_" ^ Int.toString i), | |
469 space, | |
470 string "*__lw_tmp = lw_malloc(ctx, sizeof(struct __lwd_", | |
457 string x, | 471 string x, |
458 string "\") ? ({", | 472 string "_", |
473 string (Int.toString i), | |
474 string "));", | |
459 newline, | 475 newline, |
460 string ("__lwd_" ^ x ^ "_" ^ Int.toString i), | 476 string "__lw_tmp->tag", |
461 space, | |
462 string "__lw_tmp;", | |
463 newline, | |
464 string "__lw_tmp.tag", | |
465 space, | 477 space, |
466 string "=", | 478 string "=", |
467 space, | 479 space, |
468 string ("__lwc_" ^ x ^ "_" ^ Int.toString n), | 480 string ("__lwc_" ^ x' ^ "_" ^ Int.toString n), |
469 string ";", | 481 string ";", |
470 newline, | 482 newline, |
471 string "request", | 483 string "request", |
472 space, | 484 space, |
473 string "+=", | 485 string "+=", |
474 space, | 486 space, |
475 string (Int.toString (size x)), | 487 string (Int.toString (size x')), |
476 string ";", | 488 string ";", |
489 newline, | |
490 string "if (request[0] == '/') ++request;", | |
477 newline, | 491 newline, |
478 case to of | 492 case to of |
479 NONE => box [] | 493 NONE => box [] |
480 | SOME t => box [string "__lw_tmp.data.", | 494 | SOME t => box [string "__lw_tmp->data.", |
481 string x, | 495 string x', |
482 space, | 496 space, |
483 string "=", | 497 string "=", |
484 space, | 498 space, |
485 unurlify t, | 499 unurlify t, |
486 string ";", | 500 string ";", |