Mercurial > urweb
changeset 1819:c9c38157d0d3
Merge
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Fri, 14 Sep 2012 06:44:14 -0400 |
| parents | e6ff36097cc4 148203744882 |
| children | 3c56aa6a0f55 |
| files | |
| diffstat | 7 files changed, 109 insertions(+), 39 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/manual.tex Wed Sep 12 19:49:02 2012 +0400 +++ b/doc/manual.tex Fri Sep 14 06:44:14 2012 -0400 @@ -140,6 +140,7 @@ \item \texttt{benignEffectful Module.ident} registers an FFI function or transaction as having side effects. The optimizer avoids removing, moving, or duplicating calls to such functions. Every effectful FFI function must be registered, or the optimizer may make invalid transformations. This version of the \texttt{effectful} directive registers that this function only has side effects that remain local to a single page generation. \item \texttt{clientOnly Module.ident} registers an FFI function or transaction that may only be run in client browsers. \item \texttt{clientToServer Module.ident} adds FFI type \texttt{Module.ident} to the list of types that are OK to marshal from clients to servers. Values like XML trees and SQL queries are hard to marshal without introducing expensive validity checks, so it's easier to ensure that the server never trusts clients to send such values. The file \texttt{include/urweb.h} shows examples of the C support functions that are required of any type that may be marshalled. These include \texttt{attrify}, \texttt{urlify}, and \texttt{unurlify} functions. +\item \texttt{coreInline TREESIZE} sets how many nodes the AST of a function definition may have before the optimizer stops trying hard to inline calls to that function. (This is one of two options for one of two intermediate languages within the compiler.) \item \texttt{database DBSTRING} sets the string to pass to libpq to open a database connection. \item \texttt{debug} saves some intermediate C files, which is mostly useful to help in debugging the compiler itself. \item \texttt{effectful Module.ident} registers an FFI function or transaction as having side effects. The optimizer avoids removing, moving, or duplicating calls to such functions. Every effectful FFI function must be registered, or the optimizer may make invalid transformations. (Note that merely assigning a function a \texttt{transaction}-based type does not mark it as effectful in this way!) @@ -167,6 +168,7 @@ \item \texttt{link FILENAME} adds \texttt{FILENAME} to the list of files to be passed to the linker at the end of compilation. This is most useful for importing extra libraries needed by new FFI modules. \item \texttt{linker CMD} sets \texttt{CMD} as the command line prefix to use for linking C object files. The command line will be completed with a space-separated list of \texttt{.o} and \texttt{.a} files, \texttt{-L} and \texttt{-l} flags, and finally with a \texttt{-o} flag to set the location where the executable should be written. \item \texttt{minHeap NUMBYTES} sets the initial size for thread-local heaps used in handling requests. These heaps grow automatically as needed (up to any maximum set with \texttt{limit}), but each regrow requires restarting the request handling process. +\item \texttt{monoInline TREESIZE} sets how many nodes the AST of a function definition may have before the optimizer stops trying hard to inline calls to that function. (This is one of two options for one of two intermediate languages within the compiler.) \item \texttt{noXsrfProtection URIPREFIX} turns off automatic cross-site request forgery protection for the page handler identified by the given URI prefix. This will avoid checking cryptographic signatures on cookies, which is generally a reasonable idea for some pages, such as login pages that are going to discard all old cookie values, anyway. \item \texttt{onError Module.var} changes the handling of fatal application errors. Instead of displaying a default, ugly error 500 page, the error page will be generated by calling function \texttt{Module.var} on a piece of XML representing the error message. The error handler should have type $\mt{xbody} \to \mt{transaction} \; \mt{page}$. Note that the error handler \emph{cannot} be in the application's main module, since that would register it as explicitly callable via URLs. \item \texttt{path NAME=VALUE} creates a mapping from \texttt{NAME} to \texttt{VALUE}. This mapping may be used at the beginnings of filesystem paths given to various other configuration directives. A path like \texttt{\$NAME/rest} is expanded to \texttt{VALUE/rest}. There is an initial mapping from the empty name (for paths like \texttt{\$/list}) to the directory where the Ur/Web standard library is installed. If you accept the default \texttt{configure} options, this directory is \texttt{/usr/local/lib/urweb/ur}.
--- a/src/compiler.sml Wed Sep 12 19:49:02 2012 +0400 +++ b/src/compiler.sml Fri Sep 14 06:44:14 2012 -0400 @@ -853,6 +853,14 @@ (case Int.fromString arg of NONE => ErrorMsg.error ("invalid min heap '" ^ arg ^ "'") | SOME n => minHeap := n) + | "coreInline" => + (case Int.fromString arg of + NONE => ErrorMsg.error ("invalid core inline level '" ^ arg ^ "'") + | SOME n => Settings.setCoreInline n) + | "monoInline" => + (case Int.fromString arg of + NONE => ErrorMsg.error ("invalid mono inline level '" ^ arg ^ "'") + | SOME n => Settings.setMonoInline n) | "alwaysInline" => Settings.addAlwaysInline arg | "noXsrfProtection" => Settings.addNoXsrfProtection arg | "timeFormat" => Settings.setTimeFormat arg
--- a/src/especialize.sml Wed Sep 12 19:49:02 2012 +0400 +++ b/src/especialize.sml Fri Sep 14 06:44:14 2012 -0400 @@ -124,6 +124,7 @@ val functionInside = U.Con.exists {kind = fn _ => false, con = fn TFun _ => true + | TCFun _ => true | CFfi ("Basis", "transaction") => true | CFfi ("Basis", "eq") => true | CFfi ("Basis", "num") => true
--- a/src/mono_reduce.sml Wed Sep 12 19:49:02 2012 +0400 +++ b/src/mono_reduce.sml Fri Sep 14 06:44:14 2012 -0400 @@ -179,12 +179,12 @@ bind = fn ((lower, len), U.Exp.RelE _) => (lower+1, len) | (st, _) => st} -datatype result = Yes of exp list | No | Maybe +datatype result = Yes of (string * typ * exp) list | No | Maybe fun match (env, p : pat, e : exp) = case (#1 p, #1 e) of (PWild, _) => Yes env - | (PVar (x, t), _) => Yes (e :: env) + | (PVar (x, t), _) => Yes ((x, t, e) :: env) | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) => if String.isPrefix s' s then @@ -519,6 +519,17 @@ fun doLet (x, t, e', b) = let + val notValue = U.Exp.exists {typ = fn _ => false, + exp = fn e => + case e of + EPrim _ => false + | ECon _ => false + | ENone _ => false + | ESome _ => false + | ERecord _ => false + | _ => true} + + fun doSub () = let val r = subExpInExp (0, e') b @@ -597,6 +608,8 @@ else e end + else if countFree 0 0 b > 1 andalso notValue e' then + e else trySub () end @@ -659,8 +672,11 @@ | Yes subs => let val (body, remaining) = - foldl (fn (e, (body, remaining)) => - (subExpInExp (0, multiLift remaining e) body, remaining - 1)) + foldl (fn ((x, t, e), (body, remaining)) => + (if countFree 0 0 body > 1 then + (ELet (x, t, multiLift remaining e, body), #2 e') + else + subExpInExp (0, multiLift remaining e) body, remaining - 1)) (body, length subs - 1) subs val r = reduceExp (E.patBinds env p) body in
--- a/src/monoize.sml Wed Sep 12 19:49:02 2012 +0400 +++ b/src/monoize.sml Fri Sep 14 06:44:14 2012 -0400 @@ -3263,29 +3263,29 @@ val t = (L'.TFfi ("Basis", "string"), loc) val s = (L'.EPrim (Prim.String (String.concat ["<", tag'])), loc) - val s = (L'.ECase (class, - [((L'.PPrim (Prim.String ""), loc), - s), - ((L'.PVar ("x", t), loc), - (L'.EStrcat (s, - (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc), - (L'.EStrcat ((L'.ERel 0, loc), - (L'.EPrim (Prim.String "\""), loc)), - loc)), loc)), loc))], - {disc = t, - result = t}), loc) - - val s = (L'.ECase (style, - [((L'.PPrim (Prim.String ""), loc), - s), - ((L'.PVar ("x", t), loc), - (L'.EStrcat (s, - (L'.EStrcat ((L'.EPrim (Prim.String " style=\""), loc), - (L'.EStrcat ((L'.ERel 0, loc), - (L'.EPrim (Prim.String "\""), loc)), - loc)), loc)), loc))], - {disc = t, - result = t}), loc) + val s = (L'.EStrcat (s, + (L'.ECase (class, + [((L'.PPrim (Prim.String ""), loc), + (L'.EPrim (Prim.String ""), loc)), + ((L'.PVar ("x", t), loc), + (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc), + (L'.EStrcat ((L'.ERel 0, loc), + (L'.EPrim (Prim.String "\""), loc)), + loc)), loc))], + {disc = t, + result = t}), loc)), loc) + + val s = (L'.EStrcat (s, + (L'.ECase (style, + [((L'.PPrim (Prim.String ""), loc), + (L'.EPrim (Prim.String ""), loc)), + ((L'.PVar ("x", t), loc), + (L'.EStrcat ((L'.EPrim (Prim.String " style=\""), loc), + (L'.EStrcat ((L'.ERel 0, loc), + (L'.EPrim (Prim.String "\""), loc)), + loc)), loc))], + {disc = t, + result = t}), loc)), loc) val (s, fm) = foldl (fn (("Action", _, _), acc) => acc | (("Source", _, _), acc) => acc
--- a/src/reduce.sml Wed Sep 12 19:49:02 2012 +0400 +++ b/src/reduce.sml Fri Sep 14 06:44:14 2012 -0400 @@ -232,6 +232,21 @@ ((CName "Bind", loc), bindType m loc)]), loc), loc) +fun passive (e : exp) = + case #1 e of + EPrim _ => true + | ERel _ => true + | ENamed _ => true + | ECon (_, _, _, NONE) => true + | ECon (_, _, _, SOME e) => passive e + | EFfi _ => true + | EAbs _ => true + | ECAbs _ => true + | EKAbs _ => true + | ERecord xes => List.all (passive o #2) xes + | EField (e, _, _) => passive e + | _ => false + fun kindConAndExp (namedC, namedE) = let fun kind env (all as (k, loc)) = @@ -534,16 +549,30 @@ val e2 = exp env e2 in case #1 e1 of - EAbs (_, _, _, b) => - let - val r = exp (KnownE e2 :: env') b - in - (*Print.prefaces "eapp" [("b", CorePrint.p_exp CoreEnv.empty b), - ("env", Print.PD.string (e2s env')), - ("e2", CorePrint.p_exp CoreEnv.empty e2), - ("r", CorePrint.p_exp CoreEnv.empty r)];*) - r - end + ELet (x, t, e1', e2') => + (ELet (x, t, e1', exp (UnknownE :: env') (EApp (e2', E.liftExpInExp 0 e2), loc)), loc) + + | EAbs (x, dom, _, b) => + if count b <= 1 orelse passive e2 orelse ESpecialize.functionInside dom then + let + val r = exp (KnownE e2 :: env') b + in + (*Print.prefaces "eapp" [("b", CorePrint.p_exp CoreEnv.empty b), + ("env", Print.PD.string (e2s env')), + ("e2", CorePrint.p_exp CoreEnv.empty e2), + ("r", CorePrint.p_exp CoreEnv.empty r)];*) + r + end + else + let + val dom = con env' dom + val r = exp (UnknownE :: env') b + in + (*Print.prefaces "El skippo" [("x", Print.PD.string x), + ("e2", CorePrint.p_exp CoreEnv.empty e2)];*) + (ELet (x, dom, e2, r), loc) + end + | ECase (e, pes, cc as {disc, result = res as (TFun (_, c2), _)}) => let val pes' = map (fn (p, body) => @@ -760,12 +789,14 @@ | ELet (x, t, e1, e2) => let + val e1' = exp env e1 + val t = con env t in - if ESpecialize.functionInside t then + if passive e1' orelse count e2 <= 1 orelse ESpecialize.functionInside t then exp (KnownE e1 :: env) e2 else - (ELet (x, t, exp env e1, exp (UnknownE :: env) e2), loc) + (ELet (x, t, e1', exp (UnknownE :: env) e2), loc) end | EServerCall (n, es, t) => (EServerCall (n, map (exp env) es, con env t), loc)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/badInline.ur Fri Sep 14 06:44:14 2012 -0400 @@ -0,0 +1,12 @@ +style s1 +style s2 +style s3 + +fun ifClass r cls c = if r then classes cls c else c + +fun main (n : int) : transaction page = return <xml><body> + <p class={ifClass (n = 0) s1 + (ifClass (n = 1) s2 + (ifClass (n = 2) s3 + null))}>Hi</p> +</body></xml>