Mercurial > urweb

comparison src/jscomp.sml @ 2048:4d64af730e35

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Differentiate between HTML and normal string literals
author Adam Chlipala <adam@chlipala.net>
date Fri, 01 Aug 2014 15:44:17 -0400
parents 057b08253a75
children 9e9c915f554c 278e10629ba1
comparison
equal deleted inserted replaced
2047:6be31671911b 2048:4d64af730e35
53 maxName : int 53 maxName : int
54 } 54 }
55 55
56 fun strcat loc es = 56 fun strcat loc es =
57 case es of 57 case es of
58 [] => (EPrim (Prim.String ""), loc) 58 [] => (EPrim (Prim.String (Prim.Normal, "")), loc)
59 | [x] => x 59 | [x] => x
60 | x :: es' => (EStrcat (x, strcat loc es'), loc) 60 | x :: es' => (EStrcat (x, strcat loc es'), loc)
61 61
62 exception CantEmbed of typ 62 exception CantEmbed of typ
63 63
79 someTs) someTs dts, 79 someTs) someTs dts,
80 nameds) 80 nameds)
81 | (_, state) => state) 81 | (_, state) => state)
82 (IM.empty, IM.empty) (#1 file) 82 (IM.empty, IM.empty) (#1 file)
83 83
84 fun str loc s = (EPrim (Prim.String s), loc) 84 fun str loc s = (EPrim (Prim.String (Prim.Normal, s)), loc)
85 85
86 fun isNullable (t, _) = 86 fun isNullable (t, _) =
87 case t of 87 case t of
88 TOption _ => true 88 TOption _ => true
89 | TList _ => true 89 | TList _ => true
147 | TOption t => 147 | TOption t =>
148 let 148 let
149 val (e', st) = quoteExp loc t ((ERel 0, loc), st) 149 val (e', st) = quoteExp loc t ((ERel 0, loc), st)
150 in 150 in
151 (case #1 e' of 151 (case #1 e' of
152 EPrim (Prim.String "ERROR") => raise Fail "UHOH" 152 EPrim (Prim.String (_, "ERROR")) => raise Fail "UHOH"
153 | _ => 153 | _ =>
154 (ECase (e, 154 (ECase (e,
155 [((PNone t, loc), 155 [((PNone t, loc),
156 str loc "null"), 156 str loc "null"),
157 ((PSome (t, (PVar ("x", t), loc)), loc), 157 ((PSome (t, (PVar ("x", t), loc)), loc),
448 "\\" ^ padWith (#"0", 448 "\\" ^ padWith (#"0",
449 Int.fmt StringCvt.OCT (ord ch), 449 Int.fmt StringCvt.OCT (ord ch),
450 3) 450 3)
451 in 451 in
452 case p of 452 case p of
453 Prim.String s => 453 Prim.String (_, s) =>
454 str ("\"" ^ String.translate jsChar s ^ "\"") 454 str ("\"" ^ String.translate jsChar s ^ "\"")
455 | Prim.Char ch => str ("\"" ^ jsChar ch ^ "\"") 455 | Prim.Char ch => str ("\"" ^ jsChar ch ^ "\"")
456 | _ => str (Prim.toString p) 456 | _ => str (Prim.toString p)
457 end 457 end
458 458
517 0 => s 517 0 => s
518 | _ => jsifyStringMulti (n - 1, jsifyString s) 518 | _ => jsifyStringMulti (n - 1, jsifyString s)
519 519
520 fun deStrcat level (all as (e, loc)) = 520 fun deStrcat level (all as (e, loc)) =
521 case e of 521 case e of
522 EPrim (Prim.String s) => jsifyStringMulti (level, s) 522 EPrim (Prim.String (_, s)) => jsifyStringMulti (level, s)
523 | EStrcat (e1, e2) => deStrcat level e1 ^ deStrcat level e2 523 | EStrcat (e1, e2) => deStrcat level e1 ^ deStrcat level e2
524 | EFfiApp ("Basis", "jsifyString", [(e, _)]) => "\"" ^ deStrcat (level + 1) e ^ "\"" 524 | EFfiApp ("Basis", "jsifyString", [(e, _)]) => "\"" ^ deStrcat (level + 1) e ^ "\""
525 | _ => (ErrorMsg.errorAt loc "Unexpected non-constant JavaScript code"; 525 | _ => (ErrorMsg.errorAt loc "Unexpected non-constant JavaScript code";
526 Print.prefaces "deStrcat" [("e", MonoPrint.p_exp MonoEnv.empty all)]; 526 Print.prefaces "deStrcat" [("e", MonoPrint.p_exp MonoEnv.empty all)];
527 "") 527 "")
1019 fun exp outer (e as (_, loc), st) = 1019 fun exp outer (e as (_, loc), st) =
1020 ((*Print.preface ("exp", MonoPrint.p_exp MonoEnv.empty e);*) 1020 ((*Print.preface ("exp", MonoPrint.p_exp MonoEnv.empty e);*)
1021 case #1 e of 1021 case #1 e of
1022 EPrim p => 1022 EPrim p =>
1023 (case p of 1023 (case p of
1024 Prim.String s => if inString {needle = "<script", haystack = s} then 1024 Prim.String (_, s) => if inString {needle = "<script", haystack = s} then
1025 foundJavaScript := true 1025 foundJavaScript := true
1026 else 1026 else
1027 () 1027 ()
1028 | _ => (); 1028 | _ => ();
1029 (e, st)) 1029 (e, st))
1030 | ERel _ => (e, st) 1030 | ERel _ => (e, st)
1031 | ENamed _ => (e, st) 1031 | ENamed _ => (e, st)
1032 | ECon (_, _, NONE) => (e, st) 1032 | ECon (_, _, NONE) => (e, st)