Mercurial > urweb

comparison src/jscomp.sml @ 594:55829473f6a7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Injected an option
author Adam Chlipala <adamc@hcoop.net>
date Fri, 02 Jan 2009 13:03:22 -0500
parents f277f5faebcd
children 02c8ab9f3e8b
comparison
equal deleted inserted replaced
593:f277f5faebcd 594:55829473f6a7
154 | (_, nameds) => nameds) 154 | (_, nameds) => nameds)
155 IM.empty file 155 IM.empty file
156 156
157 fun str loc s = (EPrim (Prim.String s), loc) 157 fun str loc s = (EPrim (Prim.String s), loc)
158 158
159 fun isNullable (t, _) =
160 case t of
161 TOption _ => true
162 | TRecord [] => true
163 | _ => false
164
159 fun quoteExp loc (t : typ) (e, st) = 165 fun quoteExp loc (t : typ) (e, st) =
160 case #1 t of 166 case #1 t of
161 TSource => (strcat loc [str loc "s", 167 TSource => (strcat loc [str loc "s",
162 (EFfiApp ("Basis", "htmlifyInt", [e]), loc)], st) 168 (EFfiApp ("Basis", "htmlifyInt", [e]), loc)], st)
163 169
205 str loc "false")], 211 str loc "false")],
206 {disc = (TFfi ("Basis", "bool"), loc), 212 {disc = (TFfi ("Basis", "bool"), loc),
207 result = (TFfi ("Basis", "string"), loc)}), loc), 213 result = (TFfi ("Basis", "string"), loc)}), loc),
208 st) 214 st)
209 215
216 | TOption t =>
217 let
218 val (e', st) = quoteExp loc t ((ERel 0, loc), st)
219 in
220 ((ECase (e,
221 [((PNone t, loc),
222 str loc "null"),
223 ((PSome (t, (PVar ("x", t), loc)), loc),
224 if isNullable t then
225 strcat loc [str loc "{v:", e', str loc "}"]
226 else
227 e')],
228 {disc = (TOption t, loc),
229 result = (TFfi ("Basis", "string"), loc)}), loc),
230 st)
231 end
232
210 | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript"; 233 | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript";
211 Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)]; 234 Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)];
212 (str loc "ERROR", st)) 235 (str loc "ERROR", st))
213 236
214 fun jsExp mode skip outer = 237 fun jsExp mode skip outer =
225 case pc of 248 case pc of
226 PConVar n => str (Int.toString n) 249 PConVar n => str (Int.toString n)
227 | PConFfi {mod = "Basis", con = "True", ...} => str "true" 250 | PConFfi {mod = "Basis", con = "True", ...} => str "true"
228 | PConFfi {mod = "Basis", con = "False", ...} => str "false" 251 | PConFfi {mod = "Basis", con = "False", ...} => str "false"
229 | PConFfi {con, ...} => str ("\"_" ^ con ^ "\"") 252 | PConFfi {con, ...} => str ("\"_" ^ con ^ "\"")
230
231 fun isNullable (t, _) =
232 case t of
233 TOption _ => true
234 | TRecord [] => true
235 | _ => false
236 253
237 fun unsupported s = 254 fun unsupported s =
238 (EM.errorAt loc (s ^ " in code to be compiled to JavaScript[2]"); 255 (EM.errorAt loc (s ^ " in code to be compiled to JavaScript[2]");
239 (str "ERROR", st)) 256 (str "ERROR", st))
240 257
318 | PNone _ => strcat [str ("(d" ^ Int.toString depth ^ "?"), 335 | PNone _ => strcat [str ("(d" ^ Int.toString depth ^ "?"),
319 fail, 336 fail,
320 str ":", 337 str ":",
321 succ, 338 succ,
322 str ")"] 339 str ")"]
323 | PSome (_, p) => strcat [str ("(d" ^ Int.toString depth ^ "?"), 340 | PSome (t, p) => strcat (str ("(d" ^ Int.toString depth ^ "?")
324 jsPat depth inner p succ fail, 341 :: (if isNullable t then
325 str ":", 342 [str ("d" ^ Int.toString depth
326 fail, 343 ^ "=d" ^ Int.toString depth ^ ".v")]
327 str ")"] 344 else
345 [])
346 @ [jsPat depth inner p succ fail,
347 str ":",
348 fail,
349 str ")"])
328 350
329 fun deStrcat (e, _) = 351 fun deStrcat (e, _) =
330 case e of 352 case e of
331 EPrim (Prim.String s) => s 353 EPrim (Prim.String s) => s
332 | EStrcat (e1, e2) => deStrcat e1 ^ deStrcat e2 354 | EStrcat (e1, e2) => deStrcat e1 ^ deStrcat e2