Mercurial > urweb

comparison src/jscomp.sml @ 638:3ee6bb48f6e8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
RPC returning an enumeration
author Adam Chlipala <adamc@hcoop.net>
date Sun, 08 Mar 2009 12:37:42 -0400
parents 5891f47d7cff
children b98f547a6a45
comparison
equal deleted inserted replaced
637:24fd1edfcaa3 638:3ee6bb48f6e8
62 type state = { 62 type state = {
63 decls : decl list, 63 decls : decl list,
64 script : string list, 64 script : string list,
65 included : IS.set, 65 included : IS.set,
66 injectors : int IM.map, 66 injectors : int IM.map,
67 decoders : int IM.map,
67 maxName : int 68 maxName : int
68 } 69 }
69 70
70 fun varDepth (e, _) = 71 fun varDepth (e, _) =
71 case e of 72 case e of
249 | TDatatype (n, ref (dk, cs)) => 250 | TDatatype (n, ref (dk, cs)) =>
250 (case IM.find (#injectors st, n) of 251 (case IM.find (#injectors st, n) of
251 SOME n' => ((EApp ((ENamed n', loc), e), loc), st) 252 SOME n' => ((EApp ((ENamed n', loc), e), loc), st)
252 | NONE => 253 | NONE =>
253 let 254 let
254 val dk = ElabUtil.classifyDatatype cs
255
256 val n' = #maxName st 255 val n' = #maxName st
257 val st = {decls = #decls st, 256 val st = {decls = #decls st,
258 script = #script st, 257 script = #script st,
259 included = #included st, 258 included = #included st,
260 injectors = IM.insert (#injectors st, n, n'), 259 injectors = IM.insert (#injectors st, n, n'),
260 decoders = #decoders st,
261 maxName = n' + 1} 261 maxName = n' + 1}
262 262
263 val (pes, st) = ListUtil.foldlMap 263 val (pes, st) = ListUtil.foldlMap
264 (fn ((_, cn, NONE), st) => 264 (fn ((_, cn, NONE), st) =>
265 (((PCon (dk, PConVar cn, NONE), loc), 265 (((PCon (dk, PConVar cn, NONE), loc),
273 in 273 in
274 (((PCon (dk, PConVar cn, SOME (PVar ("x", t), loc)), loc), 274 (((PCon (dk, PConVar cn, SOME (PVar ("x", t), loc)), loc),
275 case dk of 275 case dk of
276 Option => 276 Option =>
277 if isNullable t then 277 if isNullable t then
278 strcat loc [str loc "{_v:", 278 strcat loc [str loc "{v:",
279 e, 279 e,
280 str loc "}"] 280 str loc "}"]
281 else 281 else
282 e 282 e
283 | _ => strcat loc [str loc ("{n:" ^ Int.toString cn 283 | _ => strcat loc [str loc ("{n:" ^ Int.toString cn
296 val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc), 296 val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc),
297 body, "jsify")], loc) :: #decls st, 297 body, "jsify")], loc) :: #decls st,
298 script = #script st, 298 script = #script st,
299 included = #included st, 299 included = #included st,
300 injectors = #injectors st, 300 injectors = #injectors st,
301 decoders= #decoders st,
301 maxName = #maxName st} 302 maxName = #maxName st}
302 in 303 in
303 ((EApp ((ENamed n', loc), e), loc), st) 304 ((EApp ((ENamed n', loc), e), loc), st)
304 end) 305 end)
305 306
319 end 320 end
320 | TRecord ((x, t) :: xts) => 321 | TRecord ((x, t) :: xts) =>
321 let 322 let
322 val (e', st) = unurlifyExp loc (t, st) 323 val (e', st) = unurlifyExp loc (t, st)
323 val (es, st) = ListUtil.foldlMap 324 val (es, st) = ListUtil.foldlMap
324 (fn ((x, t), st) => 325 (fn ((x, t), st) =>
325 let 326 let
326 val (e, st) = unurlifyExp loc (t, st) 327 val (e, st) = unurlifyExp loc (t, st)
327 in 328 in
328 (",_" ^ x ^ ":" ^ e, st) 329 (",_" ^ x ^ ":" ^ e, st)
329 end) 330 end)
330 st xts 331 st xts
331 in 332 in
332 (String.concat ("{_" 333 (String.concat ("{_"
333 :: x 334 :: x
334 :: ":" 335 :: ":"
335 :: e' 336 :: e'
341 | TFfi ("Basis", "int") => ("parseInt(t[i++])", st) 342 | TFfi ("Basis", "int") => ("parseInt(t[i++])", st)
342 | TFfi ("Basis", "float") => ("parseFloat(t[i++])", st) 343 | TFfi ("Basis", "float") => ("parseFloat(t[i++])", st)
343 344
344 | TFfi ("Basis", "bool") => ("t[i++] == \"True\"", st) 345 | TFfi ("Basis", "bool") => ("t[i++] == \"True\"", st)
345 346
346 | TOption t => raise Fail "!!" (* 347 | TOption t =>
347 let 348 let
348 val (e', st) = quoteExp loc t ((ERel 0, loc), st) 349 val (e, st) = unurlifyExp loc (t, st)
350 val e = if isNullable t then
351 "{v:" ^ e ^ "}"
352 else
353 e
349 in 354 in
350 ((ECase (e, 355 ("(uu=t[i++],uu==\"Some\"?" ^ e ^ ":null)", st)
351 [((PNone t, loc), 356 end
352 str loc "null"), 357
353 ((PSome (t, (PVar ("x", t), loc)), loc), 358 | TDatatype (n, ref (dk, cs)) =>
354 if isNullable t then 359 (case IM.find (#decoders st, n) of
355 strcat loc [str loc "{v:", e', str loc "}"] 360 SOME n' => ("(tmp=_n" ^ Int.toString n' ^ "(t,i),i=tmp._1,tmp._2)", st)
356 else
357 e')],
358 {disc = (TOption t, loc),
359 result = (TFfi ("Basis", "string"), loc)}), loc),
360 st)
361 end*)
362
363 | TDatatype (n, ref (dk, cs)) => raise Fail "!!" (*
364 (case IM.find (#injectors st, n) of
365 SOME n' => ((EApp ((ENamed n', loc), e), loc), st)
366 | NONE => 361 | NONE =>
367 let 362 let
368 val dk = ElabUtil.classifyDatatype cs
369
370 val n' = #maxName st 363 val n' = #maxName st
371 val st = {decls = #decls st, 364 val st = {decls = #decls st,
372 script = #script st, 365 script = #script st,
373 included = #included st, 366 included = #included st,
374 injectors = IM.insert (#injectors st, n, n'), 367 injectors = #injectors st,
368 decoders = IM.insert (#decoders st, n, n'),
375 maxName = n' + 1} 369 maxName = n' + 1}
376 370
377 val (pes, st) = ListUtil.foldlMap 371 val (e, st) = foldl (fn ((x, cn, NONE), (e, st)) =>
378 (fn ((_, cn, NONE), st) => 372 ("x==\"" ^ x ^ "\"?"
379 (((PCon (dk, PConVar cn, NONE), loc), 373 ^ (case dk of
380 case dk of 374 Option => "null"
381 Option => str loc "null" 375 | _ => Int.toString cn)
382 | _ => str loc (Int.toString cn)), 376 ^ ":" ^ e,
383 st) 377 st)
384 | ((_, cn, SOME t), st) => 378 | ((x, cn, SOME t), (e, st)) =>
385 let 379 let
386 val (e, st) = quoteExp loc t ((ERel 0, loc), st) 380 val (e', st) = unurlifyExp loc (t, st)
387 in 381 in
388 (((PCon (dk, PConVar cn, SOME (PVar ("x", t), loc)), loc), 382 ("x==\"" ^ x ^ "\"?"
389 case dk of 383 ^ (case dk of
390 Option => 384 Option =>
391 if isNullable t then 385 if isNullable t then
392 strcat loc [str loc "{_v:", 386 "{v:" ^ e' ^ "}"
393 e, 387 else
394 str loc "}"] 388 e'
395 else 389 | _ => "{n:" ^ Int.toString cn ^ ",v:" ^ e' ^ "}")
396 e 390 ^ ":" ^ e,
397 | _ => strcat loc [str loc ("{n:" ^ Int.toString cn
398 ^ ",v:"),
399 e,
400 str loc "}"]),
401 st) 391 st)
402 end) 392 end)
403 st cs 393 ("pf()", st) cs
404 394
405 val s = (TFfi ("Basis", "string"), loc) 395 val body = "function _n" ^ Int.toString n' ^ "(t,i){var x=t[i++];var r="
406 val body = (ECase ((ERel 0, loc), pes, 396 ^ e ^ ";return {_1:i,_2:r}}\n\n"
407 {disc = t, result = s}), loc) 397
408 val body = (EAbs ("x", t, s, body), loc) 398 val st = {decls = #decls st,
409 399 script = body :: #script st,
410 val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc),
411 body, "jsify")], loc) :: #decls st,
412 script = #script st,
413 included = #included st, 400 included = #included st,
414 injectors = #injectors st, 401 injectors = #injectors st,
402 decoders = #decoders st,
415 maxName = #maxName st} 403 maxName = #maxName st}
416 in 404 in
417 ((EApp ((ENamed n', loc), e), loc), st) 405 ("(tmp=_n" ^ Int.toString n' ^ "(t,i),i=tmp._1,tmp._2)", st)
418 end)*) 406 end)
419 407
420 | _ => (EM.errorAt loc "Don't know how to unurlify type in JavaScript"; 408 | _ => (EM.errorAt loc "Don't know how to unurlify type in JavaScript";
421 Print.prefaces "Can't unurlify" [("t", MonoPrint.p_typ MonoEnv.empty t)]; 409 Print.prefaces "Can't unurlify" [("t", MonoPrint.p_typ MonoEnv.empty t)];
422 ("ERROR", st)) 410 ("ERROR", st))
423 411
600 let 588 let
601 val st = {decls = #decls st, 589 val st = {decls = #decls st,
602 script = #script st, 590 script = #script st,
603 included = IS.add (#included st, n), 591 included = IS.add (#included st, n),
604 injectors = #injectors st, 592 injectors = #injectors st,
593 decoders = #decoders st,
605 maxName = #maxName st} 594 maxName = #maxName st}
606 595
607 val (e, st) = jsExp mode skip [] 0 (e, st) 596 val (e, st) = jsExp mode skip [] 0 (e, st)
608 val e = deStrcat 0 e 597 val e = deStrcat 0 e
609 598
611 in 600 in
612 {decls = #decls st, 601 {decls = #decls st,
613 script = sc :: #script st, 602 script = sc :: #script st,
614 included = #included st, 603 included = #included st,
615 injectors = #injectors st, 604 injectors = #injectors st,
605 decoders= #decoders st,
616 maxName = #maxName st} 606 maxName = #maxName st}
617 end 607 end
618 in 608 in
619 (str ("_n" ^ Int.toString n), st) 609 (str ("_n" ^ Int.toString n), st)
620 end 610 end
984 (List.revAppend (#decls st, [d]), 974 (List.revAppend (#decls st, [d]),
985 {decls = [], 975 {decls = [],
986 script = #script st, 976 script = #script st,
987 included = #included st, 977 included = #included st,
988 injectors = #injectors st, 978 injectors = #injectors st,
979 decoders = #decoders st,
989 maxName = #maxName st}) 980 maxName = #maxName st})
990 end 981 end
991 982
992 val (ds, st) = ListUtil.foldlMapConcat doDecl 983 val (ds, st) = ListUtil.foldlMapConcat doDecl
993 {decls = [], 984 {decls = [],
994 script = [], 985 script = [],
995 included = IS.empty, 986 included = IS.empty,
996 injectors = IM.empty, 987 injectors = IM.empty,
988 decoders = IM.empty,
997 maxName = U.File.maxName file + 1} 989 maxName = U.File.maxName file + 1}
998 file 990 file
999 991
1000 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"}) 992 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"})
1001 fun lines acc = 993 fun lines acc =