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 ";",