# HG changeset patch # User Adam Chlipala # Date 1347619454 14400 # Node ID c9c38157d0d34c9e90088621ffe3c8019eee59b3 # Parent e6ff36097cc4c646ad5cf5e75bb0d369cd14d9ac# Parent 148203744882648b0d25ae2e493e57749bcd3f59 Merge diff -r e6ff36097cc4 -r c9c38157d0d3 doc/manual.tex --- 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}. diff -r e6ff36097cc4 -r c9c38157d0d3 src/compiler.sml --- 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 diff -r e6ff36097cc4 -r c9c38157d0d3 src/especialize.sml --- 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 diff -r e6ff36097cc4 -r c9c38157d0d3 src/mono_reduce.sml --- 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 diff -r e6ff36097cc4 -r c9c38157d0d3 src/monoize.sml --- 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 diff -r e6ff36097cc4 -r c9c38157d0d3 src/reduce.sml --- 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) diff -r e6ff36097cc4 -r c9c38157d0d3 tests/badInline.ur --- /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 +

Hi

+