Mercurial > urweb

comparison src/jscomp.sml @ 601:7c3c21eb5b4c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial experiments with nested <dyn>
author Adam Chlipala <adamc@hcoop.net>
date Tue, 13 Jan 2009 15:17:11 -0500
parents d49d58a69877
children b1064de2b1f9
comparison
equal deleted inserted replaced
600:d1cce194180d 601:7c3c21eb5b4c
35 35
36 structure IS = IntBinarySet 36 structure IS = IntBinarySet
37 structure IM = IntBinaryMap 37 structure IM = IntBinaryMap
38 38
39 val funcs = [(("Basis", "alert"), "alert"), 39 val funcs = [(("Basis", "alert"), "alert"),
40 (("Basis", "get_client_source"), "sg"),
40 (("Basis", "htmlifyBool"), "bs"), 41 (("Basis", "htmlifyBool"), "bs"),
41 (("Basis", "htmlifyFloat"), "ts"), 42 (("Basis", "htmlifyFloat"), "ts"),
42 (("Basis", "htmlifyInt"), "ts"), 43 (("Basis", "htmlifyInt"), "ts"),
43 (("Basis", "htmlifyString"), "eh"), 44 (("Basis", "htmlifyString"), "eh"),
44 (("Basis", "new_client_source"), "sc"), 45 (("Basis", "new_client_source"), "sc"),
433 @ [jsPat depth inner p succ fail, 434 @ [jsPat depth inner p succ fail,
434 str ":", 435 str ":",
435 fail, 436 fail,
436 str ")"]) 437 str ")"])
437 438
438 fun deStrcat (e, _) = 439 val jsifyString = String.translate (fn #"\"" => "\\\""
440 | #"\\" => "\\\\"
441 | ch => String.str ch)
442
443 fun jsifyStringMulti (n, s) =
444 case n of
445 0 => s
446 | _ => jsifyStringMulti (n - 1, jsifyString s)
447
448 fun deStrcat level (all as (e, _)) =
439 case e of 449 case e of
440 EPrim (Prim.String s) => s 450 EPrim (Prim.String s) => jsifyStringMulti (level, s)
441 | EStrcat (e1, e2) => deStrcat e1 ^ deStrcat e2 451 | EStrcat (e1, e2) => deStrcat level e1 ^ deStrcat level e2
442 | _ => raise Fail "Jscomp: deStrcat" 452 | EFfiApp ("Basis", "jsifyString", [e]) => "\"" ^ deStrcat (level + 1) e ^ "\""
453 | _ => (Print.prefaces "deStrcat" [("e", MonoPrint.p_exp MonoEnv.empty all)];
454 raise Fail "Jscomp: deStrcat")
443 455
444 val quoteExp = quoteExp loc 456 val quoteExp = quoteExp loc
445 in 457 in
446 (*Print.prefaces "jsE" [("e", MonoPrint.p_exp MonoEnv.empty e)];*) 458 (*Print.prefaces "jsE" [("e", MonoPrint.p_exp MonoEnv.empty e)];*)
447 459
472 included = IS.add (#included st, n), 484 included = IS.add (#included st, n),
473 injectors = #injectors st, 485 injectors = #injectors st,
474 maxName = #maxName st} 486 maxName = #maxName st}
475 487
476 val (e, st) = jsExp mode skip [] 0 (e, st) 488 val (e, st) = jsExp mode skip [] 0 (e, st)
477 val e = deStrcat e 489 val () = Print.prefaces "Pre-e" [("e", MonoPrint.p_exp MonoEnv.empty e)]
490 val e = deStrcat 0 e
478 491
479 val sc = "_n" ^ Int.toString n ^ "=" ^ e ^ ";\n" 492 val sc = "_n" ^ Int.toString n ^ "=" ^ e ^ ";\n"
480 in 493 in
481 {decls = #decls st, 494 {decls = #decls st,
482 script = sc :: #script st, 495 script = sc :: #script st,
743 str ",", 756 str ",",
744 e2, 757 e2,
745 str ")"], st) 758 str ")"], st)
746 end 759 end
747 760
748 | EJavaScript (_, _, SOME _) => (e, st) 761 | EJavaScript (Source _, _, SOME _) => (e, st)
762 | EJavaScript (_, _, SOME e) => ((EFfiApp ("Basis", "jsifyString", [e]), loc), st)
749 763
750 | EClosure _ => unsupported "EClosure" 764 | EClosure _ => unsupported "EClosure"
751 | EQuery _ => unsupported "Query" 765 | EQuery _ => unsupported "Query"
752 | EDml _ => unsupported "DML" 766 | EDml _ => unsupported "DML"
753 | ENextval _ => unsupported "Nextval" 767 | ENextval _ => unsupported "Nextval"
754 | EUnurlify _ => unsupported "EUnurlify" 768 | EUnurlify _ => unsupported "EUnurlify"
755 | EJavaScript (_, e, _) => unsupported "Nested JavaScript" 769 | EJavaScript (_, e, _) =>
770 let
771 val (e, st) = jsE inner (e, st)
772 in
773 ((EFfiApp ("Basis", "jsifyString", [e]), loc), st)
774 end
756 775
757 | ESignalReturn e => 776 | ESignalReturn e =>
758 let 777 let
759 val (e, st) = jsE inner (e, st) 778 val (e, st) = jsE inner (e, st)
760 in 779 in