Mercurial > urweb

comparison src/jscomp.sml @ 765:a28982de5645

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Successfully influenced effectful-ness status of FFI func
author Adam Chlipala <adamc@hcoop.net>
date Sat, 02 May 2009 11:27:26 -0400
parents 7f653298dd66
children dc3fc3f3b834
comparison
equal deleted inserted replaced
764:7f653298dd66 765:a28982de5645
33 structure E = MonoEnv 33 structure E = MonoEnv
34 structure U = MonoUtil 34 structure U = MonoUtil
35 35
36 structure IS = IntBinarySet 36 structure IS = IntBinarySet
37 structure IM = IntBinaryMap 37 structure IM = IntBinaryMap
38
39 val funcs = [(("Basis", "alert"), "alert"),
40 (("Basis", "get_client_source"), "sg"),
41 (("Basis", "htmlifyBool"), "bs"),
42 (("Basis", "htmlifyFloat"), "ts"),
43 (("Basis", "htmlifyInt"), "ts"),
44 (("Basis", "htmlifyString"), "eh"),
45 (("Basis", "new_client_source"), "sc"),
46 (("Basis", "set_client_source"), "sv"),
47 (("Basis", "stringToFloat_error"), "pfl"),
48 (("Basis", "stringToInt_error"), "pi"),
49 (("Basis", "urlifyInt"), "ts"),
50 (("Basis", "urlifyFloat"), "ts"),
51 (("Basis", "urlifyString"), "uf"),
52 (("Basis", "recv"), "rv"),
53 (("Basis", "strcat"), "cat"),
54 (("Basis", "intToString"), "ts"),
55 (("Basis", "floatToString"), "ts"),
56 (("Basis", "onError"), "onError"),
57 (("Basis", "onFail"), "onFail"),
58 (("Basis", "onConnectFail"), "onConnectFail"),
59 (("Basis", "onDisconnect"), "onDisconnect"),
60 (("Basis", "onServerError"), "onServerError")]
61
62 structure FM = BinaryMapFn(struct
63 type ord_key = string * string
64 fun compare ((m1, x1), (m2, x2)) =
65 Order.join (String.compare (m1, m2),
66 fn () => String.compare (x1, x2))
67 end)
68
69 val funcs = foldl (fn ((k, v), m) => FM.insert (m, k, v)) FM.empty funcs
70
71 fun ffi k = FM.find (funcs, k)
72 38
73 type state = { 39 type state = {
74 decls : decl list, 40 decls : decl list,
75 script : string list, 41 script : string list,
76 included : IS.set, 42 included : IS.set,
682 e, st) 648 e, st)
683 end 649 end
684 650
685 | EFfi k => 651 | EFfi k =>
686 let 652 let
687 val name = case ffi k of 653 val name = case Settings.jsFunc k of
688 NONE => (EM.errorAt loc ("Unsupported FFI identifier " ^ #2 k 654 NONE => (EM.errorAt loc ("Unsupported FFI identifier " ^ #2 k
689 ^ " in JavaScript"); 655 ^ " in JavaScript");
690 "ERROR") 656 "ERROR")
691 | SOME s => s 657 | SOME s => s
692 in 658 in
698 case (m, x, args) of 664 case (m, x, args) of
699 ("Basis", "new_client_source", [(EJavaScript (_, e, _), _)]) => [e] 665 ("Basis", "new_client_source", [(EJavaScript (_, e, _), _)]) => [e]
700 | ("Basis", "set_client_source", [e1, (EJavaScript (_, e2, _), _)]) => [e1, e2] 666 | ("Basis", "set_client_source", [e1, (EJavaScript (_, e2, _), _)]) => [e1, e2]
701 | _ => args 667 | _ => args
702 668
703 val name = case ffi (m, x) of 669 val name = case Settings.jsFunc (m, x) of
704 NONE => (EM.errorAt loc ("Unsupported FFI function " 670 NONE => (EM.errorAt loc ("Unsupported FFI function "
705 ^ x ^ " in JavaScript"); 671 ^ x ^ " in JavaScript");
706 "ERROR") 672 "ERROR")
707 | SOME s => s 673 | SOME s => s
708 in 674 in