Improving/reordering Unpoly and Especialize; pathmaps

6 files changed, 443 insertions, 342 deletions

diff --git a/src/compiler.sig b/src/compiler.sig
index 276cb4f2..2f062622 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -77,7 +77,6 @@ signature COMPILER = sig
     val termination : (Elab.file, Elab.file) phase
     val explify : (Elab.file, Expl.file) phase
     val corify : (Expl.file, Core.file) phase
-    val especialize : (Core.file, Core.file) phase
     val core_untangle : (Core.file, Core.file) phase
     val shake : (Core.file, Core.file) phase
     val rpcify : (Core.file, Core.file) phase
@@ -107,7 +106,6 @@ signature COMPILER = sig
     val toTermination : (string, Elab.file) transform
     val toExplify : (string, Expl.file) transform
     val toCorify : (string, Core.file) transform
-    val toEspecialize : (string, Core.file) transform 
     val toCore_untangle : (string, Core.file) transform
     val toShake1 : (string, Core.file) transform
     val toRpcify : (string, Core.file) transform
@@ -118,6 +116,8 @@ signature COMPILER = sig
     val toUnpoly : (string, Core.file) transform 
     val toSpecialize : (string, Core.file) transform 
     val toShake3 : (string, Core.file) transform
+    val toEspecialize : (string, Core.file) transform 
+    val toShake4 : (string, Core.file) transform
     val toMarshalcheck : (string, Core.file) transform
     val toEffectize : (string, Core.file) transform
     val toMonoize : (string, Mono.file) transform
diff --git a/src/compiler.sml b/src/compiler.sml
index f47812ed..b0dfe387 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -267,276 +267,313 @@ fun trim s =
         s
     end
 
-fun parseUrp' filename =
+structure M = BinaryMapFn(struct
+                          type ord_key = string
+                          val compare = String.compare
+                          end)
+
+fun parseUrp' fname =
     let
-        val dir = OS.Path.dir filename
-        val inf = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
+        val pathmap = ref (M.insert (M.empty, "", Config.libUr))
 
-        fun relify fname =
-            OS.Path.concat (dir, fname)
-            handle OS.Path.Path => fname
+        fun pu filename =
+            let
+                val dir = OS.Path.dir filename
+                val inf = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
 
-        val absDir = OS.Path.mkAbsolute {path = dir, relativeTo = OS.FileSys.getDir ()}
+                fun pathify fname =
+                    if size fname > 0 andalso String.sub (fname, 0) = #"$" then
+                        let
+                            val fname' = Substring.extract (fname, 1, NONE)
+                            val (befor, after) = Substring.splitl (fn ch => ch <> #"/") fname'
+                        in
+                            if Substring.isEmpty after then
+                                fname
+                            else
+                                case M.find (!pathmap, Substring.string befor) of
+                                    NONE => fname
+                                  | SOME rep => rep ^ Substring.string after
+                        end
+                    else
+                        fname
+
+                fun relify fname =
+                    let
+                        val fname = pathify fname
+                    in
+                        OS.Path.concat (dir, fname)
+                        handle OS.Path.Path => fname
+                    end
 
-        fun relifyA fname = OS.Path.mkAbsolute {path = fname, relativeTo = absDir}
+                val absDir = OS.Path.mkAbsolute {path = dir, relativeTo = OS.FileSys.getDir ()}
 
-        fun readSources acc =
-            case TextIO.inputLine inf of
-                NONE => rev acc
-              | SOME line =>
-                let
-                    val acc = if CharVector.all Char.isSpace line then
-                                  acc
-                              else
-                                  let
-                                      val fname = String.implode (List.filter (fn x => not (Char.isSpace x))
-                                                                              (String.explode line))
-                                      val fname = relify fname
-                                  in
-                                      fname :: acc
-                                  end
-                in
-                    readSources acc
-                end
-
-        val prefix = ref NONE
-        val database = ref NONE
-        val exe = ref NONE
-        val sql = ref NONE
-        val debug = ref false
-        val profile = ref false
-        val timeout = ref NONE
-        val ffi = ref []
-        val link = ref []
-        val headers = ref []
-        val scripts = ref []
-        val clientToServer = ref []
-        val effectful = ref []
-        val clientOnly = ref []
-        val serverOnly = ref []
-        val jsFuncs = ref []
-        val rewrites = ref []
-        val url = ref []
-        val mime = ref []
-        val libs = ref []
-
-        fun finish sources =
-            let
-                val job = {
-                    prefix = Option.getOpt (!prefix, "/"),
-                    database = !database,
-                    exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
-                                                                    ext = SOME "exe"}),
-                    sql = !sql,
-                    debug = !debug,
-                    profile = !profile,
-                    timeout = Option.getOpt (!timeout, 60),
-                    ffi = rev (!ffi),
-                    link = rev (!link),
-                    headers = rev (!headers),
-                    scripts = rev (!scripts),
-                    clientToServer = rev (!clientToServer),
-                    effectful = rev (!effectful),
-                    clientOnly = rev (!clientOnly),
-                    serverOnly = rev (!serverOnly),
-                    jsFuncs = rev (!jsFuncs),
-                    rewrites = rev (!rewrites),
-                    filterUrl = rev (!url),
-                    filterMime = rev (!mime),
-                    sources = sources
-                }
-
-                fun mergeO f (old, new) =
-                    case (old, new) of
-                        (NONE, _) => new
-                      | (_, NONE) => old
-                      | (SOME v1, SOME v2) => SOME (f (v1, v2))
-
-                fun same desc = mergeO (fn (x : string, y) =>
-                                           (if x = y then
-                                                ()
-                                            else
-                                                ErrorMsg.error ("Multiple "
-                                                                ^ desc ^ " values that don't agree");
-                                            x))
-
-                fun merge (old : job, new : job) = {
-                    prefix = #prefix old,
-                    database = #database old,
-                    exe = #exe old,
-                    sql = #sql old,
-                    debug = #debug old orelse #debug new,
-                    profile = #profile old orelse #profile new,
-                    timeout = #timeout old,
-                    ffi = #ffi old @ #ffi new,
-                    link = #link old @ #link new,
-                    headers = #headers old @ #headers new,
-                    scripts = #scripts old @ #scripts new,
-                    clientToServer = #clientToServer old @ #clientToServer new,
-                    effectful = #effectful old @ #effectful new,
-                    clientOnly = #clientOnly old @ #clientOnly new,
-                    serverOnly = #serverOnly old @ #serverOnly new,
-                    jsFuncs = #jsFuncs old @ #jsFuncs new,
-                    rewrites = #rewrites old @ #rewrites new,
-                    filterUrl = #filterUrl old @ #filterUrl new,
-                    filterMime = #filterMime old @ #filterMime new,
-                    sources = #sources new @ #sources old
-                }
-            in
-                foldr (fn (fname, job) => merge (job, parseUrp' fname)) job (!libs)
-            end
+                fun relifyA fname =
+                    OS.Path.mkAbsolute {path = pathify fname, relativeTo = absDir}
 
-        fun parsePkind s =
-            case s of
-                "all" => Settings.Any
-              | "url" => Settings.Url
-              | "table" => Settings.Table
-              | "sequence" => Settings.Sequence
-              | "view" => Settings.View
-              | "relation" => Settings.Relation
-              | "cookie" => Settings.Cookie
-              | "style" => Settings.Style
-              | _ => (ErrorMsg.error "Bad path kind spec";
-                      Settings.Any)
-
-        fun parseFrom s =
-            if size s > 1 andalso String.sub (s, size s - 2) = #"/" andalso String.sub (s, size s - 1) = #"*" then
-                (Settings.Prefix, String.substring (s, 0, size s - 1))
-            else
-                (Settings.Exact, s)
-
-        fun parseFkind s =
-            case s of
-                "url" => url
-              | "mime" => mime
-              | _ => (ErrorMsg.error "Bad filter kind";
-                      url)
-
-        fun parsePattern s =
-            if size s > 0 andalso String.sub (s, size s - 1) = #"*" then
-                (Settings.Prefix, String.substring (s, 0, size s - 1))
-            else
-                (Settings.Exact, s)
-
-        fun read () =
-            case TextIO.inputLine inf of
-                NONE => finish []
-              | SOME "\n" => finish (readSources [])
-              | SOME line =>
-                let
-                    val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
-                    val cmd = Substring.string (trim cmd)
-                    val arg = Substring.string (trim arg)
-
-                    fun ffiS () =
-                        case String.fields (fn ch => ch = #".") arg of
-                            [m, x] => (m, x)
-                          | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func");
-                                  ("", ""))
-
-                    fun ffiM () =
-                        case String.fields (fn ch => ch = #"=") arg of
-                            [f, s] =>
-                            (case String.fields (fn ch => ch = #".") f of
-                                 [m, x] => ((m, x), s)
-                               | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
-                                       (("", ""), "")))
-                          | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
-                                  (("", ""), ""))
-                in
-                    case cmd of
-                        "prefix" =>
-                        (case !prefix of
-                             NONE => ()
-                           | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive";
-                         prefix := SOME arg)
-                      | "database" =>
-                        (case !database of
-                             NONE => ()
-                           | SOME _ => ErrorMsg.error "Duplicate 'database' directive";
-                         database := SOME arg)
-                      | "exe" =>
-                        (case !exe of
-                             NONE => ()
-                           | SOME _ => ErrorMsg.error "Duplicate 'exe' directive";
-                         exe := SOME (relify arg))
-                      | "sql" =>
-                        (case !sql of
-                             NONE => ()
-                           | SOME _ => ErrorMsg.error "Duplicate 'sql' directive";
-                         sql := SOME (relify arg))
-                      | "debug" => debug := true
-                      | "profile" => profile := true
-                      | "timeout" =>
-                        (case !timeout of
-                             NONE => ()
-                           | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
-                         timeout := SOME (valOf (Int.fromString arg)))
-                      | "ffi" => ffi := relify arg :: !ffi
-                      | "link" => link := relifyA arg :: !link
-                      | "include" => headers := relifyA arg :: !headers
-                      | "script" => scripts := arg :: !scripts
-                      | "clientToServer" => clientToServer := ffiS () :: !clientToServer
-                      | "effectful" => effectful := ffiS () :: !effectful
-                      | "clientOnly" => clientOnly := ffiS () :: !clientOnly
-                      | "serverOnly" => serverOnly := ffiS () :: !serverOnly
-                      | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
-                      | "rewrite" =>
+                fun readSources acc =
+                    case TextIO.inputLine inf of
+                        NONE => rev acc
+                      | SOME line =>
                         let
-                            fun doit (pkind, from, to) =
+                            val acc = if CharVector.all Char.isSpace line then
+                                          acc
+                                      else
+                                          let
+                                              val fname = String.implode (List.filter (fn x => not (Char.isSpace x))
+                                                                                      (String.explode line))
+                                              val fname = relify fname
+                                          in
+                                              fname :: acc
+                                          end
+                        in
+                            readSources acc
+                        end
+
+                val prefix = ref NONE
+                val database = ref NONE
+                val exe = ref NONE
+                val sql = ref NONE
+                val debug = ref false
+                val profile = ref false
+                val timeout = ref NONE
+                val ffi = ref []
+                val link = ref []
+                val headers = ref []
+                val scripts = ref []
+                val clientToServer = ref []
+                val effectful = ref []
+                val clientOnly = ref []
+                val serverOnly = ref []
+                val jsFuncs = ref []
+                val rewrites = ref []
+                val url = ref []
+                val mime = ref []
+                val libs = ref []
+
+                fun finish sources =
+                    let
+                        val job = {
+                            prefix = Option.getOpt (!prefix, "/"),
+                            database = !database,
+                            exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
+                                                                            ext = SOME "exe"}),
+                            sql = !sql,
+                            debug = !debug,
+                            profile = !profile,
+                            timeout = Option.getOpt (!timeout, 60),
+                            ffi = rev (!ffi),
+                            link = rev (!link),
+                            headers = rev (!headers),
+                            scripts = rev (!scripts),
+                            clientToServer = rev (!clientToServer),
+                            effectful = rev (!effectful),
+                            clientOnly = rev (!clientOnly),
+                            serverOnly = rev (!serverOnly),
+                            jsFuncs = rev (!jsFuncs),
+                            rewrites = rev (!rewrites),
+                            filterUrl = rev (!url),
+                            filterMime = rev (!mime),
+                            sources = sources
+                        }
+
+                        fun mergeO f (old, new) =
+                            case (old, new) of
+                                (NONE, _) => new
+                              | (_, NONE) => old
+                              | (SOME v1, SOME v2) => SOME (f (v1, v2))
+
+                        fun same desc = mergeO (fn (x : string, y) =>
+                                                   (if x = y then
+                                                        ()
+                                                    else
+                                                        ErrorMsg.error ("Multiple "
+                                                                        ^ desc ^ " values that don't agree");
+                                                    x))
+
+                        fun merge (old : job, new : job) = {
+                            prefix = #prefix old,
+                            database = #database old,
+                            exe = #exe old,
+                            sql = #sql old,
+                            debug = #debug old orelse #debug new,
+                            profile = #profile old orelse #profile new,
+                            timeout = #timeout old,
+                            ffi = #ffi old @ #ffi new,
+                            link = #link old @ #link new,
+                            headers = #headers old @ #headers new,
+                            scripts = #scripts old @ #scripts new,
+                            clientToServer = #clientToServer old @ #clientToServer new,
+                            effectful = #effectful old @ #effectful new,
+                            clientOnly = #clientOnly old @ #clientOnly new,
+                            serverOnly = #serverOnly old @ #serverOnly new,
+                            jsFuncs = #jsFuncs old @ #jsFuncs new,
+                            rewrites = #rewrites old @ #rewrites new,
+                            filterUrl = #filterUrl old @ #filterUrl new,
+                            filterMime = #filterMime old @ #filterMime new,
+                            sources = #sources new @ #sources old
+                        }
+                    in
+                        foldr (fn (fname, job) => merge (job, parseUrp' fname)) job (!libs)
+                    end
+
+                fun parsePkind s =
+                    case s of
+                        "all" => Settings.Any
+                      | "url" => Settings.Url
+                      | "table" => Settings.Table
+                      | "sequence" => Settings.Sequence
+                      | "view" => Settings.View
+                      | "relation" => Settings.Relation
+                      | "cookie" => Settings.Cookie
+                      | "style" => Settings.Style
+                      | _ => (ErrorMsg.error "Bad path kind spec";
+                              Settings.Any)
+
+                fun parseFrom s =
+                    if size s > 1 andalso String.sub (s, size s - 2) = #"/" andalso String.sub (s, size s - 1) = #"*" then
+                        (Settings.Prefix, String.substring (s, 0, size s - 1))
+                    else
+                        (Settings.Exact, s)
+
+                fun parseFkind s =
+                    case s of
+                        "url" => url
+                      | "mime" => mime
+                      | _ => (ErrorMsg.error "Bad filter kind";
+                              url)
+
+                fun parsePattern s =
+                    if size s > 0 andalso String.sub (s, size s - 1) = #"*" then
+                        (Settings.Prefix, String.substring (s, 0, size s - 1))
+                    else
+                        (Settings.Exact, s)
+
+                fun read () =
+                    case TextIO.inputLine inf of
+                        NONE => finish []
+                      | SOME "\n" => finish (readSources [])
+                      | SOME line =>
+                        let
+                            val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
+                            val cmd = Substring.string (trim cmd)
+                            val arg = Substring.string (trim arg)
+
+                            fun ffiS () =
+                                case String.fields (fn ch => ch = #".") arg of
+                                    [m, x] => (m, x)
+                                  | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func");
+                                          ("", ""))
+
+                            fun ffiM () =
+                                case String.fields (fn ch => ch = #"=") arg of
+                                    [f, s] =>
+                                    (case String.fields (fn ch => ch = #".") f of
+                                         [m, x] => ((m, x), s)
+                                       | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
+                                               (("", ""), "")))
+                                  | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
+                                          (("", ""), ""))
+                        in
+                            case cmd of
+                                "prefix" =>
+                                (case !prefix of
+                                     NONE => ()
+                                   | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive";
+                                 prefix := SOME arg)
+                              | "database" =>
+                                (case !database of
+                                     NONE => ()
+                                   | SOME _ => ErrorMsg.error "Duplicate 'database' directive";
+                                 database := SOME arg)
+                              | "exe" =>
+                                (case !exe of
+                                     NONE => ()
+                                   | SOME _ => ErrorMsg.error "Duplicate 'exe' directive";
+                                 exe := SOME (relify arg))
+                              | "sql" =>
+                                (case !sql of
+                                     NONE => ()
+                                   | SOME _ => ErrorMsg.error "Duplicate 'sql' directive";
+                                 sql := SOME (relify arg))
+                              | "debug" => debug := true
+                              | "profile" => profile := true
+                              | "timeout" =>
+                                (case !timeout of
+                                     NONE => ()
+                                   | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
+                                 timeout := SOME (valOf (Int.fromString arg)))
+                              | "ffi" => ffi := relify arg :: !ffi
+                              | "link" => link := relifyA arg :: !link
+                              | "include" => headers := relifyA arg :: !headers
+                              | "script" => scripts := arg :: !scripts
+                              | "clientToServer" => clientToServer := ffiS () :: !clientToServer
+                              | "effectful" => effectful := ffiS () :: !effectful
+                              | "clientOnly" => clientOnly := ffiS () :: !clientOnly
+                              | "serverOnly" => serverOnly := ffiS () :: !serverOnly
+                              | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
+                              | "rewrite" =>
                                 let
-                                    val pkind = parsePkind pkind
-                                    val (kind, from) = parseFrom from
+                                    fun doit (pkind, from, to) =
+                                        let
+                                            val pkind = parsePkind pkind
+                                            val (kind, from) = parseFrom from
+                                        in
+                                            rewrites := {pkind = pkind, kind = kind, from = from, to = to} :: !rewrites
+                                        end
                                 in
-                                    rewrites := {pkind = pkind, kind = kind, from = from, to = to} :: !rewrites
+                                    case String.tokens Char.isSpace arg of
+                                        [pkind, from, to] => doit (pkind, from, to)
+                                      | [pkind, from] => doit (pkind, from, "")
+                                      | _ => ErrorMsg.error "Bad 'rewrite' syntax"
                                 end
-                        in
-                            case String.tokens Char.isSpace arg of
-                                [pkind, from, to] => doit (pkind, from, to)
-                              | [pkind, from] => doit (pkind, from, "")
-                              | _ => ErrorMsg.error "Bad 'rewrite' syntax"
+                              | "allow" =>
+                                (case String.tokens Char.isSpace arg of
+                                     [fkind, pattern] =>
+                                     let
+                                         val fkind = parseFkind fkind
+                                         val (kind, pattern) = parsePattern pattern
+                                     in
+                                         fkind := {action = Settings.Allow, kind = kind, pattern = pattern} :: !fkind
+                                     end
+                                   | _ => ErrorMsg.error "Bad 'allow' syntax")
+                              | "deny" =>
+                                (case String.tokens Char.isSpace arg of
+                                     [fkind, pattern] =>
+                                     let
+                                         val fkind = parseFkind fkind
+                                         val (kind, pattern) = parsePattern pattern
+                                     in
+                                         fkind := {action = Settings.Deny, kind = kind, pattern = pattern} :: !fkind
+                                     end
+                                   | _ => ErrorMsg.error "Bad 'deny' syntax")
+                              | "library" => libs := relify arg :: !libs
+                              | "path" =>
+                                (case String.fields (fn ch => ch = #"=") arg of
+                                     [n, v] => pathmap := M.insert (!pathmap, n, v)
+                                   | _ => ErrorMsg.error "path argument not of the form name=value'")
+                              | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
+                            read ()
                         end
-                      | "allow" =>
-                        (case String.tokens Char.isSpace arg of
-                             [fkind, pattern] =>
-                             let
-                                 val fkind = parseFkind fkind
-                                 val (kind, pattern) = parsePattern pattern
-                             in
-                                 fkind := {action = Settings.Allow, kind = kind, pattern = pattern} :: !fkind
-                             end
-                           | _ => ErrorMsg.error "Bad 'allow' syntax")
-                      | "deny" =>
-                        (case String.tokens Char.isSpace arg of
-                             [fkind, pattern] =>
-                             let
-                                 val fkind = parseFkind fkind
-                                 val (kind, pattern) = parsePattern pattern
-                             in
-                                 fkind := {action = Settings.Deny, kind = kind, pattern = pattern} :: !fkind
-                             end
-                           | _ => ErrorMsg.error "Bad 'deny' syntax")
-                      | "library" => libs := relify arg :: !libs
-                      | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
-                    read ()
-                end
-
-        val job = read ()
+
+                val job = read ()
+            in
+                TextIO.closeIn inf;
+                Settings.setUrlPrefix (#prefix job);
+                Settings.setTimeout (#timeout job);
+                Settings.setHeaders (#headers job);
+                Settings.setScripts (#scripts job);
+                Settings.setClientToServer (#clientToServer job);
+                Settings.setEffectful (#effectful job);
+                Settings.setClientOnly (#clientOnly job);
+                Settings.setServerOnly (#serverOnly job);
+                Settings.setJsFuncs (#jsFuncs job);
+                Settings.setRewriteRules (#rewrites job);
+                Settings.setUrlRules (#filterUrl job);
+                Settings.setMimeRules (#filterMime job);
+                job
+            end
     in
-        TextIO.closeIn inf;
-        Settings.setUrlPrefix (#prefix job);
-        Settings.setTimeout (#timeout job);
-        Settings.setHeaders (#headers job);
-        Settings.setScripts (#scripts job);
-        Settings.setClientToServer (#clientToServer job);
-        Settings.setEffectful (#effectful job);
-        Settings.setClientOnly (#clientOnly job);
-        Settings.setServerOnly (#serverOnly job);
-        Settings.setJsFuncs (#jsFuncs job);
-        Settings.setRewriteRules (#rewrites job);
-        Settings.setUrlRules (#filterUrl job);
-        Settings.setMimeRules (#filterMime job);
-        job
+        pu fname
     end
 
 val parseUrp = {
@@ -669,14 +706,12 @@ val especialize = {
     print = CorePrint.p_file CoreEnv.empty
 }
 
-val toEspecialize = transform especialize "especialize" o toCorify
-
 val core_untangle = {
     func = CoreUntangle.untangle,
     print = CorePrint.p_file CoreEnv.empty
 }
 
-val toCore_untangle = transform core_untangle "core_untangle" o toEspecialize
+val toCore_untangle = transform core_untangle "core_untangle" o toCorify
 
 val shake = {
     func = Shake.shake,
@@ -725,12 +760,16 @@ val toSpecialize = transform specialize "specialize" o toUnpoly
 
 val toShake3 = transform shake "shake3" o toSpecialize
 
+val toEspecialize = transform especialize "especialize" o toShake3
+
+val toShake4 = transform shake "shake4" o toEspecialize
+
 val marshalcheck = {
     func = (fn file => (MarshalCheck.check file; file)),
     print = CorePrint.p_file CoreEnv.empty
 }
 
-val toMarshalcheck = transform marshalcheck "marshalcheck" o toShake3
+val toMarshalcheck = transform marshalcheck "marshalcheck" o toShake4
 
 val effectize = {
     func = Effective.effectize,
diff --git a/src/especialize.sml b/src/especialize.sml
index d1d018ee..03be01b1 100644
--- a/src/especialize.sml
+++ b/src/especialize.sml
@@ -148,6 +148,13 @@ fun specialize' file =
                             val functionInside = U.Con.exists {kind = fn _ => false,
                                                                con = fn TFun _ => true
                                                                       | CFfi ("Basis", "transaction") => true
+                                                                      | CFfi ("Basis", "eq") => true
+                                                                      | CFfi ("Basis", "num") => true
+                                                                      | CFfi ("Basis", "ord") => true
+                                                                      | CFfi ("Basis", "show") => true
+                                                                      | CFfi ("Basis", "read") => true
+                                                                      | CFfi ("Basis", "sql_injectable_prim") => true
+                                                                      | CFfi ("Basis", "sql_injectable") => true
                                                                       | _ => false}
                             val loc = ErrorMsg.dummySpan
 
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 26558745..d10bfd50 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -400,6 +400,8 @@ fun process file =
             else
                 s
 
+        val foundJavaScript = ref false
+
         fun jsExp mode skip outer =
             let
                 val len = length outer
@@ -662,8 +664,10 @@ fun process file =
                             let
                                 val args =
                                     case (m, x, args) of
-                                        ("Basis", "new_client_source", [(EJavaScript (_, e, _), _)]) => [e]
-                                      | ("Basis", "set_client_source", [e1, (EJavaScript (_, e2, _), _)]) => [e1, e2]
+                                        ("Basis", "new_client_source", [(EJavaScript (_, e, _), _)]) =>
+                                        (foundJavaScript := true; [e])
+                                      | ("Basis", "set_client_source", [e1, (EJavaScript (_, e2, _), _)]) =>
+                                        (foundJavaScript := true; [e1, e2])
                                       | _ => args
 
                                 val name = case Settings.jsFunc (m, x) of
@@ -871,12 +875,15 @@ fun process file =
                                          str ")"], st)
                             end
 
-                          | EJavaScript (Source _, _, SOME _) => (e, st)
+                          | EJavaScript (Source _, _, SOME _) =>
+                            (foundJavaScript := true;
+                             (e, st))
                           | EJavaScript (_, _, SOME e) =>
-                            (strcat [str "cs(function(){return ",
-                                     e,
-                                     str "})"],
-                             st)
+                            (foundJavaScript := true;
+                             (strcat [str "cs(function(){return ",
+                                      e,
+                                      str "})"],
+                              st))
 
                           | EClosure _ => unsupported "EClosure"
                           | EQuery _ => unsupported "Query"
@@ -888,6 +895,7 @@ fun process file =
                             let
                                 val (e, st) = jsE inner (e, st)
                             in
+                                foundJavaScript := true;
                                 (strcat [str "cs(function(){return ",
                                          e,
                                          str "})"],
@@ -995,7 +1003,8 @@ fun process file =
                                       in
                                           case e of
                                               EJavaScript (m, orig, NONE) =>
-                                              doCode m 0 env orig orig
+                                              (foundJavaScript := true;
+                                               doCode m 0 env orig orig)
                                             | _ => (e, st)
                                       end,
                              decl = fn (_, e, st) => (e, st),
@@ -1031,9 +1040,15 @@ fun process file =
                 NONE => String.concat (rev acc)
               | SOME line => lines (line :: acc)
         val lines = lines []
+
+        val script =
+            if !foundJavaScript then
+                lines ^ String.concat (rev (#script st))
+            else
+                ""
     in
         TextIO.closeIn inf;
-        (DJavaScript (lines ^ String.concat (rev (#script st))), ErrorMsg.dummySpan) :: ds
+        (DJavaScript script, ErrorMsg.dummySpan) :: ds
     end
 
 end
diff --git a/src/unpoly.sml b/src/unpoly.sml
index 17878508..56406636 100644
--- a/src/unpoly.sml
+++ b/src/unpoly.sml
@@ -72,8 +72,19 @@ fun unpolyNamed (xn, rep) =
                             end
                           | _ => e}
 
+structure M = BinaryMapFn(struct
+                          type ord_key = con list
+                          val compare = Order.joinL U.Con.compare
+                          end)
+
+type func = {
+     kinds : kind list,
+     defs : (string * int * con * exp * string) list,
+     replacements : int M.map
+}
+
 type state = {
-     funcs : (kind list * (string * int * con * exp * string) list) IM.map,
+     funcs : func IM.map,
      decls : decl list,
      nextName : int
 }
@@ -86,8 +97,6 @@ fun exp (e, st : state) =
     case e of
         ECApp _ =>
         let
-            (*val () = Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))]*)
-
             fun unravel (e, cargs) =
                 case e of
                     ECApp ((e, _), c) => unravel (e, c :: cargs)
@@ -102,72 +111,101 @@ fun exp (e, st : state) =
                 else
                     case IM.find (#funcs st, n) of
                         NONE => (e, st)
-                      | SOME (ks, vis) =>
-                        let
-                            val (vis, nextName) = ListUtil.foldlMap
-                                                      (fn ((x, n, t, e, s), nextName) =>
-                                                          ((x, nextName, n, t, e, s), nextName + 1))
-                                                      (#nextName st) vis
-
-                            fun specialize (x, n, n_old, t, e, s) =
-                                let
-                                    fun trim (t, e, cargs) =
-                                        case (t, e, cargs) of
-                                            ((TCFun (_, _, t), _),
-                                             (ECAbs (_, _, e), _),
-                                             carg :: cargs) =>
-                                            let
-                                                val t = subConInCon (length cargs, carg) t
-                                                val e = subConInExp (length cargs, carg) e
-                                            in
-                                                trim (t, e, cargs)
-                                            end
-                                          | (_, _, []) =>
-                                            let
-                                                val e = foldl (fn ((_, n, n_old, _, _, _), e) =>
-                                                                  unpolyNamed (n_old, ENamed n) e)
-                                                              e vis
-                                            in
-                                                SOME (t, e)
-                                            end
-                                          | _ => NONE
-                                in
-                                    (*Print.prefaces "specialize"
-                                                     [("t", CorePrint.p_con CoreEnv.empty t),
-                                                      ("e", CorePrint.p_exp CoreEnv.empty e),
-                                                      ("|cargs|", Print.PD.string (Int.toString (length cargs)))];*)
-                                    Option.map (fn (t, e) => (x, n, n_old, t, e, s))
-                                               (trim (t, e, cargs))
-                                end
-
-                            val vis = List.map specialize vis
-                        in
-                            if List.exists (not o Option.isSome) vis orelse length cargs > length ks then
-                                (e, st)
-                            else
-                                let
-                                    val vis = List.mapPartial (fn x => x) vis
-                                    val vis = map (fn (x, n, n_old, t, e, s) =>
-                                                      (x ^ "_unpoly", n, n_old, t, e, s)) vis
-                                    val vis' = map (fn (x, n, _, t, e, s) =>
-                                                       (x, n, t, e, s)) vis
-
-                                    val ks' = List.drop (ks, length cargs)
-                                in
-                                    case List.find (fn (_, _, n_old, _, _, _) => n_old = n) vis of
-                                        NONE => raise Fail "Unpoly: Inconsistent 'val rec' record"
-                                      | SOME (_, n, _, _, _, _) =>
-                                        (ENamed n,
-                                         {funcs = foldl (fn (vi, funcs) =>
-                                                            IM.insert (funcs, #2 vi, (ks', vis')))
-                                                        (#funcs st) vis',
+                      | SOME {kinds = ks, defs = vis, replacements} =>
+                        case M.find (replacements, cargs) of
+                            SOME n => (ENamed n, st)
+                          | NONE =>
+                            let
+                                val old_vis = vis
+                                val (vis, (thisName, nextName)) =
+                                    ListUtil.foldlMap
+                                        (fn ((x, n', t, e, s), (thisName, nextName)) =>
+                                            ((x, nextName, n', t, e, s),
+                                             (if n' = n then nextName else thisName,
+                                              nextName + 1)))
+                                        (0, #nextName st) vis
+
+                                fun specialize (x, n, n_old, t, e, s) =
+                                    let
+                                        fun trim (t, e, cargs) =
+                                            case (t, e, cargs) of
+                                                ((TCFun (_, _, t), _),
+                                                 (ECAbs (_, _, e), _),
+                                                 carg :: cargs) =>
+                                                let
+                                                    val t = subConInCon (length cargs, carg) t
+                                                    val e = subConInExp (length cargs, carg) e
+                                                in
+                                                    trim (t, e, cargs)
+                                                end
+                                              | (_, _, []) =>
+                                                (*let
+                                                    val e = foldl (fn ((_, n, n_old, _, _, _), e) =>
+                                                                      unpolyNamed (n_old, ENamed n) e)
+                                                                  e vis
+                                                in*)
+                                                    SOME (t, e)
+                                                (*end*)
+                                              | _ => NONE
+                                    in
+                                        (*Print.prefaces "specialize"
+                                                         [("t", CorePrint.p_con CoreEnv.empty t),
+                                                          ("e", CorePrint.p_exp CoreEnv.empty e),
+                                                          ("|cargs|", Print.PD.string (Int.toString (length cargs)))];*)
+                                        Option.map (fn (t, e) => (x, n, n_old, t, e, s))
+                                                   (trim (t, e, cargs))
+                                    end
+
+                                val vis = List.map specialize vis
+                            in
+                                if List.exists (not o Option.isSome) vis orelse length cargs > length ks then
+                                    (e, st)
+                                else
+                                    let
+                                        val vis = List.mapPartial (fn x => x) vis
+
+                                        val vis = map (fn (x, n, n_old, t, e, s) =>
+                                                          (x ^ "_unpoly", n, n_old, t, e, s)) vis
+                                        val vis' = map (fn (x, n, _, t, e, s) =>
+                                                           (x, n, t, e, s)) vis
+
+                                        val funcs = IM.insert (#funcs st, n,
+                                                               {kinds = ks,
+                                                                defs = old_vis,
+                                                                replacements = M.insert (replacements,
+                                                                                         cargs,
+                                                                                         thisName)})
+
+                                        val ks' = List.drop (ks, length cargs)
+
+                                        val st = {funcs = foldl (fn (vi, funcs) =>
+                                                                    IM.insert (funcs, #2 vi,
+                                                                               {kinds = ks',
+                                                                                defs = vis',
+                                                                                replacements = M.empty}))
+                                                                funcs vis',
+                                                  decls = #decls st,
+                                                  nextName = nextName}
+
+                                        val (vis', st) = ListUtil.foldlMap (fn ((x, n, t, e, s), st) =>
+                                                                               let
+                                                                                   val (e, st) = polyExp (e, st)
+                                                                               in
+                                                                                   ((x, n, t, e, s), st)
+                                                                               end)
+                                                                           st vis'
+                                    in
+                                        (ENamed thisName,
+                                         {funcs = #funcs st,
                                           decls = (DValRec vis', ErrorMsg.dummySpan) :: #decls st,
-                                          nextName = nextName})
-                                end
-                        end
+                                          nextName = #nextName st})
+                                    end
+                            end
         end
       | _ => (e, st)
 
+and polyExp (x, st) = U.Exp.foldMap {kind = kind, con = con, exp = exp} st x
+
 fun decl (d, st : state) =
     case d of
         DValRec (vis as ((x, n, t, e, s) :: rest)) =>
@@ -232,7 +270,9 @@ fun decl (d, st : state) =
                         (d, st)
                     else
                         (d, {funcs = foldl (fn (vi, funcs) =>
-                                               IM.insert (funcs, #2 vi, (cargs, vis)))
+                                               IM.insert (funcs, #2 vi, {kinds = cargs,
+                                                                         defs = vis,
+                                                                         replacements = M.empty}))
                                            (#funcs st) vis,
                              decls = #decls st,
                              nextName = #nextName st})
diff --git a/src/urweb.grm b/src/urweb.grm
index 1e1fe2ed..4697fef7 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -933,12 +933,12 @@ eexp   : eapps                          (eapps)
 
        | eexp CARET eexp                (native_op ("strcat", eexp1, eexp2, s (eexp1left, eexp2right)))
 
-       | eterm DCOLON eexp              (let
-                                             val loc = s (etermleft, eexpright)
+       | eapps DCOLON eexp              (let
+                                             val loc = s (eappsleft, eexpright)
                                          in
                                              (EApp ((EVar (["Basis"], "Cons", Infer), loc),
                                                     (ERecord [((CName "1", loc),
-                                                               eterm),
+                                                               eapps),
                                                               ((CName "2", loc),
                                                                eexp)], loc)), loc)
                                          end)