Mercurial > urweb
diff src/cjr_print.sml @ 759:67cd8326f743
subforms working
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 30 Apr 2009 13:47:46 -0400 |
parents | 8323c1beef2e |
children | 7f653298dd66 |
line wrap: on
line diff
--- a/src/cjr_print.sml Thu Apr 30 11:48:56 2009 -0400 +++ b/src/cjr_print.sml Thu Apr 30 13:47:46 2009 -0400 @@ -2425,6 +2425,14 @@ in SOME (map #1 xts :: List.concat (List.mapPartial (flatFields o #2) xts)) end + | TList (_, i) => + let + val ts = E.lookupStruct env i + in + case ts of + [("1", t'), ("2", _)] => flatFields t' + | _ => raise Fail "CjrPrint: Bad struct for TList" + end | _ => NONE val fields = foldl (fn ((ek, _, _, ts, _, _), fields) => @@ -2566,7 +2574,7 @@ fun getInput (x, t) = let val n = case SM.find (fnums, x) of - NONE => raise Fail "CjrPrint: Can't find in fnums" + NONE => raise Fail ("CjrPrint: Can't find " ^ x ^ " in fnums") | SOME n => n val f = case t of @@ -2631,6 +2639,76 @@ newline, string "uw_leave_subform(ctx);"] end + | TList (t', i) => + let + val xts = E.lookupStruct env i + val i' = case xts of + [("1", (TRecord i', loc)), ("2", _)] => i' + | _ => raise Fail "CjrPrint: Bad TList record [2]" + val xts = E.lookupStruct env i' + in + box [string "{", + newline, + string "int status;", + newline, + string "uw_input_", + p_ident x, + space, + string "=", + space, + string "NULL;", + newline, + string "for (status = uw_enter_subforms(ctx, ", + string (Int.toString n), + string "); status; status = uw_next_entry(ctx)) {", + newline, + box [p_typ env t, + space, + string "result", + space, + string "=", + space, + string "uw_malloc(ctx, sizeof(struct __uws_", + string (Int.toString i), + string "));", + newline, + box [string "{", + p_list_sep (box []) + (fn (x, t) => + box [p_typ env t, + space, + string "uw_input_", + string x, + string ";", + newline]) + xts, + newline, + p_list_sep (box []) (fn (x, t) => + box [getInput (x, t), + string "result->__uwf_1.__uwf_", + string x, + space, + string "=", + space, + string "uw_input_", + string x, + string ";", + newline]) + xts, + string "}", + newline], + newline, + string "result->__uwf_2 = uw_input_", + p_ident x, + string ";", + newline, + string "uw_input_", + p_ident x, + string " = result;", + newline], + string "}}", + newline] + end | _ => box [string "request = uw_get_", string f,