comparison src/cjr_print.sml @ 639:9da62680adc5

RPC returning an option datatype
author Adam Chlipala <adamc@hcoop.net>
date Sun, 08 Mar 2009 12:54:07 -0400
parents 3ee6bb48f6e8
children 63b0bcacd535
comparison
equal deleted inserted replaced
638:3ee6bb48f6e8 639:9da62680adc5
925 string "}"] 925 string "}"]
926 in 926 in
927 doEm xncs 927 doEm xncs
928 end 928 end
929 929
930 | TDatatype (Option, i, xncs) => box [] 930 | TDatatype (Option, i, xncs) =>
931 (*if IS.member (rf, i) then 931 if IS.member (rf, i) then
932 box [string "unurlify_", 932 box [string "urlify_",
933 string (Int.toString i), 933 string (Int.toString i),
934 string "()"] 934 string "(it",
935 string (Int.toString level),
936 string ");",
937 newline]
935 else 938 else
936 let 939 let
937 val (x, _) = E.lookupDatatype env i 940 val (x, _) = E.lookupDatatype env i
938 941
939 val (no_arg, has_arg, t) = 942 val (no_arg, has_arg, t) =
940 case !xncs of 943 case !xncs of
941 [(no_arg, _, NONE), (has_arg, _, SOME t)] => 944 [(no_arg, _, NONE), (has_arg, _, SOME t)] =>
942 (no_arg, has_arg, t) 945 (no_arg, has_arg, t)
943 | [(has_arg, _, SOME t), (no_arg, _, NONE)] => 946 | [(has_arg, _, SOME t), (no_arg, _, NONE)] =>
944 (no_arg, has_arg, t) 947 (no_arg, has_arg, t)
945 | _ => raise Fail "CjrPrint: unfooify misclassified Option datatype" 948 | _ => raise Fail "CjrPrint: urlify misclassified Option datatype"
946 949
947 val rf = IS.add (rf, i) 950 val rf = IS.add (rf, i)
948 in 951 in
949 box [string "({", 952 box [string "({",
950 space, 953 space,
954 string "void",
955 space,
956 string "urlify_",
957 string (Int.toString i),
958 string "(",
951 p_typ env t, 959 p_typ env t,
952 space, 960 space,
953 string "*unurlify_", 961 if isUnboxable t then
954 string (Int.toString i), 962 box []
955 string "(void) {", 963 else
964 string "*",
965 string "it0) {",
956 newline, 966 newline,
957 box [string "return (request[0] == '/' ? ++request : request,", 967 box [string "if (it0) {",
958 newline, 968 if isUnboxable t then
959 string "((!strncmp(request, \"", 969 urlify' rf 0 t
960 string no_arg,
961 string "\", ",
962 string (Int.toString (size no_arg)),
963 string ") && (request[",
964 string (Int.toString (size no_arg)),
965 string "] == 0 || request[",
966 string (Int.toString (size no_arg)),
967 string "] == '/')) ? (request",
968 space,
969 string "+=",
970 space,
971 string (Int.toString (size no_arg)),
972 string ", NULL) : ((!strncmp(request, \"",
973 string has_arg,
974 string "\", ",
975 string (Int.toString (size has_arg)),
976 string ") && (request[",
977 string (Int.toString (size has_arg)),
978 string "] == 0 || request[",
979 string (Int.toString (size has_arg)),
980 string "] == '/')) ? (request",
981 space,
982 string "+=",
983 space,
984 string (Int.toString (size has_arg)),
985 string ", (request[0] == '/' ? ++request : NULL), ",
986 newline,
987
988 if isUnboxable t then
989 unurlify' rf (#1 t)
990 else 970 else
991 box [string "({", 971 box [p_typ env t,
992 newline,
993 p_typ env t,
994 space, 972 space,
995 string "*tmp", 973 string "it1",
996 space, 974 space,
997 string "=", 975 string "=",
998 space, 976 space,
999 string "uw_malloc(ctx, sizeof(", 977 string "*it0;",
1000 p_typ env t,
1001 string "));",
1002 newline, 978 newline,
1003 string "*tmp", 979 string "uw_write(ctx, \"",
1004 space, 980 string has_arg,
1005 string "=", 981 string "/\");",
1006 space, 982 newline,
1007 unurlify' rf (#1 t), 983 urlify' rf 1 t,
1008 string ";", 984 string ";",
1009 newline, 985 newline],
1010 string "tmp;", 986 string "} else {",
1011 newline, 987 box [string "uw_write(ctx, \"",
1012 string "})"], 988 string no_arg,
1013 string ")", 989 string "\");",
1014 newline, 990 newline],
1015 string ":", 991 string "}",
1016 space,
1017 string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x
1018 ^ "\"), NULL))));"),
1019 newline], 992 newline],
1020 string "}", 993 string "}",
1021 newline, 994 newline,
1022 newline, 995 newline,
1023 996
1024 string "unurlify_", 997 string "urlify_",
1025 string (Int.toString i), 998 string (Int.toString i),
1026 string "();", 999 string "(it",
1000 string (Int.toString level),
1001 string ");",
1027 newline, 1002 newline,
1028 string "})"] 1003 string "});",
1029 end*) 1004 newline]
1005 end
1030 1006
1031 | TDatatype (Default, i, _) => box [] 1007 | TDatatype (Default, i, _) => box []
1032 (*if IS.member (rf, i) then 1008 (*if IS.member (rf, i) then
1033 box [string "unurlify_", 1009 box [string "unurlify_",
1034 string (Int.toString i), 1010 string (Int.toString i),