Mercurial > urweb

comparison src/jscomp.sml @ 584:101eb0058136

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Used an option as a source
author Adam Chlipala <adamc@hcoop.net>
date Thu, 01 Jan 2009 10:49:42 -0500
parents 1fd4c041634e
children 35471f067980
comparison
equal deleted inserted replaced
583:1fd4c041634e 584:101eb0058136
131 | TRecord [] => str "null" 131 | TRecord [] => str "null"
132 | TFfi ("Basis", "string") => e 132 | TFfi ("Basis", "string") => e
133 | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript"; 133 | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript";
134 Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)]; 134 Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)];
135 str "ERROR") 135 str "ERROR")
136
137 fun jsPrim p =
138 case p of
139 Prim.String s =>
140 str ("\""
141 ^ String.translate (fn #"'" =>
142 if mode = Attribute then
143 "\\047"
144 else
145 "'"
146 | #"\"" => "\\\""
147 | #"<" =>
148 if mode = Script then
149 "<"
150 else
151 "\\074"
152 | #"\\" => "\\\\"
153 | ch => String.str ch) s
154 ^ "\"")
155 | _ => str (Prim.toString p)
156
157 fun jsPat inner (p, _) succ fail =
158 case p of
159 PWild => succ
160 | PVar _ => strcat [str ("(_" ^ Int.toString (len + inner) ^ "=d,"),
161 succ,
162 str ")"]
163 | PPrim p => strcat [str "(d==",
164 jsPrim p,
165 str "?",
166 succ,
167 str ":",
168 fail,
169 str ")"]
170 | PCon _ => raise Fail "jsPat: PCon"
171 | PRecord xps =>
172 let
173 val (_, succ) = foldl
174 (fn ((x, p, _), (inner, succ)) =>
175 (inner + E.patBindsN p,
176 jsPat inner p succ fail))
177 (inner, succ) xps
178 in
179 succ
180 end
181 | PNone _ => strcat [str "(d?",
182 fail,
183 str ":",
184 succ,
185 str ")"]
186 | PSome (_, p) => strcat [str "(d?",
187 jsPat inner p succ fail,
188 str ":",
189 fail,
190 str ")"]
136 in 191 in
137 case #1 e of 192 case #1 e of
138 EPrim (Prim.String s) => 193 EPrim p => (jsPrim p, st)
139 (str ("\""
140 ^ String.translate (fn #"'" =>
141 if mode = Attribute then
142 "\\047"
143 else
144 "'"
145 | #"\"" => "\\\""
146 | #"<" =>
147 if mode = Script then
148 "<"
149 else
150 "\\074"
151 | #"\\" => "\\\\"
152 | ch => String.str ch) s
153 ^ "\""), st)
154 | EPrim p => (str (Prim.toString p), st)
155 | ERel n => 194 | ERel n =>
156 if n < inner then 195 if n < inner then
157 (str ("_" ^ var n), st) 196 (str ("_" ^ var n), st)
158 else 197 else
159 let 198 let
315 in 354 in
316 (strcat [e, 355 (strcat [e,
317 str ("._" ^ x)], st) 356 str ("._" ^ x)], st)
318 end 357 end
319 358
320 | ECase _ => raise Fail "Jscomp: ECase" 359 | ECase (e, pes, _) =>
360 let
361 val plen = length pes
362
363 val (cases, st) = ListUtil.foldliMap
364 (fn (i, (p, e), st) =>
365 let
366 val (e, st) = jsE (inner + E.patBindsN p) (e, st)
367 val fail =
368 if i = plen - 1 then
369 str "pf()"
370 else
371 str ("c" ^ Int.toString (i+1) ^ "()")
372 val c = jsPat inner p e fail
373 in
374 (strcat [str ("c" ^ Int.toString i ^ "=function(){return "),
375 c,
376 str "},"],
377 st)
378 end)
379 st pes
380
381 val (e, st) = jsE inner (e, st)
382 in
383 (strcat (str "("
384 :: List.revAppend (cases,
385 [str "d=",
386 e,
387 str ",c0())"])), st)
388 end
321 389
322 | EStrcat (e1, e2) => 390 | EStrcat (e1, e2) =>
323 let 391 let
324 val (e1, st) = jsE inner (e1, st) 392 val (e1, st) = jsE inner (e1, st)
325 val (e2, st) = jsE inner (e2, st) 393 val (e2, st) = jsE inner (e2, st)