comparison src/jscomp.sml @ 1995:057b08253a75

-explainEmbed
author Adam Chlipala <adam@chlipala.net>
date Mon, 17 Mar 2014 16:52:10 -0400
parents 98895243b5b6
children 4d64af730e35
comparison
equal deleted inserted replaced
1994:94529780bbcf 1995:057b08253a75
38 38
39 structure TM = BinaryMapFn(struct 39 structure TM = BinaryMapFn(struct
40 type ord_key = typ 40 type ord_key = typ
41 val compare = U.Typ.compare 41 val compare = U.Typ.compare
42 end) 42 end)
43
44 val explainEmbed = ref false
43 45
44 type state = { 46 type state = {
45 decls : (string * int * (string * int * typ option) list) list, 47 decls : (string * int * (string * int * typ option) list) list,
46 script : string list, 48 script : string list,
47 included : IS.set, 49 included : IS.set,
265 maxName = #maxName st} 267 maxName = #maxName st}
266 in 268 in
267 ((EApp ((ENamed n', loc), e), loc), st) 269 ((EApp ((ENamed n', loc), e), loc), st)
268 end) 270 end)
269 271
270 | _ => ((*Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)];*) 272 | _ => (if !explainEmbed then
273 Print.prefaces "Can't embed" [("loc", Print.PD.string (ErrorMsg.spanToString loc)),
274 ("e", MonoPrint.p_exp MonoEnv.empty e),
275 ("t", MonoPrint.p_typ MonoEnv.empty t)]
276 else
277 ();
271 raise CantEmbed t) 278 raise CantEmbed t)
272 279
273 fun unurlifyExp loc (t : typ, st) = 280 fun unurlifyExp loc (t : typ, st) =
274 case #1 t of 281 case #1 t of
275 TRecord [] => ("(i++,null)", st) 282 TRecord [] => ("(i++,null)", st)
398 let 405 let
399 val len = length outer 406 val len = length outer
400 407
401 fun jsE inner (e as (_, loc), st) = 408 fun jsE inner (e as (_, loc), st) =
402 let 409 let
410 (*val () = Print.prefaces "jsExp" [("e", MonoPrint.p_exp MonoEnv.empty e),
411 ("loc", Print.PD.string (ErrorMsg.spanToString loc))]*)
412
403 val str = str loc 413 val str = str loc
404 414
405 fun patCon pc = 415 fun patCon pc =
406 case pc of 416 case pc of
407 PConVar n => str (Int.toString n) 417 PConVar n => str (Int.toString n)