Mercurial > urweb
changeset 1445:6e6f1643c4e9
To generate server-side source JavaScript, try both the old and new strategies; remove an unsound optimization from MonoOpt and make MonoReduce work harder to compensate
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Mon, 28 Mar 2011 10:37:49 -0400 |
| parents | 0fc7b676b88b |
| children | 36f7d1debb37 |
| files | src/jscomp.sml src/mono_opt.sml src/mono_reduce.sml |
| diffstat | 3 files changed, 9 insertions(+), 20 deletions(-) [+] |
line wrap: on
line diff
--- a/src/jscomp.sml Sun Mar 27 15:51:37 2011 -0400 +++ b/src/jscomp.sml Mon Mar 28 10:37:49 2011 -0400 @@ -1194,10 +1194,12 @@ in ((ELet ("x", t, e', x'), loc), st) end - handle CantEmbed t => ((*ErrorMsg.errorAt loc "Unable to embed type in JavaScript"; - Print.preface ("Type", - MonoPrint.p_typ MonoEnv.empty t);*) - (e, st))) + handle CantEmbed _ => + (jsExp m outer (e', st) + handle CantEmbed t => ((*ErrorMsg.errorAt loc "Unable to embed type in JavaScript"; + Print.preface ("Type", + MonoPrint.p_typ MonoEnv.empty t);*) + (e, st)))) | EJavaScript (m, e') => (foundJavaScript := true;
--- a/src/mono_opt.sml Sun Mar 27 15:51:37 2011 -0400 +++ b/src/mono_opt.sml Mon Mar 28 10:37:49 2011 -0400 @@ -357,22 +357,6 @@ result = ran}), loc) end - | ECase (discE, pes, {disc, result = (TFun (dom, ran), loc)}) => - let - fun doBody (p, e) = - let - val pb = MonoEnv.patBindsN p - in - (EApp (MonoEnv.liftExpInExp pb e, (ERel pb, loc)), loc) - end - in - EAbs ("x", dom, ran, - (optExp (ECase (MonoEnv.liftExpInExp 0 discE, - map (fn (p, e) => (p, doBody (p, e))) pes, - {disc = disc, - result = ran}), loc), loc)) - end - | EWrite (EQuery {exps, tables, state, query, initial = (EPrim (Prim.String ""), _), body = (EStrcat ((EPrim (Prim.String s), _),
--- a/src/mono_reduce.sml Sun Mar 27 15:51:37 2011 -0400 +++ b/src/mono_reduce.sml Mon Mar 28 10:37:49 2011 -0400 @@ -635,6 +635,7 @@ fun safe (e, _) = case e of EAbs _ => true + | EError _ => true | _ => false in if List.all (safe o #2) pes then @@ -642,6 +643,8 @@ (ECase (liftExpInExp 0 e', map (fn (p, (EAbs (_, _, _, e), _)) => (p, swapExpVarsPat (0, patBinds p) e) + | (p, (EError (e, (TFun (_, t), _)), loc)) => + (p, (EError (e, t), loc)) | _ => raise Fail "MonoReduce ECase") pes, {disc = disc, result = result}), loc)) else