Mercurial > urweb

comparison src/jscomp.sml @ 578:1e589a60b86f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Harmonized source-setting between server and client
author Adam Chlipala <adamc@hcoop.net>
date Tue, 30 Dec 2008 11:33:31 -0500
parents 3d56940120b1
children 0094e0242100
comparison
equal deleted inserted replaced
577:3d56940120b1 578:1e589a60b86f
188 in 188 in
189 (str name, st) 189 (str name, st)
190 end 190 end
191 | EFfiApp (m, x, args) => 191 | EFfiApp (m, x, args) =>
192 let 192 let
193 val args =
194 case (m, x, args) of
195 ("Basis", "new_client_source", [(EJavaScript (_, e, _), _)]) => [e]
196 | ("Basis", "set_client_source", [e1, (EJavaScript (_, e2, _), _)]) => [e1, e2]
197 | _ => args
198
193 val name = case ffi (m, x) of 199 val name = case ffi (m, x) of
194 NONE => (EM.errorAt loc ("Unsupported FFI function " ^ x ^ " in JavaScript"); 200 NONE => (EM.errorAt loc ("Unsupported FFI function " ^ x ^ " in JavaScript");
195 "ERROR") 201 "ERROR")
196 | SOME s => s 202 | SOME s => s
197 in 203 in
198 case args of 204 case args of
199 [] => (str (name ^ "()"), st) 205 [] => (str (name ^ "()"), st)
200 | [e] => 206 | [e] =>
201 let 207 let
202 val (e, st) = jsE inner (e, st) 208 val (e, st) = jsE inner (e, st)
203
204 in 209 in
205 (strcat [str (name ^ "("), 210 (strcat [str (name ^ "("),
206 e, 211 e,
207 str ")"], st) 212 str ")"], st)
208 end 213 end
396 401
397 val decl : state -> decl -> decl * state = 402 val decl : state -> decl -> decl * state =
398 U.Decl.foldMapB {typ = fn x => x, 403 U.Decl.foldMapB {typ = fn x => x,
399 exp = fn (env, e, st) => 404 exp = fn (env, e, st) =>
400 let 405 let
401 fun doCode m env e = 406 fun doCode m env orig e =
402 let 407 let
403 val len = length env 408 val len = length env
404 fun str s = (EPrim (Prim.String s), #2 e) 409 fun str s = (EPrim (Prim.String s), #2 e)
405 410
406 val locals = List.tabulate 411 val locals = List.tabulate
407 (varDepth e, 412 (varDepth e,
408 fn i => str ("var uwr" ^ Int.toString (len + i) ^ ";")) 413 fn i => str ("var uwr" ^ Int.toString (len + i) ^ ";"))
409 val (e, st) = jsExp m env 0 (e, st) 414 val (e, st) = jsExp m env 0 (e, st)
410 in 415 in
411 (#1 (strcat (#2 e) (locals @ [e])), st) 416 (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st)
412 end 417 end
413 in 418 in
414 case e of 419 case e of
415 EJavaScript (m, (EAbs (_, t, _, e), _)) => doCode m (t :: env) e 420 EJavaScript (m, orig as (EAbs (_, t, _, e), _), _) => doCode m (t :: env) orig e
416 | EJavaScript (m, e) => doCode m env e 421 | EJavaScript (m, e, _) => doCode m env e e
417 | _ => (e, st) 422 | _ => (e, st)
418 end, 423 end,
419 decl = fn (_, e, st) => (e, st), 424 decl = fn (_, e, st) => (e, st),
420 bind = fn (env, U.Decl.RelE (_, t)) => t :: env 425 bind = fn (env, U.Decl.RelE (_, t)) => t :: env
421 | (env, _) => env} 426 | (env, _) => env}