purescript · jutaro · Mar 21, 2016 · Mar 22, 2016 · Mar 22, 2016 · Mar 23, 2016
diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md
@@ -31,6 +31,7 @@ This file lists the contributors to the PureScript compiler project, and the ter
 - [@jacereda](https://github.com/jacereda) (Jorge Acereda) My existing contributions and all future contributions until further notice are Copyright Jorge Acereda, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
 - [@japesinator](https://github.com/japesinator) (JP Smith) My existing contributions and all future contributions until further notice are Copyright JP Smith, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
 - [@joneshf](https://github.com/joneshf) (Hardy Jones) - My existing contributions and all future contributions until further notice are Copyright Hardy Jones, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
+- [@jutaro](https://github.com/jutaro) (Jürgen Nicklisch-Franken) - My existing contributions and all future contributions until further notice are Copyright Hardy Jones, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
 - [@kika](https://github.com/kika) (Kirill Pertsev) - My existing contributions and all future contributions until further notice are Copyright Kirill Pertsev, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
 - [@kRITZCREEK](https://github.com/kRITZCREEK) (Christoph Hegemann) - My existing contributions and all future contributions until further notice are Copyright Christoph Hegemann, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
 - [@L8D](https://github.com/L8D) (Tenor Biel) My existing contributions and all future contributions until further notice are Copyright Tenor Biel, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

diff --git a/psc-bundle/Main.hs b/psc-bundle/Main.hs
@@ -8,6 +8,7 @@ module Main (main) where
 
 import Data.Traversable (for)
 import Data.Version (showVersion)
+import Data.Maybe (fromMaybe)
 
 import Control.Applicative
 import Control.Monad
@@ -35,6 +36,7 @@ data Options = Options
   , optionsEntryPoints :: [String]
   , optionsMainModule  :: Maybe String
   , optionsNamespace   :: String
+  , optionsShouldUncurry :: Maybe Bool
   } deriving Show
 
 -- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
@@ -60,8 +62,7 @@ app Options{..} = do
     length js `seq` return (mid, js)                                            -- evaluate readFile till EOF before returning, not to exhaust file handles
 
   let entryIds = map (`ModuleIdentifier` Regular) optionsEntryPoints
-
-  bundle input entryIds optionsMainModule optionsNamespace
+  bundle input entryIds optionsMainModule optionsNamespace (fromMaybe False optionsShouldUncurry)
 
 -- | Command line options parser.
 options :: Parser Options
@@ -70,6 +71,7 @@ options = Options <$> some inputFile
                   <*> many entryPoint
                   <*> optional mainModule
                   <*> namespace
+                  <*> (optional (not <$> noShouldUncurry) <|> optional shouldUncurry)
   where
   inputFile :: Parser FilePath
   inputFile = strArgument $
@@ -101,6 +103,18 @@ options = Options <$> some inputFile
     <> showDefault
     <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
 
+
+  shouldUncurry :: Parser Bool
+  shouldUncurry = switch $
+       short 'O'
+    <> long "optimize"
+    <> help "When given this option psc-bundle will apply an uncurry optimization"
+
+  noShouldUncurry :: Parser Bool
+  noShouldUncurry = switch $
+    long "no-optimize"
+    <> help "When given this option psc-bundle will prevent the uncurry optimization"
+
 -- | Make it go.
 main :: IO ()
 main = do

diff --git a/psc-bundle/README.md b/psc-bundle/README.md
@@ -4,14 +4,15 @@ A dead code elimination tool for PureScript-style CommonJS modules. This can be
 
 ## Usage
 
-    psc-bundle FILE (-m|--module ARG) [--main ARG] [--namespace ARG]
-    
+    psc-bundle FILE (-m|--module ARG) [--main ARG] [--namespace ARG] [--optimize]
+
 Options:
 
 - The input .js file(s)
 - Entry point module name(s) are specified with `-m` or `--module`. All code which is not a transitive dependency of an entry point module will be removed.
 - The main module is (optionally) specified using `--main`. If specified, this will generate code to run the main method in the specified module.
 - The browser namespace defaults to `PS`, and can be overridden with `--namespace`.
+- The uncurry optimization option is off by default. It can be explicitly enabled with `-O` or `--optimize` and disabled with `--no-optimize`.
 
 For example, to bundle the modules in the `output` directory, with main module `Main`:
 

diff --git a/purescript.cabal b/purescript.cabal
@@ -141,6 +141,8 @@ library
                      Language.PureScript.AST.Traversals
                      Language.PureScript.AST.Exported
                      Language.PureScript.Bundle
+                     Language.PureScript.BundleTypes
+                     Language.PureScript.BundleOpt                                          
                      Language.PureScript.Crash
                      Language.PureScript.Externs
                      Language.PureScript.CodeGen

diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs
@@ -1,33 +1,49 @@
--- |
+-----------------------------------------------------------------------------
+--
+-- Module      :  psc-bundle
+-- Copyright   :  (c) Phil Freeman 2015
+-- License     :  MIT
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
 -- Bundles compiled PureScript modules for the browser.
 --
 -- This module takes as input the individual generated modules from 'Language.PureScript.Make' and
 -- performs dead code elimination, filters empty modules,
 -- and generates the final Javascript bundle.
-module Language.PureScript.Bundle
-  ( bundle
-  , ModuleIdentifier(..)
-  , moduleName
-  , ModuleType(..)
-  , ErrorMessage(..)
-  , printErrorMessage
-  , getExportedIdentifiers
-  ) where
+-----------------------------------------------------------------------------
 
-import Prelude.Compat
 
-import Control.Monad
-import Control.Monad.Error.Class
+module Language.PureScript.Bundle (
+     bundle
+   , ModuleIdentifier(..)
+   , moduleName
+   , ModuleType(..)
+   , ErrorMessage(..)
+   , printErrorMessage
+   , getExportedIdentifiers
+) where
+
+import Prelude.Compat
 
-import Data.Generics (everything, everywhere, mkQ, mkT)
-import Data.Graph
 import Data.List (nub, stripPrefix)
 import Data.Maybe (mapMaybe, catMaybes)
+import Data.Generics (everything, everywhere, mkQ, mkT)
+import Data.Graph
 import Data.Version (showVersion)
+
 import qualified Data.Set as S
 
+import Control.Monad
+import Control.Monad.Error.Class
+import Language.JavaScript.Parser.AST hiding (showStripped)
 import Language.JavaScript.Parser
-import Language.JavaScript.Parser.AST
+import Language.PureScript.BundleOpt
+import Language.PureScript.BundleTypes
+
+-- import Debug.Trace
 
 import qualified Paths_purescript as Paths
 
@@ -41,54 +57,6 @@ data ErrorMessage
   | ErrorInModule ModuleIdentifier ErrorMessage
   deriving (Show, Read)
 
--- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules.
-data ModuleType
-  = Regular
-  | Foreign
-  deriving (Show, Read, Eq, Ord)
-
-showModuleType :: ModuleType -> String
-showModuleType Regular = "Regular"
-showModuleType Foreign = "Foreign"
-
--- | A module is identified by its module name and its type.
-data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Read, Eq, Ord)
-
-moduleName :: ModuleIdentifier -> String
-moduleName (ModuleIdentifier name _) = name
-
--- | A piece of code is identified by its module and its name. These keys are used to label vertices
--- in the dependency graph.
-type Key = (ModuleIdentifier, String)
-
--- | An export is either a "regular export", which exports a name from the regular module we are in,
--- or a reexport of a declaration in the corresponding foreign module.
---
--- Regular exports are labelled, since they might re-export an operator with another name.
-data ExportType
-  = RegularExport String
-  | ForeignReexport
-  deriving (Show, Eq, Ord)
-
--- | There are four types of module element we are interested in:
---
--- 1) Require statements
--- 2) Member declarations
--- 3) Export lists
--- 4) Everything else
---
--- Each is labelled with the original AST node which generated it, so that we can dump it back
--- into the output during codegen.
-data ModuleElement
-  = Require JSStatement String (Either String ModuleIdentifier)
-  | Member JSStatement Bool String JSExpression [Key]
-  | ExportsList [(ExportType, String, JSExpression, [Key])]
-  | Other JSStatement
-  deriving (Show)
-
--- | A module is just a list of elements of the types listed above.
-data Module = Module ModuleIdentifier [ModuleElement] deriving (Show)
-
 -- | Prepare an error message for consumption by humans.
 printErrorMessage :: ErrorMessage -> [String]
 printErrorMessage (UnsupportedModulePath s) =
@@ -567,13 +535,14 @@ codeGen optionsMainModule optionsNamespace ms =  renderToString (JSAstProgram (p
 -- | The bundling function.
 -- This function performs dead code elimination, filters empty modules
 -- and generates and prints the final Javascript bundle.
-bundle :: (MonadError ErrorMessage m)
-       => [(ModuleIdentifier, String)] -- ^ The input modules.  Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.
-       -> [ModuleIdentifier] -- ^ Entry points.  These module identifiers are used as the roots for dead-code elimination
-       -> Maybe String -- ^ An optional main module.
-       -> String -- ^ The namespace (e.g. PS).
-       -> m String
-bundle inputStrs entryPoints mainModule namespace = do
+bundle :: (Applicative m, MonadError ErrorMessage m)
+     => [(ModuleIdentifier, String)] -- ^ The input modules.  Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.
+     -> [ModuleIdentifier] -- ^ Entry points.  These module identifiers are used as the roots for dead-code elimination
+     -> Maybe String -- ^ An optional main
+     -> String -- ^ The namespace (e.g. PS).
+     -> Bool
+     -> m String
+bundle inputStrs entryPoints mainModule namespace shouldUncurry = do
   input <- forM inputStrs $ \(ident, js) -> do
                 ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)
                 return (ident, ast)
@@ -583,6 +552,20 @@ bundle inputStrs entryPoints mainModule namespace = do
   modules <- traverse (fmap withDeps . uncurry (toModule mids)) input
 
   let compiled = compile modules entryPoints
-      sorted   = sortModules (filter (not . isModuleEmpty) compiled)
+
+  -- The uncurry optimization performs dead code elemination (DCE) once and then
+  -- generates uncurried variants of the surviving functions. We need to
+  -- perform DCE again to throw away variants (curried or uncurried) that
+  -- aren't called after choosing the appropriate variant for each call site.
+  -- This two-step process avoids generating variants for functions that
+  -- are dead weight anyway.
+  compiled' <- if shouldUncurry
+                    then do
+                        let modules' = uncurryFunc compiled entryPoints
+                        modules'' <- traverse (fmap withDeps . pure) modules'   -- traverse and compile again
+                        return (compile modules'' entryPoints)
+                    else return compiled
+
+  let sorted   = sortModules (filter (not . isModuleEmpty) compiled')
 
   return (codeGen mainModule namespace sorted)