Mercurial > urweb

comparison src/jscomp.sml @ 1663:0577be31a435

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First part of changes to avoid depending on C function call argument order of evaluation (omitting normal Ur function calls, so far)
author Adam Chlipala <adam@chlipala.net>
date Sat, 07 Jan 2012 15:56:22 -0500
parents 3e7c7e200713
children c414850f206f
comparison
equal deleted inserted replaced
1662:edf86cef0dba 1663:0577be31a435
89 | TRecord [] => true 89 | TRecord [] => true
90 | _ => false 90 | _ => false
91 91
92 fun quoteExp loc (t : typ) (e, st) = 92 fun quoteExp loc (t : typ) (e, st) =
93 case #1 t of 93 case #1 t of
94 TSource => ((EFfiApp ("Basis", "htmlifySource", [e]), loc), st) 94 TSource => ((EFfiApp ("Basis", "htmlifySource", [(e, t)]), loc), st)
95 95
96 | TRecord [] => (str loc "null", st) 96 | TRecord [] => (str loc "null", st)
97 | TRecord [(x, t)] => 97 | TRecord [(x, t)] =>
98 let 98 let
99 val (e, st) = quoteExp loc t ((EField (e, x), loc), st) 99 val (e, st) = quoteExp loc t ((EField (e, x), loc), st)
118 :: e' 118 :: e'
119 :: es 119 :: es
120 @ [str loc "}"]), st) 120 @ [str loc "}"]), st)
121 end 121 end
122 122
123 | TFfi ("Basis", "string") => ((EFfiApp ("Basis", "jsifyString", [e]), loc), st) 123 | TFfi ("Basis", "string") => ((EFfiApp ("Basis", "jsifyString", [(e, t)]), loc), st)
124 | TFfi ("Basis", "char") => ((EFfiApp ("Basis", "jsifyChar", [e]), loc), st) 124 | TFfi ("Basis", "char") => ((EFfiApp ("Basis", "jsifyChar", [(e, t)]), loc), st)
125 | TFfi ("Basis", "int") => ((EFfiApp ("Basis", "htmlifyInt", [e]), loc), st) 125 | TFfi ("Basis", "int") => ((EFfiApp ("Basis", "htmlifyInt", [(e, t)]), loc), st)
126 | TFfi ("Basis", "float") => ((EFfiApp ("Basis", "htmlifyFloat", [e]), loc), st) 126 | TFfi ("Basis", "float") => ((EFfiApp ("Basis", "htmlifyFloat", [(e, t)]), loc), st)
127 | TFfi ("Basis", "channel") => ((EFfiApp ("Basis", "jsifyChannel", [e]), loc), st) 127 | TFfi ("Basis", "channel") => ((EFfiApp ("Basis", "jsifyChannel", [(e, t)]), loc), st)
128 | TFfi ("Basis", "time") => ((EFfiApp ("Basis", "jsifyTime", [e]), loc), st) 128 | TFfi ("Basis", "time") => ((EFfiApp ("Basis", "jsifyTime", [(e, t)]), loc), st)
129 129
130 | TFfi ("Basis", "bool") => ((ECase (e, 130 | TFfi ("Basis", "bool") => ((ECase (e,
131 [((PCon (Enum, PConFfi {mod = "Basis", 131 [((PCon (Enum, PConFfi {mod = "Basis",
132 datatyp = "bool", 132 datatyp = "bool",
133 con = "True", 133 con = "True",
509 509
510 fun deStrcat level (all as (e, _)) = 510 fun deStrcat level (all as (e, _)) =
511 case e of 511 case e of
512 EPrim (Prim.String s) => jsifyStringMulti (level, s) 512 EPrim (Prim.String s) => jsifyStringMulti (level, s)
513 | EStrcat (e1, e2) => deStrcat level e1 ^ deStrcat level e2 513 | EStrcat (e1, e2) => deStrcat level e1 ^ deStrcat level e2
514 | EFfiApp ("Basis", "jsifyString", [e]) => "\"" ^ deStrcat (level + 1) e ^ "\"" 514 | EFfiApp ("Basis", "jsifyString", [(e, _)]) => "\"" ^ deStrcat (level + 1) e ^ "\""
515 | _ => (Print.prefaces "deStrcat" [("e", MonoPrint.p_exp MonoEnv.empty all)]; 515 | _ => (Print.prefaces "deStrcat" [("e", MonoPrint.p_exp MonoEnv.empty all)];
516 raise Fail "Jscomp: deStrcat") 516 raise Fail "Jscomp: deStrcat")
517 517
518 val quoteExp = quoteExp loc 518 val quoteExp = quoteExp loc
519 in 519 in
643 NONE => (EM.errorAt loc ("Unsupported FFI function " 643 NONE => (EM.errorAt loc ("Unsupported FFI function "
644 ^ m ^ "." ^ x ^ " in JavaScript"); 644 ^ m ^ "." ^ x ^ " in JavaScript");
645 "ERROR") 645 "ERROR")
646 | SOME s => s 646 | SOME s => s
647 647
648 val (e, st) = foldr (fn (e, (acc, st)) => 648 val (e, st) = foldr (fn ((e, _), (acc, st)) =>
649 let 649 let
650 val (e, st) = jsE inner (e, st) 650 val (e, st) = jsE inner (e, st)
651 in 651 in
652 (strcat [str "cons(", 652 (strcat [str "cons(",
653 e, 653 e,
1022 ((ESome (t, e), loc), st) 1022 ((ESome (t, e), loc), st)
1023 end 1023 end
1024 | EFfi _ => (e, st) 1024 | EFfi _ => (e, st)
1025 | EFfiApp (m, x, es) => 1025 | EFfiApp (m, x, es) =>
1026 let 1026 let
1027 val (es, st) = ListUtil.foldlMap (exp outer) st es 1027 val (es, st) = ListUtil.foldlMap (fn ((e, t), st) =>
1028 let
1029 val (e, st) = exp outer (e, st)
1030 in
1031 ((e, t), st)
1032 end) st es
1028 in 1033 in
1029 ((EFfiApp (m, x, es), loc), st) 1034 ((EFfiApp (m, x, es), loc), st)
1030 end 1035 end
1031 | EApp (e1, e2) => 1036 | EApp (e1, e2) =>
1032 let 1037 let