Mercurial > urweb

comparison src/jscomp.sml @ 813:7b380e2b9e68

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Corify FFI datatypes properly; eliminate nested JavaScript markers
author Adam Chlipala <adamc@hcoop.net>
date Sun, 17 May 2009 13:25:57 -0400
parents c1f8963ebb18
children 493f44759879
comparison
equal deleted inserted replaced
812:2fbd1ac2f04b 813:7b380e2b9e68
166 | _ => e, 166 | _ => e,
167 bind = fn (inner, b) => 167 bind = fn (inner, b) =>
168 case b of 168 case b of
169 U.Exp.RelE _ => inner+1 169 U.Exp.RelE _ => inner+1
170 | _ => inner} 170 | _ => inner}
171
172 val desourceify' =
173 U.Exp.map {typ = fn t => t,
174 exp = fn e =>
175 case e of
176 EJavaScript (_, e, _) => #1 e
177 | _ => e}
178
179 val desourceify =
180 U.File.map {typ = fn t => t,
181 exp = fn e =>
182 case e of
183 EJavaScript (m, e, eo) => EJavaScript (m, desourceify' e, eo)
184 | _ => e,
185 decl = fn d => d}
171 186
172 fun process file = 187 fun process file =
173 let 188 let
174 val (someTs, nameds) = 189 val (someTs, nameds) =
175 foldl (fn ((DVal (_, n, t, e, _), _), (someTs, nameds)) => (someTs, IM.insert (nameds, n, e)) 190 foldl (fn ((DVal (_, n, t, e, _), _), (someTs, nameds)) => (someTs, IM.insert (nameds, n, e))
249 264
250 | TOption t => 265 | TOption t =>
251 let 266 let
252 val (e', st) = quoteExp loc t ((ERel 0, loc), st) 267 val (e', st) = quoteExp loc t ((ERel 0, loc), st)
253 in 268 in
254 ((ECase (e, 269 (case #1 e' of
255 [((PNone t, loc), 270 EPrim (Prim.String "ERROR") => raise Fail "UHOH"
256 str loc "null"), 271 | _ =>
257 ((PSome (t, (PVar ("x", t), loc)), loc), 272 (ECase (e,
258 if isNullable t then 273 [((PNone t, loc),
259 strcat loc [str loc "{v:", e', str loc "}"] 274 str loc "null"),
260 else 275 ((PSome (t, (PVar ("x", t), loc)), loc),
261 e')], 276 if isNullable t then
262 {disc = (TOption t, loc), 277 strcat loc [str loc "{v:", e', str loc "}"]
263 result = (TFfi ("Basis", "string"), loc)}), loc), 278 else
279 e')],
280 {disc = (TOption t, loc),
281 result = (TFfi ("Basis", "string"), loc)}), loc),
264 st) 282 st)
265 end 283 end
266 284
267 | TList t' => 285 | TList t' =>
268 (case TM.find (#listInjectors st, t') of 286 (case TM.find (#listInjectors st, t') of
576 strcat [str ("(d" ^ Int.toString depth ^ "?(d" 594 strcat [str ("(d" ^ Int.toString depth ^ "?(d"
577 ^ Int.toString (depth+1) ^ "=d" ^ Int.toString depth 595 ^ Int.toString (depth+1) ^ "=d" ^ Int.toString depth
578 ^ (if isNullable t then 596 ^ (if isNullable t then
579 ".v," 597 ".v,"
580 else 598 else
581 "")), 599 "")
600 ^ ","),
582 jsPat (depth+1) inner p succ fail, 601 jsPat (depth+1) inner p succ fail,
583 str "):", 602 str "):",
584 fail, 603 fail,
585 str ")"]) 604 str ")"])
586 | PCon (_, pc, NONE) => 605 | PCon (_, pc, NONE) =>
655 | ERel n => 674 | ERel n =>
656 if n < inner then 675 if n < inner then
657 (str ("_" ^ var n), st) 676 (str ("_" ^ var n), st)
658 else 677 else
659 let 678 let
660 (*val () = Print.prefaces "ERel"
661 [("n", Print.PD.string (Int.toString n)),
662 ("inner", Print.PD.string (Int.toString inner)),
663 ("eq", MonoPrint.p_exp MonoEnv.empty
664 (#1 (quoteExp (List.nth (outer, n - inner))
665 ((ERel (n - inner), loc), st))))]*)
666 val n = n - inner 679 val n = n - inner
680 (*val () = Print.prefaces "quote" [("t", MonoPrint.p_typ MonoEnv.empty
681 (List.nth (outer, n)))]*)
667 in 682 in
668 quoteExp (List.nth (outer, n)) ((ERel n, loc), st) 683 quoteExp (List.nth (outer, n)) ((ERel n, loc), st)
669 end 684 end
670 685
671 | ENamed n => 686 | ENamed n =>
1081 1096
1082 val decl : state -> decl -> decl * state = 1097 val decl : state -> decl -> decl * state =
1083 U.Decl.foldMapB {typ = fn x => x, 1098 U.Decl.foldMapB {typ = fn x => x,
1084 exp = fn (env, e, st) => 1099 exp = fn (env, e, st) =>
1085 let 1100 let
1086 fun doCode m env orig e = 1101 fun doCode m env e =
1087 let 1102 let
1088 val len = length env 1103 val len = length env
1089 fun str s = (EPrim (Prim.String s), #2 e) 1104 fun str s = (EPrim (Prim.String s), #2 e)
1090 1105
1091 val locals = List.tabulate 1106 val locals = List.tabulate
1092 (varDepth e, 1107 (varDepth e,
1093 fn i => str ("var _" ^ Int.toString (len + i) ^ ";")) 1108 fn i => str ("var _" ^ Int.toString (len + i) ^ ";"))
1094 val old = e 1109 val old = e
1095 val (e, st) = jsExp m env 0 (e, st) 1110 val (e, st) = jsExp m env 0 (e, st)
1111 val e =
1112 case locals of
1113 [] => e
1114 | _ =>
1115 strcat (#2 e) (str "(function(){"
1116 :: locals
1117 @ [str "return ",
1118 e,
1119 str "}())"])
1096 in 1120 in
1097 (*Print.prefaces "jsify" [("old", MonoPrint.p_exp MonoEnv.empty old), 1121 (*Print.prefaces "jsify" [("old", MonoPrint.p_exp MonoEnv.empty old),
1098 ("new", MonoPrint.p_exp MonoEnv.empty e)];*) 1122 ("new", MonoPrint.p_exp MonoEnv.empty e)];*)
1099 (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st) 1123 (EJavaScript (m, old, SOME e), st)
1100 end 1124 end
1101 in 1125 in
1102 case e of 1126 case e of
1103 EJavaScript (m, orig, NONE) => 1127 (*EJavaScript (m as Source t, orig, NONE) =>
1128 let
1129 val loc = #2 orig
1130 val (e, st) = doCode m (t :: env) (ERel 0, loc)
1131 in
1132 (ELet ("x", t, orig, (e, loc)), st)
1133 end
1134 |*) EJavaScript (m, orig, NONE) =>
1104 (foundJavaScript := true; 1135 (foundJavaScript := true;
1105 doCode m env orig orig) 1136 doCode m env orig)
1106 | _ => (e, st) 1137 | _ => (e, st)
1107 end, 1138 end,
1108 decl = fn (_, e, st) => (e, st), 1139 decl = fn (_, e, st) => (e, st),
1109 bind = fn (env, U.Decl.RelE (_, t)) => t :: env 1140 bind = fn (env, U.Decl.RelE (_, t)) => t :: env
1110 | (env, _) => env} 1141 | (env, _) => env}
1130 included = IS.empty, 1161 included = IS.empty,
1131 injectors = IM.empty, 1162 injectors = IM.empty,
1132 listInjectors = TM.empty, 1163 listInjectors = TM.empty,
1133 decoders = IM.empty, 1164 decoders = IM.empty,
1134 maxName = U.File.maxName file + 1} 1165 maxName = U.File.maxName file + 1}
1135 file 1166 (desourceify file)
1136 1167
1137 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"}) 1168 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"})
1138 fun lines acc = 1169 fun lines acc =
1139 case TextIO.inputLine inf of 1170 case TextIO.inputLine inf of
1140 NONE => String.concat (rev acc) 1171 NONE => String.concat (rev acc)