Mercurial > urweb

comparison src/cjr_print.sml @ 759:67cd8326f743

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
subforms working
author Adam Chlipala <adamc@hcoop.net>
date Thu, 30 Apr 2009 13:47:46 -0400
parents 8323c1beef2e
children 7f653298dd66
comparison
equal deleted inserted replaced
758:8323c1beef2e 759:67cd8326f743
2423 let 2423 let
2424 val xts = E.lookupStruct env i 2424 val xts = E.lookupStruct env i
2425 in 2425 in
2426 SOME (map #1 xts :: List.concat (List.mapPartial (flatFields o #2) xts)) 2426 SOME (map #1 xts :: List.concat (List.mapPartial (flatFields o #2) xts))
2427 end 2427 end
2428 | TList (_, i) =>
2429 let
2430 val ts = E.lookupStruct env i
2431 in
2432 case ts of
2433 [("1", t'), ("2", _)] => flatFields t'
2434 | _ => raise Fail "CjrPrint: Bad struct for TList"
2435 end
2428 | _ => NONE 2436 | _ => NONE
2429 2437
2430 val fields = foldl (fn ((ek, _, _, ts, _, _), fields) => 2438 val fields = foldl (fn ((ek, _, _, ts, _, _), fields) =>
2431 case ek of 2439 case ek of
2432 Link => fields 2440 Link => fields
2564 end 2572 end
2565 2573
2566 fun getInput (x, t) = 2574 fun getInput (x, t) =
2567 let 2575 let
2568 val n = case SM.find (fnums, x) of 2576 val n = case SM.find (fnums, x) of
2569 NONE => raise Fail "CjrPrint: Can't find in fnums" 2577 NONE => raise Fail ("CjrPrint: Can't find " ^ x ^ " in fnums")
2570 | SOME n => n 2578 | SOME n => n
2571 2579
2572 val f = case t of 2580 val f = case t of
2573 (TFfi ("Basis", "bool"), _) => "optional_" 2581 (TFfi ("Basis", "bool"), _) => "optional_"
2574 | _ => "" 2582 | _ => ""
2628 string "result;", 2636 string "result;",
2629 newline], 2637 newline],
2630 string "});", 2638 string "});",
2631 newline, 2639 newline,
2632 string "uw_leave_subform(ctx);"] 2640 string "uw_leave_subform(ctx);"]
2641 end
2642 | TList (t', i) =>
2643 let
2644 val xts = E.lookupStruct env i
2645 val i' = case xts of
2646 [("1", (TRecord i', loc)), ("2", _)] => i'
2647 | _ => raise Fail "CjrPrint: Bad TList record [2]"
2648 val xts = E.lookupStruct env i'
2649 in
2650 box [string "{",
2651 newline,
2652 string "int status;",
2653 newline,
2654 string "uw_input_",
2655 p_ident x,
2656 space,
2657 string "=",
2658 space,
2659 string "NULL;",
2660 newline,
2661 string "for (status = uw_enter_subforms(ctx, ",
2662 string (Int.toString n),
2663 string "); status; status = uw_next_entry(ctx)) {",
2664 newline,
2665 box [p_typ env t,
2666 space,
2667 string "result",
2668 space,
2669 string "=",
2670 space,
2671 string "uw_malloc(ctx, sizeof(struct __uws_",
2672 string (Int.toString i),
2673 string "));",
2674 newline,
2675 box [string "{",
2676 p_list_sep (box [])
2677 (fn (x, t) =>
2678 box [p_typ env t,
2679 space,
2680 string "uw_input_",
2681 string x,
2682 string ";",
2683 newline])
2684 xts,
2685 newline,
2686 p_list_sep (box []) (fn (x, t) =>
2687 box [getInput (x, t),
2688 string "result->__uwf_1.__uwf_",
2689 string x,
2690 space,
2691 string "=",
2692 space,
2693 string "uw_input_",
2694 string x,
2695 string ";",
2696 newline])
2697 xts,
2698 string "}",
2699 newline],
2700 newline,
2701 string "result->__uwf_2 = uw_input_",
2702 p_ident x,
2703 string ";",
2704 newline,
2705 string "uw_input_",
2706 p_ident x,
2707 string " = result;",
2708 newline],
2709 string "}}",
2710 newline]
2633 end 2711 end
2634 | _ => 2712 | _ =>
2635 box [string "request = uw_get_", 2713 box [string "request = uw_get_",
2636 string f, 2714 string f,
2637 string "input(ctx, ", 2715 string "input(ctx, ",