# HG changeset patch # User Adam Chlipala # Date 1301323069 14400 # Node ID 6e6f1643c4e9fd0be8080a5b0cec0cb5ce51c61a # Parent 0fc7b676b88bfc5d17ec554d8aa6e2b8d396ec64 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 diff -r 0fc7b676b88b -r 6e6f1643c4e9 src/jscomp.sml --- 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; diff -r 0fc7b676b88b -r 6e6f1643c4e9 src/mono_opt.sml --- 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), _), diff -r 0fc7b676b88b -r 6e6f1643c4e9 src/mono_reduce.sml --- 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