diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2014-03-17 16:52:10 -0400 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2014-03-17 16:52:10 -0400 |
| commit | d6a66b55f7f24bfbf144d00bce0a10b65930fb20 (patch) | |
| tree | b40bda48bf16d43a3b4ad3639de98562632fa23c /src | |
| parent | 2e3db71b6717f477ac24c4baa4fba1885cc55dad (diff) | |
-explainEmbed
Diffstat (limited to 'src')
| -rw-r--r-- | src/jscomp.sig | 4 | ||||
| -rw-r--r-- | src/jscomp.sml | 12 | ||||
| -rw-r--r-- | src/main.mlton.sml | 3 |
3 files changed, 18 insertions, 1 deletions
diff --git a/src/jscomp.sig b/src/jscomp.sig index 929c507d..5b8723b4 100644 --- a/src/jscomp.sig +++ b/src/jscomp.sig @@ -29,4 +29,8 @@ signature JSCOMP = sig val process : Mono.file -> Mono.file + val explainEmbed : bool ref + (* Output verbose error messages about inability to embed server-side + * values in client-side code? *) + end diff --git a/src/jscomp.sml b/src/jscomp.sml index 4a2c0365..bcabed0b 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -41,6 +41,8 @@ structure TM = BinaryMapFn(struct val compare = U.Typ.compare end) +val explainEmbed = ref false + type state = { decls : (string * int * (string * int * typ option) list) list, script : string list, @@ -267,7 +269,12 @@ fun process (file : file) = ((EApp ((ENamed n', loc), e), loc), st) end) - | _ => ((*Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)];*) + | _ => (if !explainEmbed then + Print.prefaces "Can't embed" [("loc", Print.PD.string (ErrorMsg.spanToString loc)), + ("e", MonoPrint.p_exp MonoEnv.empty e), + ("t", MonoPrint.p_typ MonoEnv.empty t)] + else + (); raise CantEmbed t) fun unurlifyExp loc (t : typ, st) = @@ -400,6 +407,9 @@ fun process (file : file) = fun jsE inner (e as (_, loc), st) = let + (*val () = Print.prefaces "jsExp" [("e", MonoPrint.p_exp MonoEnv.empty e), + ("loc", Print.PD.string (ErrorMsg.spanToString loc))]*) + val str = str loc fun patCon pc = diff --git a/src/main.mlton.sml b/src/main.mlton.sml index 71fefc48..bfc18e59 100644 --- a/src/main.mlton.sml +++ b/src/main.mlton.sml @@ -174,6 +174,9 @@ fun oneRun args = else Settings.addLimit (class, n); doArgs rest) + | "-explainEmbed" :: rest => + (JsComp.explainEmbed := true; + doArgs rest) | arg :: rest => (if size arg > 0 andalso String.sub (arg, 0) = #"-" then raise Fail ("Unknown flag " ^ arg) |