packages feed

purescript 0.4.17.1 → 0.4.18

raw patch · 18 files changed

+311/−211 lines, 18 filesdep ~sybPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: syb

API changes (from Hackage documentation)

- Language.PureScript.CodeGen.JS: wrapExportsContainer :: Options -> [JS] -> JS
- Language.PureScript.Constants: (!!) :: String
- Language.PureScript.Constants: _ps :: String
+ Language.PureScript: progress :: MonadMake m => String -> m ()
+ Language.PureScript.CodeGen.JS: CommonJS :: ModuleType
+ Language.PureScript.CodeGen.JS: Globals :: ModuleType
+ Language.PureScript.CodeGen.JS: data ModuleType
+ Language.PureScript.Constants: preludeUnsafe :: String
+ Language.PureScript.Constants: unsafeIndex :: String
+ Language.PureScript.Names: runIdent :: Ident -> String
+ Language.PureScript.Types: moveQuantifiersToFront :: Type -> Type
- Language.PureScript: make :: (Functor m, Monad m, MonadMake m) => Options -> [(FilePath, Module)] -> m ()
+ Language.PureScript: make :: (Functor m, Monad m, MonadMake m) => FilePath -> Options -> [(FilePath, Module)] -> m Environment
- Language.PureScript.CodeGen.JS: moduleToJs :: Options -> Module -> Environment -> Maybe JS
+ Language.PureScript.CodeGen.JS: moduleToJs :: ModuleType -> Options -> Module -> Environment -> [JS]
- Language.PureScript.Optimizer.Inliner: inlineOperator :: String -> (JS -> JS -> JS) -> JS -> JS
+ Language.PureScript.Optimizer.Inliner: inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
- Language.PureScript.Options: Options :: Bool -> Bool -> Bool -> Bool -> Maybe String -> Bool -> String -> [String] -> [String] -> Bool -> Options
+ Language.PureScript.Options: Options :: Bool -> Bool -> Bool -> Bool -> Maybe String -> Bool -> Maybe String -> [String] -> [String] -> Bool -> Options
- Language.PureScript.Options: optionsBrowserNamespace :: Options -> String
+ Language.PureScript.Options: optionsBrowserNamespace :: Options -> Maybe String

Files

prelude/prelude.purs view
@@ -6,9 +6,6 @@   const :: forall a b. a -> b -> a   const a _ = a -  on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c-  on f g x y = g x `f` g y-   asTypeOf :: forall a. a -> a -> a   asTypeOf x _ = x @@ -39,11 +36,28 @@   (#) :: forall a b. a -> (a -> b) -> b   (#) x f = f x +  infixr 6 :++  (:) :: forall a. a -> [a] -> [a]+  (:) = cons++  foreign import cons+    "function cons(e) {\+    \  return function (l) {\+    \    return [e].concat(l);\+    \  };\+    \}" :: forall a. a -> [a] -> [a]+   class Show a where     show :: a -> String +  foreign import showStringImpl+    "function showStringImpl(s) {\+    \  return JSON.stringify(s);\+    \}" :: String -> String+   instance showString :: Show String where-    show s = s+    show = showStringImpl    instance showBoolean :: Show Boolean where     show true = "true"@@ -56,6 +70,20 @@   instance showNumber :: Show Number where     show = showNumberImpl +  foreign import showArrayImpl+    "function showArrayImpl (f) {\+    \  return function (xs) {\+    \    var ss = [];\+    \    for (var i = 0, l = xs.length; i < l; i++) {\+    \      ss[i] = f(xs[i]);\+    \    }\+    \    return '[' + ss.join(',') + ']';\+    \  };\+    \}" :: forall a. (a -> String) -> [a] -> String++  instance showArray :: (Show a) => Show [a] where+    show = showArrayImpl show+   infixl 4 <$>    class Functor f where@@ -243,7 +271,7 @@   foreign import numCompare     "function numCompare(n1) {\     \  return function(n2) {\-    \    return n1 < n2 ? module.LT : n1 > n2 ? module.GT : module.EQ;\+    \    return n1 < n2 ? LT : n1 > n2 ? GT : EQ;\     \  };\     \}" :: Number -> Number -> Ordering @@ -312,14 +340,6 @@     zshr = numZshr     complement = numComplement -  infixl 8 !!--  foreign import (!!) "function $bang$bang(xs) {\-                      \  return function(n) {\-                      \    return xs[n];\-                      \  };\-                      \}" :: forall a. [a] -> Number -> a-   infixr 2 ||   infixr 3 && @@ -369,6 +389,11 @@   (++) :: forall s. (Semigroup s) => s -> s -> s   (++) = (<>) +module Data.Function where++  on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c+  on f g x y = g x `f` g y+ module Data.Eq where    data Ref a = Ref a@@ -379,6 +404,15 @@   instance eqRef :: Eq (Ref a) where     (==) = liftRef refEq     (/=) = liftRef refIneq++module Prelude.Unsafe where++  foreign import unsafeIndex+    "function unsafeIndex(xs) {\+    \  return function(n) {\+    \    return xs[n];\+    \  };\+    \}" :: forall a. [a] -> Number -> a  module Control.Monad.Eff where 
psc-make/Main.hs view
@@ -67,16 +67,17 @@     U.putStrLn $ "Writing " ++ path     U.writeFile path text   liftError = either throwError return+  progress = makeIO . U.putStrLn -compile :: P.Options -> [FilePath] -> IO ()-compile opts input = do+compile :: FilePath -> P.Options -> [FilePath] -> IO ()+compile outputDir opts input = do   modules <- readInput input   case modules of     Left err -> do       U.print err       exitFailure     Right ms -> do-      e <- runMake $ P.make opts ms+      e <- runMake $ P.make outputDir opts ms       case e of         Left err -> do           U.putStrLn err@@ -91,6 +92,10 @@ inputFiles = value $ posAny [] $ posInfo      { posDoc = "The input .ps files" } +outputDirectory :: Term FilePath+outputDirectory = value $ opt "output" $ (optInfo [ "o", "output" ])+     { optDoc = "The output directory" }+ noTco :: Term Bool noTco = value $ flag $ (optInfo [ "no-tco" ])      { optDoc = "Disable tail call optimizations" }@@ -111,16 +116,12 @@ noOpts = value $ flag $ (optInfo [ "no-opts" ])      { optDoc = "Skip the optimization phase." } -browserNamespace :: Term String-browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])-     { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }- verboseErrors :: Term Bool verboseErrors = value $ flag $ (optInfo [ "v", "verbose-errors" ])      { optDoc = "Display verbose error messages" }  options :: Term P.Options-options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> pure Nothing <*> noOpts <*> browserNamespace <*> pure [] <*> pure [] <*> verboseErrors+options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> pure Nothing <*> noOpts <*> pure Nothing <*> pure [] <*> pure [] <*> verboseErrors  inputFilesAndPrelude :: FilePath -> Term [FilePath] inputFilesAndPrelude prelude = combine <$> (not <$> noPrelude) <*> inputFiles@@ -129,7 +130,7 @@   combine False input = input  term :: FilePath -> Term (IO ())-term prelude = compile <$> options <*> inputFilesAndPrelude prelude+term prelude = compile <$> outputDirectory <*> options <*> inputFilesAndPrelude prelude  termInfo :: TermInfo termInfo = defTI
psc/Main.hs view
@@ -127,7 +127,7 @@      { optDoc = "Display verbose error messages" }  options :: Term P.Options-options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> runMain <*> noOpts <*> browserNamespace <*> dceModules <*> codeGenModules <*> verboseErrors+options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> runMain <*> noOpts <*> (Just <$> browserNamespace) <*> dceModules <*> codeGenModules <*> verboseErrors  stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath]) stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles@@ -150,3 +150,4 @@ main = do   prelude <- preludeFilename   run (term prelude, termInfo)+
psci/Main.hs view
@@ -13,7 +13,7 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE DoAndIfThenElse, FlexibleContexts #-}+{-# LANGUAGE DoAndIfThenElse, FlexibleContexts, GeneralizedNewtypeDeriving #-}  module Main where @@ -24,29 +24,36 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) import Control.Monad.Trans.State.Strict+import Control.Monad.Error (ErrorT(..), MonadError)+import Control.Monad.Error.Class (MonadError(..))  import Data.List (intercalate, isPrefixOf, nub, sortBy) import Data.Maybe (mapMaybe) import Data.Foldable (traverse_)-import Data.Traversable (traverse) import Data.Version (showVersion)+import Data.Traversable (traverse)  import Parser +import System.IO.Error (tryIOError) import System.Console.Haskeline-import System.Directory (doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)+import System.Directory+       (createDirectoryIfMissing, getModificationTime, doesFileExist,+        findExecutable, getHomeDirectory, getCurrentDirectory)+import System.Process (readProcessWithExitCode) import System.Exit import System.Environment.XDG.BaseDir-import System.FilePath ((</>), isPathSeparator)+import System.FilePath+       (pathSeparator, takeDirectory, (</>), isPathSeparator) import qualified System.Console.CmdTheLine as Cmd-import System.Process  import Text.Parsec (ParseError)  import qualified Data.Map as M import qualified Language.PureScript as P import qualified Paths_purescript as Paths-import qualified System.IO.UTF8 as U (print, readFile)+import qualified System.IO.UTF8 as U+       (writeFile, putStrLn, print, readFile)  -- | -- The PSCI state.@@ -57,7 +64,7 @@ data PSCiState = PSCiState   { psciImportedFilenames   :: [FilePath]   , psciImportedModuleNames :: [P.ModuleName]-  , psciLoadedModules       :: [P.Module]+  , psciLoadedModules       :: [(FilePath, P.Module)]   , psciLetBindings         :: [P.Value -> P.Value]   } @@ -78,7 +85,7 @@ -- | -- Updates the state to have more loaded files. ---updateModules :: [P.Module] -> PSCiState -> PSCiState+updateModules :: [(FilePath, P.Module)] -> PSCiState -> PSCiState updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }  -- |@@ -168,7 +175,7 @@   where   findCompletions :: String -> StateT PSCiState IO [Completion]   findCompletions str = do-    ms <- psciLoadedModules <$> get+    ms <- map snd . psciLoadedModules <$> get     files <- listFiles str     let matches = filter (isPrefixOf str) (names ms)     return $ sortBy sorter $ map simpleCompletion matches ++ files@@ -197,9 +204,41 @@ -- | Compilation options. -- options :: P.Options-options = P.Options False True False True (Just "Main") True "PS" [] [] False+options = P.Options False True False True Nothing True Nothing [] [] False  -- |+-- PSCI monad+--+newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)++psciIO :: IO a -> PSCI a+psciIO io = PSCI (lift (lift io))++newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadError String)++runMake :: Make a -> IO (Either String a)+runMake = runErrorT . unMake++makeIO :: IO a -> Make a+makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError++instance P.MonadMake Make where+  getTimestamp path = makeIO $ do+    exists <- doesFileExist path+    case exists of+      True -> Just <$> getModificationTime path+      False -> return Nothing+  readTextFile path = makeIO $ U.readFile path+  writeTextFile path text = makeIO $ do+    mkdirp path+    U.writeFile path text+  liftError = either throwError return+  progress s = unless (s == "Compiling Main") $ makeIO . U.putStrLn $ s++mkdirp :: FilePath -> IO ()+mkdirp = createDirectoryIfMissing True . takeDirectory++-- | -- Makes a volatile module to execute the current expression. -- createTemporaryModule :: Bool -> PSCiState -> P.Value -> P.Module@@ -217,34 +256,45 @@   in     P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing +modulesDir :: FilePath+modulesDir = "psci_modules" ++ pathSeparator : "node_modules"++indexFile :: FilePath+indexFile = "psci_modules" ++ pathSeparator : "index.js"+ -- | -- Takes a value declaration and evaluates it with the current state. ---handleDeclaration :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()-handleDeclaration value st = do+handleDeclaration :: P.Value -> PSCI ()+handleDeclaration value = do+  st <- PSCI $ lift get   let m = createTemporaryModule True st value-  case P.compile options (psciLoadedModules st ++ [m]) of-    Left err -> outputStrLn err-    Right (js, _, _) -> do-      process <- lift . lift $ findNodeProcess-      result  <- lift . lift $ traverse (\node -> readProcessWithExitCode node [] js) process+  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("Main.purs", m)])+  case e of+    Left err -> PSCI $ outputStrLn err+    Right _ -> do+      psciIO $ writeFile indexFile $ "require('Main').main();"+      process <- psciIO findNodeProcess+      result  <- psciIO $ traverse (\node -> readProcessWithExitCode node [indexFile] "") process       case result of-        Just (ExitSuccess,   out, _)   -> outputStrLn out-        Just (ExitFailure _, _,   err) -> outputStrLn err-        Nothing                        -> outputStrLn "Couldn't find node.js"+        Just (ExitSuccess,   out, _)   -> PSCI $ outputStrLn out+        Just (ExitFailure _, _,   err) -> PSCI $ outputStrLn err+        Nothing                        -> PSCI $ outputStrLn "Couldn't find node.js"  -- | -- Takes a value and prints its type ---handleTypeOf :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()-handleTypeOf value st = do+handleTypeOf :: P.Value -> PSCI ()+handleTypeOf value = do+  st <- PSCI $ lift get   let m = createTemporaryModule False st value-  case P.compile options { P.optionsMain = Nothing } (psciLoadedModules st ++ [m]) of-    Left err -> outputStrLn err-    Right (_, _, env') ->+  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("Main.purs", m)])+  case e of+    Left err -> PSCI $ outputStrLn err+    Right env' ->       case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of-        Just (ty, _) -> outputStrLn . P.prettyPrintType $ ty-        Nothing -> outputStrLn "Could not find type"+        Just (ty, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty+        Nothing -> PSCI $ outputStrLn "Could not find type"  -- Commands @@ -265,27 +315,31 @@ -- | -- Performs an action for each meta-command given, and also for expressions.. ---handleCommand :: Command -> InputT (StateT PSCiState IO) ()-handleCommand (Expression val) = lift get >>= handleDeclaration val-handleCommand Help = outputStrLn helpMessage-handleCommand (Import moduleName) = lift $ modify (updateImports moduleName)-handleCommand (Let l) = lift $ modify (updateLets l)+handleCommand :: Command -> PSCI ()+handleCommand (Expression val) = handleDeclaration val+handleCommand Help = PSCI $ outputStrLn helpMessage+handleCommand (Import moduleName) = PSCI $ lift $ modify (updateImports moduleName)+handleCommand (Let l) = PSCI $ lift $ modify (updateLets l) handleCommand (LoadFile filePath) = do-  absPath <- lift . lift $ expandTilde filePath-  exists <- lift . lift $ doesFileExist absPath+  absPath <- psciIO $ expandTilde filePath+  exists <- psciIO $ doesFileExist absPath   if exists then do-    lift $ modify (updateImportedFiles absPath)-    either outputStrLn (lift . modify . updateModules) =<< (lift . lift $ loadModule absPath)+    PSCI . lift $ modify (updateImportedFiles absPath)+    m <- psciIO $ loadModule absPath+    case m of+      Left err -> PSCI $ outputStrLn err+      Right mods -> PSCI . lift $ modify (updateModules (map ((,) absPath) mods))   else-    outputStrLn $ "Couldn't locate: " ++ filePath+    PSCI . outputStrLn $ "Couldn't locate: " ++ filePath handleCommand Reset = do-  files <- psciImportedFilenames <$> lift get-  modulesOrFirstError <- fmap concat . sequence <$> mapM (lift . lift . loadModule) files+  files <- psciImportedFilenames <$> PSCI (lift get)+  filesAndModules <- mapM (\file -> fmap (fmap (map ((,) file))) . psciIO . loadModule $ file) files+  let modulesOrFirstError = fmap concat $ sequence filesAndModules   case modulesOrFirstError of-    Left err -> lift . lift $ putStrLn err >> exitFailure-    Right modules -> lift $ put (PSCiState files defaultImports modules [])-handleCommand (TypeOf val) = lift get >>= handleTypeOf val-handleCommand _ = outputStrLn "Unknown command"+    Left err -> psciIO $ putStrLn err >> exitFailure+    Right modules -> PSCI . lift $ put (PSCiState files defaultImports modules [])+handleCommand (TypeOf val) = handleTypeOf val+handleCommand _ = PSCI $ outputStrLn "Unknown command"  inputFiles :: Cmd.Term [FilePath] inputFiles = Cmd.value $ Cmd.posAny [] $ Cmd.posInfo { Cmd.posName = "file(s)"@@ -311,7 +365,8 @@ loop files = do   config <- loadUserConfig   preludeFilename <- getPreludeFilename-  modulesOrFirstError <- fmap concat . sequence <$> mapM loadModule (preludeFilename : files)+  filesAndModules <- mapM (\file -> fmap (fmap (map ((,) file))) . loadModule $ file) (preludeFilename : files)+  let modulesOrFirstError = fmap concat $ sequence filesAndModules   case modulesOrFirstError of     Left err -> putStrLn err >> exitFailure     Right modules -> do@@ -319,7 +374,7 @@       let settings = defaultSettings {historyFile = Just historyFilename}       flip evalStateT (PSCiState (preludeFilename : files) defaultImports modules []) . runInputT (setComplete completion settings) $ do         outputStrLn prologueMessage-        traverse_ (mapM_ handleCommand) config+        traverse_ (mapM_ (runPSCI . handleCommand)) config         go       where         go :: InputT (StateT PSCiState IO) ()@@ -329,7 +384,7 @@             Left err -> outputStrLn (show err) >> go             Right Nothing -> go             Right (Just Quit) -> outputStrLn quitMessage-            Right (Just c') -> handleCommand c' >> go+            Right (Just c') -> runPSCI (handleCommand c') >> go  term :: Cmd.Term (IO ()) term = loop <$> inputFiles@@ -343,4 +398,3 @@  main :: IO () main = Cmd.run (term, termInfo)-
purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.4.17.1+version: 0.4.18 cabal-version: >=1.8 build-type: Custom license: MIT@@ -19,7 +19,7 @@  library     build-depends: base >=4 && <5, cmdtheline -any, containers -any,-                   directory >= 1.2, filepath -any, mtl -any, parsec -any, syb -any,+                   directory >= 1.2, filepath -any, mtl -any, parsec -any, syb >= 0.4.1 && < 0.5,                    transformers -any, utf8-string -any,                     pattern-arrows >= 0.0.2 && < 0.1,                     monad-unify >= 0.2.1 && < 0.3,@@ -87,7 +87,7 @@ executable psc     build-depends: base >=4 && <5, cmdtheline -any, containers -any,                    directory -any, filepath -any, mtl -any, parsec -any,-                   purescript -any, syb -any, transformers -any, utf8-string -any+                   purescript -any, syb >= 0.4.1 && < 0.5, transformers -any, utf8-string -any     main-is: Main.hs     buildable: True     hs-source-dirs: psc@@ -97,7 +97,7 @@ executable psc-make     build-depends: base >=4 && <5, cmdtheline -any, containers -any,                    directory -any, filepath -any, mtl -any, parsec -any,-                   purescript -any, syb -any, transformers -any, utf8-string -any+                   purescript -any, syb >= 0.4.1 && < 0.5, transformers -any, utf8-string -any     main-is: Main.hs     buildable: True     hs-source-dirs: psc-make@@ -107,7 +107,7 @@ executable psci     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,                    mtl -any, parsec -any, haskeline -any, purescript -any,-                   syb -any, transformers -any, utf8-string -any, process -any,+                   syb >= 0.4.1 && < 0.5, transformers -any, utf8-string -any, process -any,                    xdg-basedir -any, cmdtheline -any     main-is: Main.hs     buildable: True@@ -127,7 +127,7 @@  test-suite tests     build-depends: base >=4 && <5, containers -any, directory -any,-                   filepath -any, mtl -any, parsec -any, purescript -any, syb -any,+                   filepath -any, mtl -any, parsec -any, purescript -any, syb >= 0.4.1 && < 0.5,                    transformers -any, utf8-string -any, process -any     type: exitcode-stdio-1.0     main-is: Main.hs
src/Language/PureScript.hs view
@@ -37,7 +37,7 @@ import Data.Time.Clock import Data.Function (on) import Data.Generics (mkQ, everything)-import Data.Maybe (fromMaybe, mapMaybe)+import Data.Maybe (fromJust, fromMaybe) import Control.Monad.Error import Control.Monad.State.Lazy import Control.Arrow ((&&&))@@ -78,10 +78,10 @@   let elim = if null entryPoints then regrouped else eliminateDeadCode entryPoints regrouped   let codeGenModules = moduleNameFromString `map` optionsCodeGenModules opts   let modulesToCodeGen = if null codeGenModules then elim else filter (\(Module mn _ _) -> mn `elem` codeGenModules) elim-  let js = mapMaybe (flip (moduleToJs opts) env') modulesToCodeGen+  let js = concatMap (\m -> moduleToJs Globals opts m env') modulesToCodeGen   let exts = intercalate "\n" . map (`moduleToPs` env') $ modulesToCodeGen   js' <- generateMain env' opts js-  return (prettyPrintJS [wrapExportsContainer opts js'], exts, env')+  return (prettyPrintJS js', exts, env')   where   mainModuleIdent = moduleNameFromString <$> optionsMain opts @@ -128,7 +128,7 @@     Just mmi -> do       when ((mmi, Ident C.main) `M.notMember` names env) $         Left $ show mmi ++ "." ++ C.main ++ " is undefined"-      return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar C._ps))) []]+      return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar (fromJust (optionsBrowserNamespace opts))))) []]     _ -> return js  -- |@@ -155,6 +155,10 @@   --   liftError :: Either String a -> m a +  -- |+  -- Respond to a progress update+  --+  progress :: String -> m ()  -- | -- Compiles in "make" mode, compiling each module separately to a js files and an externs file@@ -162,17 +166,17 @@ -- If timestamps have not changed, the externs file can be used to provide the module's types without -- having to typecheck the module again. ---make :: (Functor m, Monad m, MonadMake m) => Options -> [(FilePath, Module)] -> m ()-make opts ms = do+make :: (Functor m, Monad m, MonadMake m) => FilePath -> Options -> [(FilePath, Module)] -> m Environment+make outputDir opts ms = do   let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)    (sorted, graph) <- liftError $ sortModules $ if optionsNoPrelude opts then map snd ms else (map (importPrelude . snd) ms)    toRebuild <- foldM (\s (Module moduleName' _ _) -> do-    let filePath = toFileName moduleName'+    let filePath = runModuleName moduleName' -        jsFile = "js" ++ pathSeparator : filePath ++ ".js"-        externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"+        jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"+        externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs"         inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap      jsTimestamp <- getTimestamp jsFile@@ -190,47 +194,45 @@   go initEnvironment desugared    where-  go :: (Functor m, Monad m, MonadMake m) => Environment -> [(Bool, Module)] -> m ()-  go _ [] = return ()+  go :: (Functor m, Monad m, MonadMake m) => Environment -> [(Bool, Module)] -> m Environment+  go env [] = return env   go env ((False, m) : ms') = do     (_, env') <- liftError . runCheck' opts env $ typeCheckModule Nothing m      go env' ms'   go env ((True, m@(Module moduleName' _ exps)) : ms') = do-    let filePath = toFileName moduleName'-        jsFile = "js" ++ pathSeparator : filePath ++ ".js"-        externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"+    let filePath = runModuleName moduleName'+        jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"+        externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs" +    progress $ "Compiling " ++ runModuleName moduleName'+     (Module _ elaborated _, env') <- liftError . runCheck' opts env $ typeCheckModule Nothing m      regrouped <- liftError . stringifyErrorStack True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated      let mod' = Module moduleName' regrouped exps-        js = moduleToJs opts mod' env'+        js = prettyPrintJS $ moduleToJs CommonJS opts mod' env'         exts = moduleToPs mod' env'-        js' = maybe "" (prettyPrintJS . return . wrapExportsContainer opts . return) js -    writeTextFile jsFile js'+    writeTextFile jsFile js     writeTextFile externsFile exts      go env' ms' -toFileName :: ModuleName -> FilePath-toFileName (ModuleName ps) = intercalate [pathSeparator] . map runProperName $ ps--rebuildIfNecessary :: (Functor m, Monad m, MonadMake m) => M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]-rebuildIfNecessary _ _ [] = return []-rebuildIfNecessary graph toRebuild (m@(Module moduleName' _ _) : ms) | moduleName' `S.member` toRebuild = do-  let deps = fromMaybe [] $ moduleName' `M.lookup` graph-      toRebuild' = toRebuild `S.union` S.fromList deps-  (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms-rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms) = do-  let externsFile = "externs" ++ pathSeparator : toFileName moduleName' ++ ".externs"-  externs <- readTextFile externsFile-  externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs-  case externsModules of-    [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms-    _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"+  rebuildIfNecessary :: (Functor m, Monad m, MonadMake m) => M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]+  rebuildIfNecessary _ _ [] = return []+  rebuildIfNecessary graph toRebuild (m@(Module moduleName' _ _) : ms') | moduleName' `S.member` toRebuild = do+    let deps = fromMaybe [] $ moduleName' `M.lookup` graph+        toRebuild' = toRebuild `S.union` S.fromList deps+    (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'+  rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do+    let externsFile = outputDir ++ pathSeparator : runModuleName moduleName' ++ pathSeparator : "externs.purs"+    externs <- readTextFile externsFile+    externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs+    case externsModules of+      [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'+      _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"  reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName] reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]
src/Language/PureScript/CodeGen/Common.hs view
@@ -106,6 +106,7 @@               , "long"               , "native"               , "new"+              , "null"               , "package"               , "private"               , "protected"
src/Language/PureScript/CodeGen/JS.hs view
@@ -17,14 +17,16 @@  module Language.PureScript.CodeGen.JS (     module AST,+    ModuleType(..),     declToJs,     moduleToJs,-    wrapExportsContainer,     isIdent ) where -import Data.Maybe (fromMaybe, mapMaybe)+import Data.Maybe (fromJust, fromMaybe, mapMaybe) import Data.Function (on)+import Data.List (nub, (\\))+import Data.Generics (mkQ, everything)  import Control.Arrow (second) import Control.Monad (replicateM, forM)@@ -41,27 +43,47 @@ import Language.PureScript.Optimizer import Language.PureScript.CodeGen.Common import Language.PureScript.Environment-import qualified Language.PureScript.Constants as C  -- |+-- Different types of modules which are supported+--+data ModuleType = CommonJS | Globals++-- | -- Generate code in the simplified Javascript intermediate representation for all declarations in a -- module. ---moduleToJs :: Options -> Module -> Environment -> Maybe JS-moduleToJs opts (Module name decls (Just exps)) env =-  case jsDecls of-    [] -> Nothing-    _ -> Just $ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar C._ps)) $-           JSApp (JSFunction Nothing [] (JSBlock $-            JSVariableIntroduction "module" (Just $ JSObjectLiteral []) :-            jsDecls ++-            jsExports ++-            [JSReturn $ JSVar "module"])) []+moduleToJs :: ModuleType -> Options -> Module -> Environment -> [JS]+moduleToJs mt opts (Module name decls (Just exps)) env = case mt of+  CommonJS -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) moduleExports]+  Globals ->+    [ JSVariableIntroduction (fromJust (optionsBrowserNamespace opts))+                             (Just (JSBinary Or (JSVar (fromJust (optionsBrowserNamespace opts))) (JSObjectLiteral [])) )+    , JSAssignment (JSAccessor (moduleNameToJs name) (JSVar (fromJust (optionsBrowserNamespace opts))))+                   (JSApp (JSFunction Nothing [] (JSBlock (moduleBody ++ [JSReturn moduleExports]))) [])+    ]   where+  moduleBody = JSStringLiteral "use strict" : jsImports ++ jsDecls+  moduleExports = JSObjectLiteral $ concatMap exportToJs exps   jsDecls = (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts name decl env) decls)-  jsExports = concatMap exportToJs exps-moduleToJs _ _ _ = error "Exports should have been elaborated in name desugaring"+  jsImports = map (importToJs mt opts) . (\\ [name]) . nub $ concatMap imports decls+moduleToJs _ _ _ _ = error "Exports should have been elaborated in name desugaring" +importToJs :: ModuleType -> Options -> ModuleName -> JS+importToJs mt opts mn = JSVariableIntroduction (moduleNameToJs mn) (Just moduleBody)+  where+  moduleBody = case mt of+    CommonJS -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn)]+    Globals -> JSAccessor (moduleNameToJs mn) (JSVar (fromJust (optionsBrowserNamespace opts)))++imports :: Declaration -> [ModuleName]+imports = everything (++) (mkQ [] collect)+  where+  collect :: Value -> [ModuleName]+  collect (Var (Qualified (Just mn) _)) = [mn]+  collect (Constructor (Qualified (Just mn) _)) = [mn]+  collect _ = []+ -- | -- Generate code in the simplified Javascript intermediate representation for a declaration --@@ -87,23 +109,15 @@ declToJs _ _ _ _ = Nothing  -- |--- Generate code in the simplified Javascript intermediate representation for an export from a--- module.+-- Generate key//value pairs for an object literal exporting values from a module. ---exportToJs :: DeclarationRef -> [JS]-exportToJs (TypeRef _ (Just dctors)) = flip map dctors (export . Ident . runProperName)-exportToJs (ValueRef name) = [export name]-exportToJs (TypeInstanceRef name) = [export name]+exportToJs :: DeclarationRef -> [(String, JS)]+exportToJs (TypeRef _ (Just dctors)) = map ((\n -> (n, var (Ident n))) . runProperName) dctors+exportToJs (ValueRef name) = [(runIdent name, var name)]+exportToJs (TypeInstanceRef name) = [(runIdent name, var name)] exportToJs _ = []  -- |--- Generate code in the simplified Javascript intermediate representation for assigning an exported--- value to the current module object.----export :: Ident -> JS-export ident = JSAssignment (accessor ident (JSVar "module")) (var ident)---- | -- Generate code in the simplified Javascript intermediate representation for a variable based on a -- PureScript identifier. --@@ -225,7 +239,7 @@ -- variable that may have a qualified name. -- qualifiedToJS :: ModuleName -> (a -> Ident) -> Qualified a -> JS-qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSAccessor (moduleNameToJs m') $ JSVar C._ps)+qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSVar (moduleNameToJs m')) qualifiedToJS _ f (Qualified _ a) = JSVar $ identToJs (f a)  -- |@@ -328,13 +342,3 @@   numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors e   typeConstructor (Qualified (Just moduleName) _, (tyCtor, _)) = (moduleName, tyCtor)   typeConstructor _ = error "Invalid argument to isOnlyConstructor"--wrapExportsContainer :: Options -> [JS] -> JS-wrapExportsContainer opts modules = JSApp (JSFunction Nothing [C._ps] $ JSBlock $ JSStringLiteral "use strict" : modules) [exportSelector]-  where-  exportSelector = JSConditional (JSBinary And (JSBinary NotEqualTo (JSTypeOf $ JSVar "module") (JSStringLiteral "undefined")) (JSAccessor "exports" (JSVar "module")))-                           (JSAccessor "exports" (JSVar "module"))-                           (JSConditional (JSBinary NotEqualTo (JSTypeOf $ JSVar "window") (JSStringLiteral "undefined"))-                             (JSAssignment (JSAccessor browserNamespace (JSVar "window")) (JSBinary Or (JSAccessor browserNamespace (JSVar "window")) (JSObjectLiteral [])))-                             (JSApp (JSFunction Nothing [] $ JSBlock [JSThrow $ JSStringLiteral "PureScript doesn't know how to export modules in the current environment"]) []))-  browserNamespace = optionsBrowserNamespace opts
src/Language/PureScript/Constants.hs view
@@ -23,9 +23,6 @@ (#) :: String (#) = "#" -(!!) :: String-(!!) = "!!"- (++) :: String (++) = "++" @@ -80,6 +77,9 @@ (||) :: String (||) = "||" +unsafeIndex :: String+unsafeIndex = "unsafeIndex"+ -- Prelude Operator Functions  negate :: String@@ -180,9 +180,6 @@  -- Code Generation -_ps :: String-_ps = "_ps"- __superclasses :: String __superclasses = "__superclasses" @@ -193,6 +190,9 @@  prelude :: String prelude = "Prelude"++preludeUnsafe :: String+preludeUnsafe = "Prelude_Unsafe"  eff :: String eff = "Control_Monad_Eff"
src/Language/PureScript/Names.hs view
@@ -33,6 +33,10 @@   --   | Op String deriving (Eq, Ord, Data, Typeable) +runIdent :: Ident -> String+runIdent (Ident i) = i+runIdent (Op op) = op+ instance Show Ident where   show (Ident s) = s   show (Op op) = '(':op ++ ")"
src/Language/PureScript/Optimizer.hs view
@@ -63,9 +63,9 @@   , etaConvert   , evaluateIifes   , inlineVariables-  , inlineOperator (C.$) $ \f x -> JSApp f [x]-  , inlineOperator (C.#) $ \x f -> JSApp f [x]-  , inlineOperator (C.!!) $ flip JSIndexer+  , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]+  , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]+  , inlineOperator (C.preludeUnsafe, C.unsafeIndex) $ flip JSIndexer   , inlineCommonOperators ])  untilFixedPoint :: (Eq a) => (a -> a) -> a -> a
src/Language/PureScript/Optimizer/Inliner.hs view
@@ -75,18 +75,14 @@       go (replaceIdent var js sts)   go (s:sts) = s : go sts -inlineOperator :: String -> (JS -> JS -> JS) -> JS -> JS-inlineOperator op f = everywhere (mkT convert)+inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS+inlineOperator (m, op) f = everywhere (mkT convert)   where   convert :: JS -> JS   convert (JSApp (JSApp op' [x]) [y]) | isOp op' = f x y   convert other = other-  isOp (JSAccessor longForm (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&-                                                                _ps == C._ps &&-                                                                longForm == identToJs (Op op) = True-  isOp (JSIndexer (JSStringLiteral op') (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&-                                                                            _ps == C._ps &&-                                                                            op == op' = True+  isOp (JSAccessor longForm (JSVar m')) = m == m' && longForm == identToJs (Op op)+  isOp (JSIndexer (JSStringLiteral op') (JSVar m')) = m == m' && op == op'   isOp _ = False  inlineCommonOperators :: JS -> JS@@ -131,11 +127,8 @@     convert :: JS -> JS     convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y     convert other = other-    isOp (JSAccessor longForm (JSAccessor prelude (JSVar _))) | prelude == C.prelude &&-                                                                longForm == identToJs (Op opString) = True-    isOp (JSIndexer (JSStringLiteral op') (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&-                                                                              _ps == C._ps &&-                                                                              opString == op' = True+    isOp (JSAccessor longForm (JSAccessor prelude (JSVar _))) = prelude == C.prelude && longForm == identToJs (Op opString)+    isOp (JSIndexer (JSStringLiteral op') (JSVar prelude)) = prelude == C.prelude && opString == op'     isOp _ = False   binaryFunction :: String -> String -> BinaryOperator -> JS -> JS   binaryFunction dictName fnName op = everywhere (mkT convert)@@ -143,9 +136,7 @@     convert :: JS -> JS     convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y     convert other = other-    isOp (JSAccessor fnName' (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&-                                                                 _ps == C._ps &&-                                                                 fnName == fnName' = True+    isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName == fnName'     isOp _ = False   unary :: String -> String -> UnaryOperator -> JS -> JS   unary dictName fnName op = everywhere (mkT convert)@@ -153,11 +144,7 @@     convert :: JS -> JS     convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict dictName dict = JSUnary op x     convert other = other-    isOp (JSAccessor fnName' (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&-                                                                 _ps == C._ps &&-                                                                 fnName' == fnName = True+    isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName     isOp _ = False-  isOpDict dictName (JSApp (JSAccessor prop (JSAccessor prelude (JSVar _ps))) [JSObjectLiteral []]) | prelude == C.prelude &&-                                                                                                      _ps == C._ps &&-                                                                                                      prop == dictName = True+  isOpDict dictName (JSApp (JSAccessor prop (JSVar prelude)) [JSObjectLiteral []]) = prelude == C.prelude && prop == dictName   isOpDict _ _ = False
src/Language/PureScript/Optimizer/MagicDo.hs view
@@ -80,31 +80,19 @@   isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict C.monadEffDictionary effDict = True   isReturn _ = False   -- Check if an expression represents the polymorphic >>= function-  isBindPoly (JSAccessor prop (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&-                                                                  _ps == C._ps &&-                                                                  prop == identToJs (Op (C.>>=)) = True-  isBindPoly (JSIndexer (JSStringLiteral bind) (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&-                                                                                   _ps == C._ps &&-                                                                                   bind == (C.>>=) = True+  isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == identToJs (Op (C.>>=))+  isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && bind == (C.>>=)   isBindPoly _ = False   -- Check if an expression represents the polymorphic return function-  isRetPoly (JSAccessor returnEscaped (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&-                                                                          _ps == C._ps &&-                                                                          returnEscaped == C.returnEscaped = True-  isRetPoly (JSIndexer (JSStringLiteral return') (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&-                                                                                    _ps == C._ps &&-                                                                                    return' == C.return = True+  isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped+  isRetPoly (JSIndexer (JSStringLiteral return') (JSVar prelude)) = prelude == C.prelude && return' == C.return   isRetPoly _ = False   -- Check if an expression represents a function in the Ef module-  isEffFunc name (JSAccessor name' (JSAccessor eff (JSVar _ps))) | eff == C.eff &&-                                                                   _ps == C._ps &&-                                                                   name == name' = True+  isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'   isEffFunc _ _ = False   -- Check if an expression represents the Monad Eff dictionary   isEffDict name (JSApp (JSVar ident) [JSObjectLiteral []]) | ident == name = True-  isEffDict name (JSApp (JSAccessor prop (JSAccessor eff (JSVar _ps))) [JSObjectLiteral []]) | eff == C.eff &&-                                                                                               _ps == C._ps &&-                                                                                               prop == name = True+  isEffDict name (JSApp (JSAccessor prop (JSVar eff)) [JSObjectLiteral []]) = eff == C.eff && prop == name   isEffDict _ _ = False   -- Remove __do function applications which remain after desugaring   undo :: JS -> JS@@ -147,9 +135,7 @@     JSAssignment (JSIndexer i arr) val   convert _ other = other   -- Check if an expression represents a function in the ST module-  isSTFunc name (JSAccessor name' (JSAccessor st (JSVar _ps))) | st == C.st &&-                                                                   _ps == C._ps &&-                                                                   name == name' = True+  isSTFunc name (JSAccessor name' (JSVar st)) = st == C.st && name == name'   isSTFunc _ _ = False   -- Find all ST Refs initialized in this block   findSTRefsIn = everything (++) (mkQ [] isSTRef)
src/Language/PureScript/Options.hs view
@@ -48,7 +48,7 @@     -- Specify the namespace that PureScript modules will be exported to when running in the     -- browser.     ---  , optionsBrowserNamespace :: String+  , optionsBrowserNamespace :: Maybe String     -- |     -- The modules to keep while enabling dead code elimination     --@@ -67,4 +67,4 @@ -- Default compiler options -- defaultOptions :: Options-defaultOptions = Options False False False False Nothing False "PS" [] [] False+defaultOptions = Options False False False False Nothing False Nothing [] [] False
src/Language/PureScript/Sugar/TypeClasses.hs view
@@ -145,7 +145,7 @@ typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =   ExternDeclaration TypeClassAccessorImport ident     (Just (JSFunction (Just $ identToJs ident) ["dict"] (JSBlock [JSReturn (JSIndexer (JSStringLiteral (identToProperty ident)) (JSVar "dict"))])))-    (quantify (ConstrainedType [(Qualified (Just mn) name, map TypeVar args)] ty))+    (moveQuantifiersToFront (quantify (ConstrainedType [(Qualified (Just mn) name, map TypeVar args)] ty))) typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos d) =   PositionedDeclaration pos $ typeClassMemberToDictionaryAccessor mn name args d typeClassMemberToDictionaryAccessor _ _ _ _ = error "Invalid declaration in type class definition"@@ -169,7 +169,7 @@   case mapMaybe declName tyDecls \\ mapMaybe declName decls of     x : _ -> throwError $ mkErrorStack ("Member '" ++ show x ++ "' has not been implemented") Nothing     [] -> do-    +       let instanceTys = map memberToNameAndType tyDecls        -- Replace the type arguments with the appropriate types in the member types@@ -192,16 +192,16 @@           dictTy = foldl TypeApp (TypeConstructor className) tys           constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)           dict = if null deps then Abs (Left (Ident "_")) (ObjectLiteral memberNames') else ObjectLiteral memberNames'-          +       return $ ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict constrainedTy)-  +   where    declName :: Declaration -> Maybe Ident   declName (PositionedDeclaration _ d) = declName d   declName (ValueDeclaration ident _ _ _ _) = Just ident   declName (TypeDeclaration ident _) = Just ident-  declName _ = Nothing +  declName _ = Nothing    memberToNameAndValue :: [(Ident, Type)] -> Declaration -> Desugar (Ident, Value)   memberToNameAndValue tys' d@(ValueDeclaration ident _ _ _ _) = do
src/Language/PureScript/TypeChecker/Types.hs view
@@ -675,6 +675,11 @@  inferLetBinding :: [Declaration] -> [Declaration] -> Value -> (Value -> UnifyT Type Check Value) -> UnifyT Type Check ([Declaration], Value) inferLetBinding seen [] ret j = (,) seen <$> j ret+inferLetBinding seen (ValueDeclaration ident nameKind [] Nothing tv@(TypedValue checkType val ty) : rest) ret j = do+  Just moduleName <- checkCurrentModule <$> get+  let dict = if isFunction val then M.singleton (moduleName, ident) (ty, nameKind) else M.empty+  TypedValue _ val' ty' <- if checkType then bindNames dict (check val ty) else return tv+  bindNames (M.singleton (moduleName, ident) (ty', nameKind)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] Nothing (TypedValue checkType val' ty')]) rest ret j inferLetBinding seen (ValueDeclaration ident nameKind [] Nothing val : rest) ret j = do   valTy <- fresh   Just moduleName <- checkCurrentModule <$> get@@ -1100,6 +1105,7 @@ subsumes' val ty1 ty2 = do   ty1 =?= ty2   return val+   
src/Language/PureScript/Types.hs view
@@ -182,3 +182,22 @@ -- quantify :: Type -> Type quantify ty = foldr (\arg t -> ForAll arg t Nothing) ty $ freeTypeVariables ty++-- |+-- Move all universal quantifiers to the front of a type+--+moveQuantifiersToFront :: Type -> Type+moveQuantifiersToFront = go [] []+  where+  go qs cs (ForAll q ty sco) = go ((q, sco) : qs) cs ty+  go qs cs (ConstrainedType cs' ty) = go qs (cs ++ cs') ty+  go qs cs ty =+    let constrained = case cs of+                        [] -> ty+                        cs' -> ConstrainedType cs' ty+    in case qs of+         [] -> constrained+         qs' -> foldl (\ty' (q, sco) -> ForAll q ty' sco) constrained qs'+++
tests/Main.hs view
@@ -54,12 +54,13 @@     Just err -> putStrLn err >> exitFailure     Nothing -> return () -assertCompiles :: FilePath -> FilePath -> FilePath -> IO ()+assertCompiles :: String -> FilePath -> FilePath -> IO () assertCompiles preludeJs preludeExterns inputFile = do   putStrLn $ "Assert " ++ inputFile ++ " compiles successfully"-  let options = P.defaultOptions { P.optionsMain = Just "Main", P.optionsModules = ["Main"], P.optionsCodeGenModules = ["Main"] }+  let options = P.defaultOptions { P.optionsMain = Just "Main", P.optionsModules = ["Main"], P.optionsCodeGenModules = ["Main"], P.optionsBrowserNamespace = Just "Tests" }   assert preludeExterns options inputFile $ either (return . Just) $ \(js, _, _) -> do     process <- findNodeProcess+    putStrLn $ preludeJs ++ js     result <- traverse (\node -> readProcessWithExitCode node [] (preludeJs ++ js)) process     case result of       Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing@@ -69,7 +70,7 @@ assertDoesNotCompile :: FilePath -> FilePath -> IO () assertDoesNotCompile preludeExterns inputFile = do   putStrLn $ "Assert " ++ inputFile ++ " does not compile"-  assert preludeExterns P.defaultOptions inputFile $ \e ->+  assert preludeExterns (P.defaultOptions { P.optionsBrowserNamespace = Just "Tests" }) inputFile $ \e ->     case e of       Left _ -> return Nothing       Right _ -> return $ Just "Should not have compiled"@@ -82,7 +83,7 @@ main = do   prelude <- preludeFilename   putStrLn "Compiling Prelude"-  preludeResult <- compile P.defaultOptions [prelude]+  preludeResult <- compile (P.defaultOptions { P.optionsBrowserNamespace = Just "Tests" }) [prelude]   case preludeResult of     Left err -> putStrLn err >> exitFailure     Right (preludeJs, exts, _) -> do