diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-07-29 15:25:42 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-07-29 15:25:42 -0400 |
| commit | cb3b3831a07d6674a5fa02e3e8a1e4329b58cb34 (patch) | |
| tree | 7b6064344549091735d28d42ac9fb19073e9760a /src/cjr_print.sml | |
| parent | 6855e4766fa8d07e2f3e3cd468de6c58fed0c903 (diff) | |
Unurlifying a datatype; longjmp-based error signaling mechanism
Diffstat (limited to 'src/cjr_print.sml')
| -rw-r--r-- | src/cjr_print.sml | 38 |
1 files changed, 26 insertions, 12 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 1aab8f02..ab102800 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -211,7 +211,7 @@ fun p_decl env (dAll as (d, _) : decl) = newline, string "struct", space, - string ("_lwd_" ^ x ^ "_" ^ Int.toString n), + string ("__lwd_" ^ x ^ "_" ^ Int.toString n), space, string "{", newline, @@ -451,34 +451,48 @@ fun p_file env (ds, ps) = fun doEm xncs = case xncs of - [] => string "Uh oh" - | (x, n, to) :: rest => - box [string "(!strcmp(request, \"", - string x, - string "\") ? ({", + [] => string ("(lw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x ^ "\"), NULL)") + | (x', n, to) :: rest => + box [string "((!strncmp(request, \"", + string x', + string "\", ", + string (Int.toString (size x')), + string ") && (request[", + string (Int.toString (size x')), + string "] == 0 || request[", + string (Int.toString (size x')), + string "] == '/')) ? ({", newline, + string "struct", + space, string ("__lwd_" ^ x ^ "_" ^ Int.toString i), space, - string "__lw_tmp;", + string "*__lw_tmp = lw_malloc(ctx, sizeof(struct __lwd_", + string x, + string "_", + string (Int.toString i), + string "));", newline, - string "__lw_tmp.tag", + string "__lw_tmp->tag", space, string "=", space, - string ("__lwc_" ^ x ^ "_" ^ Int.toString n), + string ("__lwc_" ^ x' ^ "_" ^ Int.toString n), string ";", newline, string "request", space, string "+=", space, - string (Int.toString (size x)), + string (Int.toString (size x')), string ";", newline, + string "if (request[0] == '/') ++request;", + newline, case to of NONE => box [] - | SOME t => box [string "__lw_tmp.data.", - string x, + | SOME t => box [string "__lw_tmp->data.", + string x', space, string "=", space, |