Mercurial > urweb

comparison src/jscomp.sml @ 613:c5991cdb0c4b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial parsing of RPC results
author Adam Chlipala <adamc@hcoop.net>
date Sun, 15 Feb 2009 12:33:41 -0500
parents 56aaa1941dad
children 5891f47d7cff
comparison
equal deleted inserted replaced
612:d80256efc160 613:c5991cdb0c4b
301 end) 301 end)
302 302
303 | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript"; 303 | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript";
304 Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)]; 304 Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)];
305 (str loc "ERROR", st)) 305 (str loc "ERROR", st))
306
307 fun unurlifyExp loc (t : typ, st) =
308 case #1 t of
309 TRecord [] => ("null", st)
310 | TRecord [(x, t)] =>
311 let
312 val (e, st) = unurlifyExp loc (t, st)
313 in
314 ("{_" ^ x ^ ":" ^ e ^ "}",
315 st)
316 end
317 | TRecord ((x, t) :: xts) =>
318 let
319 val (e', st) = unurlifyExp loc (t, st)
320 val (es, st) = ListUtil.foldlMap
321 (fn ((x, t), st) =>
322 let
323 val (e, st) = unurlifyExp loc (t, st)
324 in
325 (",_" ^ x ^ ":" ^ e, st)
326 end)
327 st xts
328 in
329 (String.concat ("{_"
330 :: x
331 :: ":"
332 :: e'
333 :: es
334 @ ["}"]), st)
335 end
336
337 | TFfi ("Basis", "string") => ("decode(t[i++])", st)
338 | TFfi ("Basis", "int") => ("parseInt(t[i++])", st)
339 | TFfi ("Basis", "float") => ("parseFloat(t[i++])", st)
340
341 | TFfi ("Basis", "bool") => ("t[i++] == \"True\"", st)
342
343 | TOption t => raise Fail "!!" (*
344 let
345 val (e', st) = quoteExp loc t ((ERel 0, loc), st)
346 in
347 ((ECase (e,
348 [((PNone t, loc),
349 str loc "null"),
350 ((PSome (t, (PVar ("x", t), loc)), loc),
351 if isNullable t then
352 strcat loc [str loc "{v:", e', str loc "}"]
353 else
354 e')],
355 {disc = (TOption t, loc),
356 result = (TFfi ("Basis", "string"), loc)}), loc),
357 st)
358 end*)
359
360 | TDatatype (n, ref (dk, cs)) => raise Fail "!!" (*
361 (case IM.find (#injectors st, n) of
362 SOME n' => ((EApp ((ENamed n', loc), e), loc), st)
363 | NONE =>
364 let
365 val dk = ElabUtil.classifyDatatype cs
366
367 val n' = #maxName st
368 val st = {decls = #decls st,
369 script = #script st,
370 included = #included st,
371 injectors = IM.insert (#injectors st, n, n'),
372 maxName = n' + 1}
373
374 val (pes, st) = ListUtil.foldlMap
375 (fn ((_, cn, NONE), st) =>
376 (((PCon (dk, PConVar cn, NONE), loc),
377 case dk of
378 Option => str loc "null"
379 | _ => str loc (Int.toString cn)),
380 st)
381 | ((_, cn, SOME t), st) =>
382 let
383 val (e, st) = quoteExp loc t ((ERel 0, loc), st)
384 in
385 (((PCon (dk, PConVar cn, SOME (PVar ("x", t), loc)), loc),
386 case dk of
387 Option =>
388 if isNullable t then
389 strcat loc [str loc "{_v:",
390 e,
391 str loc "}"]
392 else
393 e
394 | _ => strcat loc [str loc ("{n:" ^ Int.toString cn
395 ^ ",v:"),
396 e,
397 str loc "}"]),
398 st)
399 end)
400 st cs
401
402 val s = (TFfi ("Basis", "string"), loc)
403 val body = (ECase ((ERel 0, loc), pes,
404 {disc = t, result = s}), loc)
405 val body = (EAbs ("x", t, s, body), loc)
406
407 val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc),
408 body, "jsify")], loc) :: #decls st,
409 script = #script st,
410 included = #included st,
411 injectors = #injectors st,
412 maxName = #maxName st}
413 in
414 ((EApp ((ENamed n', loc), e), loc), st)
415 end)*)
416
417 | _ => (EM.errorAt loc "Don't know how to unurlify type in JavaScript";
418 Print.prefaces "Can't unurlify" [("t", MonoPrint.p_typ MonoEnv.empty t)];
419 ("ERROR", st))
306 420
307 fun jsExp mode skip outer = 421 fun jsExp mode skip outer =
308 let 422 let
309 val len = length outer 423 val len = length outer
310 424
810 e, 924 e,
811 str ")"], 925 str ")"],
812 st) 926 st)
813 end 927 end
814 928
815 | EServerCall (x, es, ek, _) => 929 | EServerCall (x, es, ek, t) =>
816 let 930 let
817 val (ek, st) = jsE inner (ek, st) 931 val (ek, st) = jsE inner (ek, st)
818 in 932 val (unurl, st) = unurlifyExp loc (t, st)
819 (strcat [str ("rc(\"" ^ !Monoize.urlPrefix ^ x ^ "\","), 933 in
934 (strcat [str ("rc(\"" ^ !Monoize.urlPrefix ^ x ^ "\", function(s){var t=s.split(\"/\");var i=0;return "
935 ^ unurl ^ "},"),
820 ek, 936 ek,
821 str ")"], 937 str ")"],
822 st) 938 st)
823 end 939 end
824 end 940 end