Mercurial > urweb

comparison src/jscomp.sml @ 794:dc3fc3f3b834

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Improving/reordering Unpoly and Especialize; pathmaps
author Adam Chlipala <adamc@hcoop.net>
date Thu, 14 May 2009 08:13:54 -0400
parents a28982de5645
children 83875a9eb9b8
comparison
equal deleted inserted replaced
793:3e5d1c6ae30c 794:dc3fc3f3b834
397 fun padWith (ch, s, len) = 397 fun padWith (ch, s, len) =
398 if size s < len then 398 if size s < len then
399 padWith (ch, String.str ch ^ s, len - 1) 399 padWith (ch, String.str ch ^ s, len - 1)
400 else 400 else
401 s 401 s
402
403 val foundJavaScript = ref false
402 404
403 fun jsExp mode skip outer = 405 fun jsExp mode skip outer =
404 let 406 let
405 val len = length outer 407 val len = length outer
406 408
660 end 662 end
661 | EFfiApp (m, x, args) => 663 | EFfiApp (m, x, args) =>
662 let 664 let
663 val args = 665 val args =
664 case (m, x, args) of 666 case (m, x, args) of
665 ("Basis", "new_client_source", [(EJavaScript (_, e, _), _)]) => [e] 667 ("Basis", "new_client_source", [(EJavaScript (_, e, _), _)]) =>
666 | ("Basis", "set_client_source", [e1, (EJavaScript (_, e2, _), _)]) => [e1, e2] 668 (foundJavaScript := true; [e])
669 | ("Basis", "set_client_source", [e1, (EJavaScript (_, e2, _), _)]) =>
670 (foundJavaScript := true; [e1, e2])
667 | _ => args 671 | _ => args
668 672
669 val name = case Settings.jsFunc (m, x) of 673 val name = case Settings.jsFunc (m, x) of
670 NONE => (EM.errorAt loc ("Unsupported FFI function " 674 NONE => (EM.errorAt loc ("Unsupported FFI function "
671 ^ x ^ " in JavaScript"); 675 ^ x ^ " in JavaScript");
869 str ",", 873 str ",",
870 e2, 874 e2,
871 str ")"], st) 875 str ")"], st)
872 end 876 end
873 877
874 | EJavaScript (Source _, _, SOME _) => (e, st) 878 | EJavaScript (Source _, _, SOME _) =>
879 (foundJavaScript := true;
880 (e, st))
875 | EJavaScript (_, _, SOME e) => 881 | EJavaScript (_, _, SOME e) =>
876 (strcat [str "cs(function(){return ", 882 (foundJavaScript := true;
877 e, 883 (strcat [str "cs(function(){return ",
878 str "})"], 884 e,
879 st) 885 str "})"],
886 st))
880 887
881 | EClosure _ => unsupported "EClosure" 888 | EClosure _ => unsupported "EClosure"
882 | EQuery _ => unsupported "Query" 889 | EQuery _ => unsupported "Query"
883 | EDml _ => unsupported "DML" 890 | EDml _ => unsupported "DML"
884 | ENextval _ => unsupported "Nextval" 891 | ENextval _ => unsupported "Nextval"
886 | EReturnBlob _ => unsupported "EUnurlify" 893 | EReturnBlob _ => unsupported "EUnurlify"
887 | EJavaScript (_, e, _) => 894 | EJavaScript (_, e, _) =>
888 let 895 let
889 val (e, st) = jsE inner (e, st) 896 val (e, st) = jsE inner (e, st)
890 in 897 in
898 foundJavaScript := true;
891 (strcat [str "cs(function(){return ", 899 (strcat [str "cs(function(){return ",
892 e, 900 e,
893 str "})"], 901 str "})"],
894 st) 902 st)
895 end 903 end
993 (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st) 1001 (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st)
994 end 1002 end
995 in 1003 in
996 case e of 1004 case e of
997 EJavaScript (m, orig, NONE) => 1005 EJavaScript (m, orig, NONE) =>
998 doCode m 0 env orig orig 1006 (foundJavaScript := true;
1007 doCode m 0 env orig orig)
999 | _ => (e, st) 1008 | _ => (e, st)
1000 end, 1009 end,
1001 decl = fn (_, e, st) => (e, st), 1010 decl = fn (_, e, st) => (e, st),
1002 bind = fn (env, U.Decl.RelE (_, t)) => t :: env 1011 bind = fn (env, U.Decl.RelE (_, t)) => t :: env
1003 | (env, _) => env} 1012 | (env, _) => env}
1029 fun lines acc = 1038 fun lines acc =
1030 case TextIO.inputLine inf of 1039 case TextIO.inputLine inf of
1031 NONE => String.concat (rev acc) 1040 NONE => String.concat (rev acc)
1032 | SOME line => lines (line :: acc) 1041 | SOME line => lines (line :: acc)
1033 val lines = lines [] 1042 val lines = lines []
1043
1044 val script =
1045 if !foundJavaScript then
1046 lines ^ String.concat (rev (#script st))
1047 else
1048 ""
1034 in 1049 in
1035 TextIO.closeIn inf; 1050 TextIO.closeIn inf;
1036 (DJavaScript (lines ^ String.concat (rev (#script st))), ErrorMsg.dummySpan) :: ds 1051 (DJavaScript script, ErrorMsg.dummySpan) :: ds
1037 end 1052 end
1038 1053
1039 end 1054 end