Mercurial > urweb

comparison src/cjr_print.sml @ 638:3ee6bb48f6e8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
RPC returning an enumeration
author Adam Chlipala <adamc@hcoop.net>
date Sun, 08 Mar 2009 12:37:42 -0400
parents c5991cdb0c4b
children 9da62680adc5
comparison
equal deleted inserted replaced
637:24fd1edfcaa3 638:3ee6bb48f6e8
499 p_ensql t (box [string "*", e]), 499 p_ensql t (box [string "*", e]),
500 string ")"] 500 string ")"]
501 501
502 fun notLeaky env allowHeapAllocated = 502 fun notLeaky env allowHeapAllocated =
503 let 503 let
504 fun nl (t, _) = 504 fun nl ok (t, _) =
505 case t of 505 case t of
506 TFun _ => false 506 TFun _ => false
507 | TRecord n => 507 | TRecord n =>
508 let 508 let
509 val xts = E.lookupStruct env n 509 val xts = E.lookupStruct env n
510 in 510 in
511 List.all (fn (_, t) => nl t) xts 511 List.all (fn (_, t) => nl ok t) xts
512 end 512 end
513 | TDatatype (dk, _, ref cons) => 513 | TDatatype (dk, n, ref cons) =>
514 (allowHeapAllocated orelse dk = Enum) 514 IS.member (ok, n)
515 andalso List.all (fn (_, _, to) => case to of 515 orelse
516 NONE => true 516 ((allowHeapAllocated orelse dk = Enum)
517 | SOME t => nl t) cons 517 andalso
518 let
519 val ok' = IS.add (ok, n)
520 in
521 List.all (fn (_, _, to) => case to of
522 NONE => true
523 | SOME t => nl ok' t) cons
524 end)
518 | TFfi ("Basis", "string") => false 525 | TFfi ("Basis", "string") => false
519 | TFfi _ => true 526 | TFfi _ => true
520 | TOption t => allowHeapAllocated andalso nl t 527 | TOption t => allowHeapAllocated andalso nl ok t
521 in 528 in
522 nl 529 nl IS.empty
523 end 530 end
524 531
525 fun capitalize s = 532 fun capitalize s =
526 if s = "" then 533 if s = "" then
527 "" 534 ""
894 ([], false) xts 901 ([], false) xts
895 in 902 in
896 box (rev blocks) 903 box (rev blocks)
897 end 904 end
898 905
899 | TDatatype (Enum, i, _) => box [] 906 | TDatatype (Enum, i, _) =>
900 (*let 907 let
901 val (x, xncs) = E.lookupDatatype env i 908 val (x, xncs) = E.lookupDatatype env i
902 909
903 fun doEm xncs = 910 fun doEm xncs =
904 case xncs of 911 case xncs of
905 [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " 912 [] => box [string ("uw_error(ctx, FATAL, \"Error urlifying datatype "
906 ^ x ^ "\"), (enum __uwe_" 913 ^ x ^ "\");"),
907 ^ x ^ "_" ^ Int.toString i ^ ")0)") 914 newline]
908 | (x', n, to) :: rest => 915 | (x', n, to) :: rest =>
909 box [string "((!strncmp(request, \"", 916 box [string ("if (it" ^ Int.toString level
910 string x', 917 ^ "==__uwc_" ^ ident x' ^ "_" ^ Int.toString n ^ ") {"),
911 string "\", ", 918 newline,
912 string (Int.toString (size x')), 919 box [string ("uw_write(ctx, \"" ^ x' ^ "\");"),
913 string ") && (request[", 920 newline],
914 string (Int.toString (size x')), 921 string "} else {",
915 string "] == 0 || request[", 922 newline,
916 string (Int.toString (size x')), 923 box [doEm rest,
917 string ("] == '/')) ? __uwc_" ^ ident x' ^ "_" ^ Int.toString n), 924 newline],
918 space, 925 string "}"]
919 string ":",
920 space,
921 doEm rest,
922 string ")"]
923 in 926 in
924 doEm xncs 927 doEm xncs
925 end*) 928 end
926 929
927 | TDatatype (Option, i, xncs) => box [] 930 | TDatatype (Option, i, xncs) => box []
928 (*if IS.member (rf, i) then 931 (*if IS.member (rf, i) then
929 box [string "unurlify_", 932 box [string "unurlify_",
930 string (Int.toString i), 933 string (Int.toString i),
1451 let 1454 let
1452 val exps = map (fn (x, t) => ("__uwf_" ^ ident x, t)) exps 1455 val exps = map (fn (x, t) => ("__uwf_" ^ ident x, t)) exps
1453 val tables = ListUtil.mapConcat (fn (x, xts) => 1456 val tables = ListUtil.mapConcat (fn (x, xts) =>
1454 map (fn (x', t) => ("__uwf_" ^ ident x ^ ".__uwf_" ^ ident x', t)) xts) 1457 map (fn (x', t) => ("__uwf_" ^ ident x ^ ".__uwf_" ^ ident x', t)) xts)
1455 tables 1458 tables
1456 1459
1457 val outputs = exps @ tables 1460 val outputs = exps @ tables
1458 val outputs = ListMergeSort.sort (fn ((s1, _), (s2, _)) => String.compare (s1, s2) = GREATER) outputs 1461 val outputs = ListMergeSort.sort (fn ((s1, _), (s2, _)) => String.compare (s1, s2) = GREATER) outputs
1459 1462
1460 val wontLeakStrings = notLeaky env true state 1463 val wontLeakStrings = notLeaky env true state
1461 val wontLeakAnything = notLeaky env false state 1464 val wontLeakAnything = notLeaky env false state
1835 p_rel env' (nargs - i - 1)]) args), 1838 p_rel env' (nargs - i - 1)]) args),
1836 string ")", 1839 string ")",
1837 space, 1840 space,
1838 string "{", 1841 string "{",
1839 newline, 1842 newline,
1840 box[string "return(", 1843 box [string "return(",
1841 p_exp env' e, 1844 p_exp env' e,
1842 string ");"], 1845 string ");"],
1843 newline, 1846 newline,
1844 string "}"] 1847 string "}"]
1845 end 1848 end
1846 1849
1847 fun p_decl env (dAll as (d, _) : decl) = 1850 fun p_decl env (dAll as (d, _) : decl) =
2162 | _ => true 2165 | _ => true
2163 2166
2164 fun p_file env (ds, ps) = 2167 fun p_file env (ds, ps) =
2165 let 2168 let
2166 val (pds, env) = ListUtil.foldlMap (fn (d, env) => 2169 val (pds, env) = ListUtil.foldlMap (fn (d, env) =>
2167 (p_decl env d, 2170 (p_decl env d,
2168 E.declBinds env d)) 2171 E.declBinds env d))
2169 env ds 2172 env ds
2170 2173
2171 val fields = foldl (fn ((ek, _, _, ts, _), fields) => 2174 val fields = foldl (fn ((ek, _, _, ts, _), fields) =>
2172 case ek of 2175 case ek of
2173 Core.Link => fields 2176 Core.Link => fields