Mercurial > urweb

comparison src/cjr_print.sml @ 1545:5f530f8e3511

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix crash in list unurlification
author Adam Chlipala <adam@chlipala.net>
date Sun, 21 Aug 2011 10:39:19 -0400
parents dc4c61363d0a
children 133c71008bef
comparison
equal deleted inserted replaced
1544:a99b743a3087 1545:5f530f8e3511
539 539
540 val unurlifies = ref IS.empty 540 val unurlifies = ref IS.empty
541 541
542 fun unurlify fromClient env (t, loc) = 542 fun unurlify fromClient env (t, loc) =
543 let 543 let
544 fun deStar request =
545 case request of
546 "(*request)" => "request"
547 | _ => "&" ^ request
548
544 fun unurlify' request t = 549 fun unurlify' request t =
545 case t of 550 case t of
546 TFfi ("Basis", "unit") => string ("uw_Basis_unurlifyUnit(ctx, &" ^ request ^ ")") 551 TFfi ("Basis", "unit") => string ("uw_Basis_unurlifyUnit(ctx, " ^ deStar request ^ ")")
547 | TFfi ("Basis", "string") => string (if fromClient then 552 | TFfi ("Basis", "string") => string (if fromClient then
548 "uw_Basis_unurlifyString_fromClient(ctx, &" ^ request ^ ")" 553 "uw_Basis_unurlifyString_fromClient(ctx, " ^ deStar request ^ ")"
549 else 554 else
550 "uw_Basis_unurlifyString(ctx, &" ^ request ^ ")") 555 "uw_Basis_unurlifyString(ctx, " ^ deStar request ^ ")")
551 | TFfi (m, t) => string ("uw_" ^ ident m ^ "_unurlify" ^ capitalize t ^ "(ctx, &" ^ request ^ ")") 556 | TFfi (m, t) => string ("uw_" ^ ident m ^ "_unurlify" ^ capitalize t ^ "(ctx, " ^ deStar request ^ ")")
552 557
553 | TRecord 0 => string ("uw_Basis_unurlifyUnit(ctx, &" ^ request ^ ")") 558 | TRecord 0 => string ("uw_Basis_unurlifyUnit(ctx, " ^ deStar request ^ ")")
554 | TRecord i => 559 | TRecord i =>
555 let 560 let
556 val xts = E.lookupStruct env i 561 val xts = E.lookupStruct env i
557 in 562 in
558 box [string "({", 563 box [string "({",
621 626
622 | TDatatype (Option, i, xncs) => 627 | TDatatype (Option, i, xncs) =>
623 if IS.member (!unurlifies, i) then 628 if IS.member (!unurlifies, i) then
624 box [string "unurlify_", 629 box [string "unurlify_",
625 string (Int.toString i), 630 string (Int.toString i),
626 string ("(ctx, &" ^ request ^ ")")] 631 string ("(ctx, " ^ deStar request ^ ")")]
627 else 632 else
628 let 633 let
629 val (x, _) = E.lookupDatatype env i 634 val (x, _) = E.lookupDatatype env i
630 635
631 val (no_arg, has_arg, t) = 636 val (no_arg, has_arg, t) =
719 724
720 | TDatatype (Default, i, _) => 725 | TDatatype (Default, i, _) =>
721 if IS.member (!unurlifies, i) then 726 if IS.member (!unurlifies, i) then
722 box [string "unurlify_", 727 box [string "unurlify_",
723 string (Int.toString i), 728 string (Int.toString i),
724 string ("(ctx, &" ^ request ^ ")")] 729 string ("(ctx, " ^ deStar request ^ ")")]
725 else 730 else
726 let 731 let
727 val (x, xncs) = E.lookupDatatype env i 732 val (x, xncs) = E.lookupDatatype env i
728 733
729 val () = unurlifies := IS.add (!unurlifies, i) 734 val () = unurlifies := IS.add (!unurlifies, i)
805 newline, 810 newline,
806 newline]); 811 newline]);
807 812
808 box [string "unurlify_", 813 box [string "unurlify_",
809 string (Int.toString i), 814 string (Int.toString i),
810 string ("(ctx, &" ^ request ^ ")")] 815 string ("(ctx, " ^ deStar request ^ ")")]
811 end 816 end
812 817
813 | TList (t', i) => 818 | TList (t', i) =>
814 if IS.member (!unurlifies, i) then 819 if IS.member (!unurlifies, i) then
815 box [string "unurlify_list_", 820 box [string "unurlify_list_",
816 string (Int.toString i), 821 string (Int.toString i),
817 string ("(ctx, &" ^ request ^ ")")] 822 string ("(ctx, " ^ deStar request ^ ")")]
818 else 823 else
819 (unurlifies := IS.add (!unurlifies, i); 824 (unurlifies := IS.add (!unurlifies, i);
820 addUrlHandler (box [string "static", 825 addUrlHandler (box [string "static",
821 space, 826 space,
822 p_typ env (t, loc), 827 p_typ env (t, loc),
830 string "((!strncmp(*request, \"Nil\", 3) && ((*request)[3] == 0 ", 835 string "((!strncmp(*request, \"Nil\", 3) && ((*request)[3] == 0 ",
831 string "|| (*request)[3] == '/')) ? (*request", 836 string "|| (*request)[3] == '/')) ? (*request",
832 space, 837 space,
833 string "+=", 838 string "+=",
834 space, 839 space,
835 string "3, ((*request)[0] == '/' ? *request++ = 0 : 0), NULL) : ((!strncmp(*request, \"Cons\", 4) && ((*request)[4] == 0 ", 840 string "3, ((*request)[0] == '/' ? ((*request)[0] = 0, (*request)++) : NULL)) : ((!strncmp(*request, \"Cons\", 4) && ((*request)[4] == 0 ",
836 string "|| (*request)[4] == '/')) ? (*request", 841 string "|| (*request)[4] == '/')) ? (*request",
837 space, 842 space,
838 string "+=", 843 string "+=",
839 space, 844 space,
840 string "4, ((*request)[0] == '/' ? ++*request : NULL), ", 845 string "4, ((*request)[0] == '/' ? ++*request : NULL), ",
872 newline, 877 newline,
873 newline]); 878 newline]);
874 879
875 box [string "unurlify_list_", 880 box [string "unurlify_list_",
876 string (Int.toString i), 881 string (Int.toString i),
877 string ("(ctx, &" ^ request ^ ")")]) 882 string ("(ctx, " ^ deStar request ^ ")")])
878 883
879 | TOption t => 884 | TOption t =>
880 box [string ("(" ^ request ^ "[0] == '/' ? ++" ^ request ^ " : " ^ request ^ ", "), 885 box [string ("(" ^ request ^ "[0] == '/' ? ++" ^ request ^ " : " ^ request ^ ", "),
881 string ("((!strncmp(" ^ request ^ ", \"None\", 4) "), 886 string ("((!strncmp(" ^ request ^ ", \"None\", 4) "),
882 string ("&& (" ^ request ^ "[4] == 0 || " ^ request ^ "[4] == '/')) "), 887 string ("&& (" ^ request ^ "[4] == 0 || " ^ request ^ "[4] == '/')) "),