purescript 0.13.5 → 0.13.6

raw patch · 28 files changed

+383/−294 lines, 28 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• LICENSE +58/−134
• purescript.cabal +2/−1
• src/Language/PureScript/AST/Declarations.hs +1/−1
• src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs +4/−0
• src/Language/PureScript/Docs/Convert.hs +6/−6
• src/Language/PureScript/Errors.hs +9/−3
• src/Language/PureScript/Ide.hs +2/−1
• src/Language/PureScript/Ide/Imports.hs +1/−1
• src/Language/PureScript/Ide/Matcher.hs +1/−1
• src/Language/PureScript/Interactive/Directive.hs +1/−1
• src/Language/PureScript/Interactive/Types.hs +7/−4
• src/Language/PureScript/Kinds.hs +1/−1
• src/Language/PureScript/Make.hs +30/−4
• src/Language/PureScript/Make/Actions.hs +10/−1
• src/Language/PureScript/Make/BuildPlan.hs +5/−2
• src/Language/PureScript/PSString.hs +54/−16
• src/Language/PureScript/Sugar.hs +4/−3
• src/Language/PureScript/Sugar/AdoNotation.hs +25/−24
• src/Language/PureScript/Sugar/CaseDeclarations.hs +10/−9
• src/Language/PureScript/Sugar/DoNotation.hs +19/−5
• src/Language/PureScript/Sugar/Names.hs +60/−58
• src/Language/PureScript/Sugar/Operators/Common.hs +1/−1
• src/Language/PureScript/TypeChecker/Skolems.hs +1/−1
• src/Language/PureScript/TypeChecker/Types.hs +49/−14
• src/Language/PureScript/Types.hs +1/−1
• tests/purs/passing/3238.purs +14/−0
• tests/purs/passing/Guards.purs +6/−0
• tests/purs/warning/ScopeShadowing.purs +1/−1

@@ -47,6 +47,7 @@   bytestring-builder   cabal-doctest   case-insensitive+  cereal   cheapskate   clock   colour@@ -71,7 +72,6 @@   dlist   easy-file   edit-distance-  enclosed-exceptions   entropy   exceptions   fast-logger@@ -83,7 +83,7 @@   happy   hashable   haskeline-  hinotify+  hfsevents   http-date   http-types   http2@@ -129,7 +129,6 @@   semialign   semigroupoids   semigroups-  shelly   simple-sendfile   sourcemap   split@@ -138,8 +137,6 @@   streaming-commons   stringsearch   syb-  system-fileio-  system-filepath   tagged   tagsoup   template-haskell@@ -1295,6 +1292,39 @@   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +cereal LICENSE file:++  Copyright (c) Lennart Kolmodin, Galois, Inc.++  All rights reserved.++  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:++  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.++  2. Redistributions in binary form must reproduce the above copyright+     notice, this list of conditions and the following disclaimer in the+     documentation and/or other materials provided with the distribution.++  3. Neither the name of the author nor the names of his contributors+     may be used to endorse or promote products derived from this software+     without specific prior written permission.++  THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+  OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+  POSSIBILITY OF SUCH DAMAGE.+ cheapskate LICENSE file:    Copyright (c) 2013, John MacFarlane@@ -2021,29 +2051,6 @@   IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT   OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -enclosed-exceptions LICENSE file:--  Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/--  Permission is hereby granted, free of charge, to any person obtaining-  a copy of this software and associated documentation files (the-  "Software"), to deal in the Software without restriction, including-  without limitation the rights to use, copy, modify, merge, publish,-  distribute, sublicense, and/or sell copies of the Software, and to-  permit persons to whom the Software is furnished to do so, subject to-  the following conditions:--  The above copyright notice and this permission notice shall be-  included in all copies or substantial portions of the Software.--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND-  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE-  LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION-  OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION-  WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.- entropy LICENSE file:    Copyright (c) Thomas DuBuisson@@ -2428,38 +2435,38 @@   OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -hinotify LICENSE file:+hfsevents LICENSE file: -  Copyright (c) Lennart Kolmodin+  Copyright (c) 2012, Luite Stegeman    All rights reserved.    Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions-  are met:+  modification, are permitted provided that the following conditions are met: -  1. Redistributions of source code must retain the above copyright-     notice, this list of conditions and the following disclaimer.+      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer. -  2. Redistributions in binary form must reproduce the above copyright-     notice, this list of conditions and the following disclaimer in the-     documentation and/or other materials provided with the distribution.+      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution. -  3. Neither the name of the author nor the names of his contributors-     may be used to endorse or promote products derived from this software-     without specific prior written permission.+      * Neither the name of Luite Stegeman nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission. -  THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS-  OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR-  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,-  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN-  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE-  POSSIBILITY OF SUCH DAMAGE.+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.  http-date LICENSE file: @@ -3947,39 +3954,6 @@   ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE   POSSIBILITY OF SUCH DAMAGE. -shelly LICENSE file:--  Copyright (c) 2017, Petr Rockai <me@mornfall.net>--  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--      * Redistributions of source code must retain the above copyright-        notice, this list of conditions and the following disclaimer.--      * Redistributions in binary form must reproduce the above-        copyright notice, this list of conditions and the following-        disclaimer in the documentation and/or other materials provided-        with the distribution.--      * Neither the name of Petr Rockai nor the names of other-        contributors may be used to endorse or promote products derived-        from this software without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.- simple-sendfile LICENSE file:    Copyright (c) 2009, IIJ Innovation Institute Inc.@@ -4289,56 +4263,6 @@     be a definition of the Haskell 98 Foreign Function Interface.    -------------------------------------------------------------------------------system-fileio LICENSE file:--  Copyright (c) 2011 John Millikin--  Permission is hereby granted, free of charge, to any person-  obtaining a copy of this software and associated documentation-  files (the "Software"), to deal in the Software without-  restriction, including without limitation the rights to use,-  copy, modify, merge, publish, distribute, sublicense, and/or sell-  copies of the Software, and to permit persons to whom the-  Software is furnished to do so, subject to the following-  conditions:--  The above copyright notice and this permission notice shall be-  included in all copies or substantial portions of the Software.--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES-  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND-  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT-  HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,-  WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING-  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR-  OTHER DEALINGS IN THE SOFTWARE.--system-filepath LICENSE file:--  Copyright (c) 2010 John Millikin--  Permission is hereby granted, free of charge, to any person-  obtaining a copy of this software and associated documentation-  files (the "Software"), to deal in the Software without-  restriction, including without limitation the rights to use,-  copy, modify, merge, publish, distribute, sublicense, and/or sell-  copies of the Software, and to permit persons to whom the-  Software is furnished to do so, subject to the following-  conditions:--  The above copyright notice and this permission notice shall be-  included in all copies or substantial portions of the Software.--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES-  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND-  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT-  HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,-  WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING-  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR-  OTHER DEALINGS IN THE SOFTWARE.  tagged LICENSE file: 

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: purescript-version: 0.13.5+version: 0.13.6 license: BSD3 license-file: LICENSE copyright: (c) 2013-17 Phil Freeman, (c) 2014-19 Gary Burgess, (c) other contributors (see CONTRIBUTORS.md)@@ -401,6 +401,7 @@     tests/purs/passing/3114/VendoredVariant.purs     tests/purs/passing/3125.purs     tests/purs/passing/3187-UnusedNameClash.purs+    tests/purs/passing/3238.purs     tests/purs/passing/3388.purs     tests/purs/passing/3410.purs     tests/purs/passing/3481.purs

@@ -111,7 +111,7 @@   | ConstrainedTypeUnified SourceType SourceType   | OverlappingInstances (Qualified (ProperName 'ClassName)) [SourceType] [Qualified Ident]   | NoInstanceFound SourceConstraint-  | AmbiguousTypeVariables SourceType SourceConstraint+  | AmbiguousTypeVariables SourceType [Int]   | UnknownClass (Qualified (ProperName 'ClassName))   | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [SourceType]   | CannotDerive (Qualified (ProperName 'ClassName)) [SourceType]

@@ -48,6 +48,10 @@   -- Desugar discard   convert (App _ (App _ bind [m]) [Function s1 Nothing [] (Block s2 js)]) | isDiscard bind =     Function s1 (Just fnName) [] $ Block s2 (App s2 m [] : map applyReturns js )+  -- Desugar bind to wildcard+  convert (App _ (App _ bind [m]) [Function s1 Nothing [] (Block s2 js)])+    | isBind bind =+    Function s1 (Just fnName) [] $ Block s2 (App s2 m [] : map applyReturns js )   -- Desugar bind   convert (App _ (App _ bind [m]) [Function s1 Nothing [arg] (Block s2 js)]) | isBind bind =     Function s1 (Just fnName) [] $ Block s2 (VariableIntroduction s2 arg (Just (App s2 m [])) : map applyReturns js)

@@ -35,11 +35,12 @@ convertModule ::   MonadError P.MultipleErrors m =>   [P.ExternsFile] ->+  P.Env ->   P.Environment ->   P.Module ->   m Module-convertModule externs checkEnv m =-  partiallyDesugar externs [m] >>= \case+convertModule externs env checkEnv m =+  partiallyDesugar externs env [m] >>= \case     [m'] -> pure (insertValueTypes checkEnv (convertSingleModule m'))     _ -> P.internalError "partiallyDesugar did not return a singleton" @@ -88,9 +89,10 @@ partiallyDesugar ::   (MonadError P.MultipleErrors m) =>   [P.ExternsFile] ->+  P.Env ->   [P.Module] ->   m [P.Module]-partiallyDesugar externs = evalSupplyT 0 . desugar'+partiallyDesugar externs env = evalSupplyT 0 . desugar'   where   desugar' =     traverse P.desugarDoModule@@ -98,10 +100,8 @@       >=> map P.desugarLetPatternModule       >>> traverse P.desugarCasesModule       >=> traverse P.desugarTypeDeclarationsModule-      >=> ignoreWarnings . P.desugarImports externs+      >=> fmap fst . runWriterT . P.desugarImports env       >=> P.rebracketFiltered isInstanceDecl externs--  ignoreWarnings = fmap fst . runWriterT    isInstanceDecl (P.TypeInstanceDeclaration {}) = True   isInstanceDecl _ = False

@@ -286,7 +286,7 @@   gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> f t   gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t   gSimple (NoInstanceFound con) = NoInstanceFound <$> overConstraintArgs (traverse f) con-  gSimple (AmbiguousTypeVariables t con) = AmbiguousTypeVariables <$> f t <*> pure con+  gSimple (AmbiguousTypeVariables t us) = AmbiguousTypeVariables <$> f t <*> pure us   gSimple (OverlappingInstances cl ts insts) = OverlappingInstances cl <$> traverse f ts <*> pure insts   gSimple (PossiblyInfiniteInstance cl ts) = PossiblyInfiniteInstance cl <$> traverse f ts   gSimple (CannotDerive cl ts) = CannotDerive cl <$> traverse f ts@@ -679,10 +679,16 @@         where         go TUnknown{} = True         go _ = False-    renderSimpleErrorMessage (AmbiguousTypeVariables t _) =+    renderSimpleErrorMessage (AmbiguousTypeVariables t us) =       paras [ line "The inferred type"             , markCodeBox $ indent $ typeAsBox prettyDepth t-            , line "has type variables which are not mentioned in the body of the type. Consider adding a type annotation."+            , line "has type variables which are not determined by those mentioned in the body of the type:"+            , indent $ Box.hsep 1 Box.left+              [ Box.vcat Box.left+                [ line $ markCode ("t" <> T.pack (show u)) <> " could not be determined"+                | u <- us ]+              ]+            , line "Consider adding a type annotation."             ]     renderSimpleErrorMessage (PossiblyInfiniteInstance nm ts) =       paras [ line "Type class instance for"

@@ -51,7 +51,8 @@   -> m Success handleCommand c = case c of   Load [] ->-    findAvailableExterns >>= loadModulesAsync+    -- Clearing the State before populating it to avoid a space leak+    resetIdeState *> findAvailableExterns >>= loadModulesAsync   Load modules ->     loadModulesAsync modules   LoadSync [] ->

@@ -303,7 +303,7 @@     -- This case comes up for newtypes and dataconstructors. Because values and     -- types don't share a namespace we can get multiple matches from the same     -- module. This also happens for parameterized types, as these generate both-    -- a type aswell as a type synonym.+    -- a type as well as a type synonym.      ms@[Match (m1, d1), Match (m2, d2)] ->       if m1 /= m2

@@ -52,7 +52,7 @@       Just _ -> mzero       Nothing -> return mempty --- | Matches any occurence of the search string with intersections+-- | Matches any occurrence of the search string with intersections -- -- The scoring measures how far the matches span the string where -- closer is better.

@@ -12,7 +12,7 @@ import Language.PureScript.Interactive.Types  -- |--- List of all avaliable directives.+-- List of all available directives. -- directives :: [Directive] directives = map fst directiveStrings

@@ -35,6 +35,7 @@ import qualified Data.Map as M import           Data.List (foldl') import           Language.PureScript.Sugar.Names.Env (nullImports, primExports)+import           Control.Monad (foldM) import           Control.Monad.Trans.Except (runExceptT) import           Control.Monad.Writer.Strict (runWriterT) @@ -118,7 +119,7 @@ -- ensure that completions remain accurate. updateImportExports :: PSCiState -> PSCiState updateImportExports st@(PSCiState modules lets externs iprint _ _) =-  case desugarModule [temporaryModule] of+  case createEnv (map snd externs) >>= flip desugarModule [temporaryModule] of     Left _          -> st -- TODO: can this fail and what should we do?     Right (env, _)  ->       case M.lookup temporaryName env of@@ -126,9 +127,11 @@         _                 -> st -- impossible   where -  desugarModule :: [P.Module] -> Either P.MultipleErrors (P.Env, [P.Module])-  desugarModule = runExceptT =<< hushWarnings . P.desugarImportsWithEnv (map snd externs)-  hushWarnings  = fmap fst . runWriterT+  desugarModule :: P.Env -> [P.Module] -> Either P.MultipleErrors (P.Env, [P.Module])+  desugarModule e = runExceptT =<< fmap fst . runWriterT . P.desugarImportsWithEnv e++  createEnv :: [P.ExternsFile] -> Either P.MultipleErrors P.Env+  createEnv = runExceptT =<< fmap fst . runWriterT . foldM P.externsEnv P.primEnv    temporaryName :: P.ModuleName   temporaryName = P.ModuleName [P.ProperName "$PSCI"]

@@ -98,7 +98,7 @@   go :: Value -> Parser (Kind a)   go = kindFromJSON defaultAnn annFromJSON --- These overlapping instances exist to preserve compatability for common+-- These overlapping instances exist to preserve compatibility for common -- instances which have a sensible default for missing annotations. instance {-# OVERLAPPING #-} A.FromJSON (Kind SourceAnn) where   parseJSON = kindFromJSON (pure NullSourceAnn) A.parseJSON

@@ -17,6 +17,7 @@ import           Control.Monad.Supply import           Control.Monad.Trans.Control (MonadBaseControl(..)) import           Control.Monad.Writer.Class (MonadWriter(..))+import           Control.Monad.Writer.Strict (runWriterT) import           Data.Function (on) import           Data.Foldable (for_) import           Data.List (foldl', sortBy)@@ -57,13 +58,25 @@   -> [ExternsFile]   -> Module   -> m ExternsFile-rebuildModule MakeActions{..} externs m@(Module _ _ moduleName _ _) = do+rebuildModule actions externs m = do+  env <- fmap fst . runWriterT $ foldM externsEnv primEnv externs+  rebuildModule' actions env externs m++rebuildModule'+  :: forall m+   . (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  => MakeActions m+  -> Env+  -> [ExternsFile]+  -> Module+  -> m ExternsFile+rebuildModule' MakeActions{..} exEnv externs m@(Module _ _ moduleName _ _) = do   progress $ CompilingModule moduleName   let env = foldl' (flip applyExternsFileToEnvironment) initEnvironment externs       withPrim = importPrim m   lint withPrim   ((Module ss coms _ elaborated exps, env'), nextVar) <- runSupplyT 0 $ do-    desugar externs [withPrim] >>= \case+    desugar exEnv externs [withPrim] >>= \case       [desugared] -> runCheck' (emptyCheckState env) $ typeCheckModule desugared       _ -> internalError "desugar did not return a singleton" @@ -88,7 +101,7 @@   -- a bug in the compiler, which should be reported as such.   -- 2. We do not want to perform any extra work generating docs unless the   -- user has asked for docs to be generated.-  let docs = case Docs.convertModule externs env' m of+  let docs = case Docs.convertModule externs exEnv env' m of                Left errs -> internalError $                  "Failed to produce docs for " ++ T.unpack (runModuleName moduleName)                  ++ "; details:\n" ++ prettyPrintMultipleErrors defaultPPEOptions errs@@ -138,6 +151,9 @@   -- Write the updated build cache database to disk   writeCacheDb $ Cache.removeModules (M.keysSet failures) newCacheDb +  -- If generating docs, also generate them for the Prim modules+  outputPrimDocs+   -- All threads have completed, rethrow any caught errors.   let errors = M.elems failures   unless (null errors) $ throwError (mconcat errors)@@ -192,7 +208,17 @@        case mexterns of         Just (_, externs) -> do-          (exts, warnings) <- listen $ rebuildModule ma externs m+          -- We need to ensure that all dependencies have been included in Env+          C.modifyMVar_ (bpEnv buildPlan) $ \env -> do+            let+              go :: Env -> ModuleName -> m Env+              go e dep = case lookup dep (zip deps externs) of+                Just exts+                  | not (M.member dep e) -> externsEnv e exts+                _ -> return e+            foldM go env deps+          env <- C.readMVar (bpEnv buildPlan)+          (exts, warnings) <- listen $ rebuildModule' ma env externs m           return $ BuildJobSucceeded warnings exts         Nothing -> return BuildJobSkipped 

@@ -36,6 +36,7 @@ import qualified Language.PureScript.CoreImp.AST as Imp import           Language.PureScript.Crash import qualified Language.PureScript.CST as CST+import qualified Language.PureScript.Docs.Prim as Docs.Prim import qualified Language.PureScript.Docs.Types as Docs import           Language.PureScript.Errors import           Language.PureScript.Externs (ExternsFile)@@ -100,6 +101,8 @@   , writeCacheDb :: CacheDb -> m ()   -- ^ Write the given cache database to some external source (e.g. a file on   -- disk).+  , outputPrimDocs :: m ()+  -- ^ If generating docs, output the documentation for the Prim modules   }  -- | A set of make actions that read and write modules from the given directory.@@ -114,7 +117,7 @@   -- ^ Generate a prefix comment?   -> MakeActions Make buildMakeActions outputDir filePathMap foreigns usePrefix =-    MakeActions getInputTimestampsAndHashes getOutputTimestamp readExterns codegen ffiCodegen progress readCacheDb writeCacheDb+    MakeActions getInputTimestampsAndHashes getOutputTimestamp readExterns codegen ffiCodegen progress readCacheDb writeCacheDb outputPrimDocs   where    getInputTimestampsAndHashes@@ -156,6 +159,12 @@   readExterns mn = do     let path = outputDir </> T.unpack (runModuleName mn) </> "externs.json"     (path, ) <$> readExternsFile path++  outputPrimDocs :: Make ()+  outputPrimDocs = do+    codegenTargets <- asks optionsCodegenTargets+    when (S.member Docs codegenTargets) $ for_ Docs.Prim.primModules $ \docsMod@Docs.Module{..} ->+      writeJSONFile (outputFilename modName "docs.json") docsMod    codegen :: CF.Module CF.Ann -> Docs.Module -> ExternsFile -> SupplyT Make ()   codegen m docs exts = do

@@ -1,5 +1,5 @@ module Language.PureScript.Make.BuildPlan-  ( BuildPlan()+  ( BuildPlan(bpEnv)   , BuildJobResult(..)   , buildJobSuccess   , buildJobFailure@@ -29,12 +29,14 @@ import           Language.PureScript.Make.Actions as Actions import           Language.PureScript.Make.Cache import           Language.PureScript.Names (ModuleName)+import           Language.PureScript.Sugar.Names.Env  -- | The BuildPlan tracks information about our build progress, and holds all -- prebuilt modules for incremental builds. data BuildPlan = BuildPlan   { bpPrebuilt :: M.Map ModuleName Prebuilt   , bpBuildJobs :: M.Map ModuleName BuildJob+  , bpEnv :: C.MVar Env   }  data Prebuilt = Prebuilt@@ -140,8 +142,9 @@           mapMaybe (\s -> (statusModuleName s, statusRebuildNever s,) <$> statusPrebuilt s) rebuildStatuses   let toBeRebuilt = filter (not . flip M.member prebuilt) sortedModuleNames   buildJobs <- foldM makeBuildJob M.empty toBeRebuilt+  env <- C.newMVar primEnv   pure-    ( BuildPlan prebuilt buildJobs+    ( BuildPlan prebuilt buildJobs env     , let         update = flip $ \s ->           M.alter (const (statusNewCacheInfo s)) (statusModuleName s)

@@ -18,7 +18,7 @@ import Control.DeepSeq (NFData) import Control.Exception (try, evaluate) import Control.Applicative ((<|>))-import Data.Char (chr)+import qualified Data.Char as Char import Data.Bits (shiftR) import Data.List (unfoldr) import Data.Scientific (toBoundedInteger)@@ -67,7 +67,7 @@ -- we do not export it. -- codePoints :: PSString -> String-codePoints = map (either (chr . fromIntegral) id) . decodeStringEither+codePoints = map (either (Char.chr . fromIntegral) id) . decodeStringEither  -- | -- Decode a PSString as UTF-16 text. Lone surrogates will be replaced with@@ -94,14 +94,6 @@   unsurrogate h l = toEnum ((toInt h - 0xD800) * 0x400 + (toInt l - 0xDC00) + 0x10000)  -- |--- Pretty print a PSString, using Haskell/PureScript escape sequences.--- This is identical to the Show instance except that we get a Text out instead--- of a String.----prettyPrintString :: PSString -> Text-prettyPrintString = T.pack . show---- | -- Attempt to decode a PSString as UTF-16 text. This will fail (returning -- Nothing) if the argument contains lone surrogates. --@@ -156,6 +148,52 @@     parseCodeUnit b = A.withScientific "two-byte non-negative integer" (maybe (A.typeMismatch "" b) return . toBoundedInteger) b  -- |+-- Pretty print a PSString, using PureScript escape sequences.+--+prettyPrintString :: PSString -> Text+prettyPrintString s = "\"" <> foldMap encodeChar (decodeStringEither s) <> "\""+  where+  encodeChar :: Either Word16 Char -> Text+  encodeChar (Left c) = "\\x" <> showHex' 6 c+  encodeChar (Right c)+    | c == '\t' = "\\t"+    | c == '\r' = "\\r"+    | c == '\n' = "\\n"+    | c == '"'  = "\\\""+    | c == '\''  = "\\\'"+    | c == '\\' = "\\\\"+    | shouldPrint c = T.singleton c+    | otherwise = "\\x" <> showHex' 6 (Char.ord c)++  -- Note we do not use Data.Char.isPrint here because that includes things+  -- like zero-width spaces and combining punctuation marks, which could be+  -- confusing to print unescaped.+  shouldPrint :: Char -> Bool+  -- The standard space character, U+20 SPACE, is the only space char we should+  -- print without escaping+  shouldPrint ' ' = True+  shouldPrint c =+    Char.generalCategory c `elem`+      [ Char.UppercaseLetter+      , Char.LowercaseLetter+      , Char.TitlecaseLetter+      , Char.OtherLetter+      , Char.DecimalNumber+      , Char.LetterNumber+      , Char.OtherNumber+      , Char.ConnectorPunctuation+      , Char.DashPunctuation+      , Char.OpenPunctuation+      , Char.InitialQuote+      , Char.FinalQuote+      , Char.OtherPunctuation+      , Char.MathSymbol+      , Char.CurrencySymbol+      , Char.ModifierSymbol+      , Char.OtherSymbol+      ]++-- | -- Pretty print a PSString, using JavaScript escape sequences. Intended for -- use in compiled JS output. --@@ -163,8 +201,8 @@ prettyPrintStringJS s = "\"" <> foldMap encodeChar (toUTF16CodeUnits s) <> "\""   where   encodeChar :: Word16 -> Text-  encodeChar c | c > 0xFF = "\\u" <> hex 4 c-  encodeChar c | c > 0x7E || c < 0x20 = "\\x" <> hex 2 c+  encodeChar c | c > 0xFF = "\\u" <> showHex' 4 c+  encodeChar c | c > 0x7E || c < 0x20 = "\\x" <> showHex' 2 c   encodeChar c | toChar c == '\b' = "\\b"   encodeChar c | toChar c == '\t' = "\\t"   encodeChar c | toChar c == '\n' = "\\n"@@ -175,10 +213,10 @@   encodeChar c | toChar c == '\\' = "\\\\"   encodeChar c = T.singleton $ toChar c -  hex :: (Enum a) => Int -> a -> Text-  hex width c =-    let hs = showHex (fromEnum c) "" in-    T.pack (replicate (width - length hs) '0' <> hs)+showHex' :: Enum a => Int -> a -> Text+showHex' width c =+  let hs = showHex (fromEnum c) "" in+  T.pack (replicate (width - length hs) '0' <> hs)  isLead :: Word16 -> Bool isLead h = h >= 0xD800 && h <= 0xDBFF

@@ -54,10 +54,11 @@ -- desugar   :: (MonadSupply m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)-  => [ExternsFile]+  => Env+  -> [ExternsFile]   -> [Module]   -> m [Module]-desugar externs =+desugar env externs =   map desugarSignedLiterals     >>> traverse desugarObjectConstructors     >=> traverse desugarDoModule@@ -65,7 +66,7 @@     >=> map desugarLetPatternModule     >>> traverse desugarCasesModule     >=> traverse desugarTypeDeclarationsModule-    >=> desugarImports externs+    >=> desugarImports env     >=> rebracket externs     >=> traverse checkFixityExports     >=> traverse (deriveInstances externs)

@@ -25,43 +25,44 @@ -- | Desugar a single ado statement desugarAdo :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration desugarAdo d =-  let (f, _, _) = everywhereOnValuesM return replace return-  in f d+  let ss = declSourceSpan d+      (f, _, _) = everywhereOnValuesM return (replace ss) return+  in rethrowWithPosition ss $ f d   where-  pure' :: Maybe ModuleName -> Expr-  pure' m = Var nullSourceSpan (Qualified m (Ident C.pure'))+  pure' :: SourceSpan -> Maybe ModuleName -> Expr+  pure' ss m = Var ss (Qualified m (Ident C.pure')) -  map' :: Maybe ModuleName -> Expr-  map' m = Var nullSourceSpan (Qualified m (Ident C.map))+  map' :: SourceSpan -> Maybe ModuleName -> Expr+  map' ss m = Var ss (Qualified m (Ident C.map)) -  apply :: Maybe ModuleName -> Expr-  apply m = Var nullSourceSpan (Qualified m (Ident C.apply))+  apply :: SourceSpan -> Maybe ModuleName -> Expr+  apply ss m = Var ss (Qualified m (Ident C.apply)) -  replace :: Expr -> m Expr-  replace (Ado m els yield) = do-    (func, args) <- foldM go (yield, []) (reverse els)+  replace :: SourceSpan -> Expr -> m Expr+  replace pos (Ado m els yield) = do+    (func, args) <- foldM (go pos) (yield, []) (reverse els)     return $ case args of-      [] -> App (pure' m) func-      hd : tl -> foldl' (\a b -> App (App (apply m) a) b) (App (App (map' m) func) hd) tl-  replace (PositionedValue pos com v) = PositionedValue pos com <$> rethrowWithPosition pos (replace v)-  replace other = return other+      [] -> App (pure' pos m) func+      hd : tl -> foldl' (\a b -> App (App (apply pos m) a) b) (App (App (map' pos m) func) hd) tl+  replace _ (PositionedValue pos com v) = PositionedValue pos com <$> rethrowWithPosition pos (replace pos v)+  replace _ other = return other -  go :: (Expr, [Expr]) -> DoNotationElement -> m (Expr, [Expr])-  go (yield, args) (DoNotationValue val) =+  go :: SourceSpan -> (Expr, [Expr]) -> DoNotationElement -> m (Expr, [Expr])+  go _ (yield, args) (DoNotationValue val) =     return (Abs NullBinder yield, val : args)-  go (yield, args) (DoNotationBind (VarBinder ss ident) val) =+  go _ (yield, args) (DoNotationBind (VarBinder ss ident) val) =     return (Abs (VarBinder ss ident) yield, val : args)-  go (yield, args) (DoNotationBind binder val) = do+  go ss (yield, args) (DoNotationBind binder val) = do     ident <- freshIdent'-    let abs = Abs (VarBinder nullSourceSpan ident)-                  (Case [Var nullSourceSpan (Qualified Nothing ident)]+    let abs = Abs (VarBinder ss ident)+                  (Case [Var ss (Qualified Nothing ident)]                         [CaseAlternative [binder] [MkUnguarded yield]])     return (abs, val : args)-  go (yield, args) (DoNotationLet ds) = do+  go _ (yield, args) (DoNotationLet ds) = do     return (Let FromLet ds yield, args)-  go acc (PositionedDoNotationElement pos com el) =+  go _ acc (PositionedDoNotationElement pos com el) =     rethrowWithPosition pos $ do-      (yield, args) <- go acc el+      (yield, args) <- go pos acc el       return $ case args of         [] -> (PositionedValue pos com yield, args)         (a : as) -> (yield, PositionedValue pos com a : as)

@@ -171,8 +171,8 @@           -- if the binder is a var binder we must not add           -- the fail case as it results in unreachable           -- alternative-          alt_fail' | all isIrrefutable vb = []-                    | otherwise = alt_fail+          alt_fail' n | all isIrrefutable vb = []+                      | otherwise = alt_fail n             -- we are here:@@ -186,18 +186,18 @@           --         in Case scrut             (CaseAlternative vb [MkUnguarded (desugarGuard gs e alt_fail)]-              : alt_fail')+              : (alt_fail' (length scrut)))        return [ CaseAlternative scrut_nullbinder [MkUnguarded rhs]] -    desugarGuard :: [Guard] -> Expr -> [CaseAlternative] -> Expr+    desugarGuard :: [Guard] -> Expr -> (Int ->[CaseAlternative]) -> Expr     desugarGuard [] e _ = e     desugarGuard (ConditionGuard c : gs) e match_failed       | isTrueExpr c = desugarGuard gs e match_failed       | otherwise =         Case [c]           (CaseAlternative [LiteralBinder ss (BooleanLiteral True)]-            [MkUnguarded (desugarGuard gs e match_failed)] : match_failed)+            [MkUnguarded (desugarGuard gs e match_failed)] : match_failed 1)      desugarGuard (PatternGuard vb g : gs) e match_failed =       Case [g]@@ -206,7 +206,7 @@       where         -- don't consider match_failed case if the binder is irrefutable         match_failed' | isIrrefutable vb = []-                      | otherwise        = match_failed+                      | otherwise        = match_failed 1      -- we generate a let-binding for the remaining guards     -- and alternatives. A CaseAlternative is passed (or in@@ -215,7 +215,7 @@     desugarAltOutOfLine :: [Binder]                         -> [GuardedExpr]                         -> [CaseAlternative]-                        -> ([CaseAlternative] -> Expr)+                        -> ((Int -> [CaseAlternative]) -> Expr)                         -> m Expr     desugarAltOutOfLine alt_binder rem_guarded rem_alts mk_body       | Just rem_case <- mkCaseOfRemainingGuardsAndAlts = do@@ -228,7 +228,8 @@           goto_rem_case :: Expr           goto_rem_case = Var ss (Qualified Nothing rem_case_id)             `App` Literal ss (BooleanLiteral True)-          alt_fail = [CaseAlternative [NullBinder] [MkUnguarded goto_rem_case]]+          alt_fail :: Int -> [CaseAlternative]+          alt_fail n = [CaseAlternative (replicate n NullBinder) [MkUnguarded goto_rem_case]]          pure $ Let FromLet [           ValueDecl (ss, []) rem_case_id Private []@@ -236,7 +237,7 @@           ] (mk_body alt_fail)        | otherwise-      = pure $ mk_body []+      = pure $ mk_body (const [])       where         mkCaseOfRemainingGuardsAndAlts           | not (null rem_guarded)

@@ -7,8 +7,10 @@  import           Prelude.Compat +import           Control.Applicative ((<|>)) import           Control.Monad.Error.Class (MonadError(..)) import           Control.Monad.Supply.Class+import           Data.Maybe (fromMaybe) import           Data.Monoid (First(..)) import           Language.PureScript.AST import           Language.PureScript.Crash@@ -40,6 +42,13 @@   replace _ (PositionedValue pos com v) = PositionedValue pos com <$> rethrowWithPosition pos (replace pos v)   replace _ other = return other +  stripPositionedBinder :: Binder -> (Maybe SourceSpan, Binder)+  stripPositionedBinder (PositionedBinder ss _ b) =+    let (ss', b') = stripPositionedBinder b+     in (ss' <|> Just ss, b')+  stripPositionedBinder b =+    (Nothing, b)+   go :: SourceSpan -> Maybe ModuleName -> [DoNotationElement] -> m Expr   go _ _ [] = internalError "The impossible happened in desugarDo"   go _ _ [DoNotationValue val] = return val@@ -52,13 +61,18 @@     where       fromIdent (Ident i) | i `elem` [ C.bind, C.discard ] = First (Just i)       fromIdent _ = mempty-  go pos m (DoNotationBind (VarBinder ss ident) val : rest) = do-    rest' <- go pos m rest-    return $ App (App (bind pos m) val) (Abs (VarBinder ss ident) rest')   go pos m (DoNotationBind binder val : rest) = do     rest' <- go pos m rest-    ident <- freshIdent'-    return $ App (App (bind pos m) val) (Abs (VarBinder pos ident) (Case [Var pos (Qualified Nothing ident)] [CaseAlternative [binder] [MkUnguarded rest']]))+    let (mss, binder') = stripPositionedBinder binder+    let ss = fromMaybe pos mss+    case binder' of+      NullBinder ->+        return $ App (App (bind pos m) val) (Abs (VarBinder ss UnusedIdent) rest')+      VarBinder _ ident ->+        return $ App (App (bind pos m) val) (Abs (VarBinder ss ident) rest')+      _ -> do+        ident <- freshIdent'+        return $ App (App (bind pos m) val) (Abs (VarBinder pos ident) (Case [Var pos (Qualified Nothing ident)] [CaseAlternative [binder] [MkUnguarded rest']]))   go _ _ [DoNotationLet _] = throwError . errorMessage $ InvalidDoLet   go pos m (DoNotationLet ds : rest) = do     let checkBind :: Declaration -> m ()

@@ -2,6 +2,7 @@   ( desugarImports   , desugarImportsWithEnv   , Env+  , externsEnv   , primEnv   , ImportRecord(..)   , ImportProvenance(..)@@ -16,7 +17,7 @@ import Control.Monad import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Lazy-import Control.Monad.Writer (MonadWriter(..), censor)+import Control.Monad.Writer (MonadWriter(..))  import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Map as M@@ -42,73 +43,22 @@ desugarImports   :: forall m    . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)-  => [ExternsFile]+  => Env   -> [Module]   -> m [Module]-desugarImports externs modules =-  fmap snd (desugarImportsWithEnv externs modules)+desugarImports env modules =+  fmap snd (desugarImportsWithEnv env modules)  desugarImportsWithEnv   :: forall m   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)-  => [ExternsFile]+  => Env   -> [Module]   -> m (Env, [Module])-desugarImportsWithEnv externs modules = do-  env <- silence $ foldM externsEnv primEnv externs-  (modules', env') <- first reverse <$> foldM updateEnv ([], env) modules+desugarImportsWithEnv e modules = do+  (modules', env') <- first reverse <$> foldM updateEnv ([], e) modules   (env',) <$> traverse (renameInModule' env') modules'   where-  silence :: m a -> m a-  silence = censor (const mempty)--  -- | Create an environment from a collection of externs files-  externsEnv :: Env -> ExternsFile -> m Env-  externsEnv env ExternsFile{..} = do-    let members = Exports{..}-        env' = M.insert efModuleName (efSourceSpan, nullImports, members) env-        fromEFImport (ExternsImport mn mt qmn) = (mn, [(efSourceSpan, Just mt, qmn)])-    imps <- foldM (resolveModuleImport env') nullImports (map fromEFImport efImports)-    exps <- resolveExports env' efSourceSpan efModuleName imps members efExports-    return $ M.insert efModuleName (efSourceSpan, imps, exps) env-    where--    -- An ExportSource for declarations local to the module which the given-    -- ExternsFile corresponds to.-    localExportSource =-      ExportSource { exportSourceDefinedIn = efModuleName-                   , exportSourceImportedFrom = Nothing-                   }--    exportedTypes :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ExportSource)-    exportedTypes = M.fromList $ mapMaybe toExportedType efExports-      where-      toExportedType (TypeRef _ tyCon dctors) = Just (tyCon, (fromMaybe (mapMaybe forTyCon efDeclarations) dctors, localExportSource))-        where-        forTyCon :: ExternsDeclaration -> Maybe (ProperName 'ConstructorName)-        forTyCon (EDDataConstructor pn _ tNm _ _) | tNm == tyCon = Just pn-        forTyCon _ = Nothing-      toExportedType _ = Nothing--    exportedTypeOps :: M.Map (OpName 'TypeOpName) ExportSource-    exportedTypeOps = exportedRefs getTypeOpRef--    exportedTypeClasses :: M.Map (ProperName 'ClassName) ExportSource-    exportedTypeClasses = exportedRefs getTypeClassRef--    exportedValues :: M.Map Ident ExportSource-    exportedValues = exportedRefs getValueRef--    exportedValueOps :: M.Map (OpName 'ValueOpName) ExportSource-    exportedValueOps = exportedRefs getValueOpRef--    exportedKinds :: M.Map (ProperName 'KindName) ExportSource-    exportedKinds = exportedRefs getKindRef--    exportedRefs :: Ord a => (DeclarationRef -> Maybe a) -> M.Map a ExportSource-    exportedRefs f =-      M.fromList $ (, localExportSource) <$> mapMaybe f efExports-   updateEnv :: ([Module], Env) -> Module -> m ([Module], Env)   updateEnv (ms, env) m@(Module ss _ mn _ refs) = do     members <- findExportable m@@ -125,6 +75,58 @@       let m'' = elaborateExports exps m'       lintImports m'' env used       return m''++-- | Create an environment from a collection of externs files+externsEnv+  :: forall m+   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  => Env+  -> ExternsFile+  -> m Env+externsEnv env ExternsFile{..} = do+  let members = Exports{..}+      env' = M.insert efModuleName (efSourceSpan, nullImports, members) env+      fromEFImport (ExternsImport mn mt qmn) = (mn, [(efSourceSpan, Just mt, qmn)])+  imps <- foldM (resolveModuleImport env') nullImports (map fromEFImport efImports)+  exps <- resolveExports env' efSourceSpan efModuleName imps members efExports+  return $ M.insert efModuleName (efSourceSpan, imps, exps) env+  where++  -- An ExportSource for declarations local to the module which the given+  -- ExternsFile corresponds to.+  localExportSource =+    ExportSource { exportSourceDefinedIn = efModuleName+                  , exportSourceImportedFrom = Nothing+                  }++  exportedTypes :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ExportSource)+  exportedTypes = M.fromList $ mapMaybe toExportedType efExports+    where+    toExportedType (TypeRef _ tyCon dctors) = Just (tyCon, (fromMaybe (mapMaybe forTyCon efDeclarations) dctors, localExportSource))+      where+      forTyCon :: ExternsDeclaration -> Maybe (ProperName 'ConstructorName)+      forTyCon (EDDataConstructor pn _ tNm _ _) | tNm == tyCon = Just pn+      forTyCon _ = Nothing+    toExportedType _ = Nothing++  exportedTypeOps :: M.Map (OpName 'TypeOpName) ExportSource+  exportedTypeOps = exportedRefs getTypeOpRef++  exportedTypeClasses :: M.Map (ProperName 'ClassName) ExportSource+  exportedTypeClasses = exportedRefs getTypeClassRef++  exportedValues :: M.Map Ident ExportSource+  exportedValues = exportedRefs getValueRef++  exportedValueOps :: M.Map (OpName 'ValueOpName) ExportSource+  exportedValueOps = exportedRefs getValueOpRef++  exportedKinds :: M.Map (ProperName 'KindName) ExportSource+  exportedKinds = exportedRefs getKindRef++  exportedRefs :: Ord a => (DeclarationRef -> Maybe a) -> M.Map a ExportSource+  exportedRefs f =+    M.fromList $ (, localExportSource) <$> mapMaybe f efExports  -- | -- Make all exports for a module explicit. This may still affect modules that

@@ -96,7 +96,7 @@   -- grouping them by shared precedence, then if any of the following conditions   -- are met, we have something to report:   --   1. any of the groups have mixed associativity-  --   2. there is more than one occurance of a non-associative operator in a+  --   2. there is more than one occurrence of a non-associative operator in a   --      precedence group   mkErrors :: Chain a -> [ErrorMessage]   mkErrors chain =

@@ -30,7 +30,7 @@   modify $ \st -> st { checkNextSkolem = s + 1 }   return s --- | Introduce skolem scope at every occurence of a ForAll+-- | Introduce skolem scope at every occurrence of a ForAll introduceSkolemScope :: MonadState CheckState m => Type a -> m (Type a) introduceSkolemScope = everywhereOnTypesM go   where

@@ -25,7 +25,7 @@ -}  import Prelude.Compat-import Protolude (ordNub)+import Protolude (ordNub, fold, atMay)  import Control.Arrow (first, second, (***)) import Control.Monad@@ -110,21 +110,56 @@           . throwError           . errorMessage' ss           $ CannotGeneralizeRecursiveFunction ident generalized-        -- Make sure any unsolved type constraints only use type variables which appear-        -- unknown in the inferred type.-        forM_ unsolved $ \(_, _, con) -> do-          -- We need information about functional dependencies, since we allow-          -- ambiguous types to be inferred if they can be solved by some functional-          -- dependency.+        -- We need information about functional dependencies, since we allow+        -- ambiguous types to be inferred if they can be solved by some functional+        -- dependency.+        conData <- forM unsolved $ \(_, _, con) -> do           let findClass = fromMaybe (internalError "entails: type class not found in environment") . M.lookup (constraintClass con)           TypeClassData{ typeClassDependencies } <- gets (findClass . typeClasses . checkEnv)-          let solved = foldMap (S.fromList . fdDetermined) typeClassDependencies-          let constraintTypeVars = ordNub . foldMap (unknownsInType . fst) . filter ((`notElem` solved) . snd) $ zip (constraintArgs con) [0..]-          when (any (`notElem` unsolvedTypeVars) constraintTypeVars) .-            throwError-              . onErrorMessages (replaceTypes currentSubst)-              . errorMessage' ss-              $ AmbiguousTypeVariables generalized con+          let+            -- The set of unknowns mentioned in each argument.+            unknownsForArg :: [S.Set Int]+            unknownsForArg =+              map (S.fromList . map snd . unknownsInType) (constraintArgs con)+          pure (typeClassDependencies, unknownsForArg)+        -- Make sure any unsolved type constraints are determined by the+        -- type variables which appear unknown in the inferred type.+        let+          -- Take the closure of fundeps across constraints, to get more+          -- and more solved variables until reaching a fixpoint.+          solveFrom :: S.Set Int -> S.Set Int+          solveFrom determined = do+            let solved = solve1 determined+            if solved `S.isSubsetOf` determined+              then determined+              else solveFrom (determined <> solved)+          solve1 :: S.Set Int -> S.Set Int+          solve1 determined = fold $ do+            (tcDeps, conArgUnknowns) <- conData+            let+              lookupUnknowns :: Int -> Maybe (S.Set Int)+              lookupUnknowns = atMay conArgUnknowns+              unknownsDetermined :: Maybe (S.Set Int) -> Bool+              unknownsDetermined Nothing = False+              unknownsDetermined (Just unknowns) =+                unknowns `S.isSubsetOf` determined+            -- If all of the determining arguments of a particular fundep are+            -- already determined, add the determined arguments from the fundep+            tcDep <- tcDeps+            guard $ all (unknownsDetermined . lookupUnknowns) (fdDeterminers tcDep)+            map (fromMaybe S.empty . lookupUnknowns) (fdDetermined tcDep)+        -- These unknowns can be determined from the body of the inferred+        -- type (i.e. excluding the unknowns mentioned in the constraints)+        let determinedFromType = S.fromList . map snd $ unsolvedTypeVars+        -- These are all the unknowns mentioned in the constraints+        let constraintTypeVars = fold (conData >>= snd)+        let solved = solveFrom determinedFromType+        let unsolvedVars = S.difference constraintTypeVars solved+        when (not (S.null unsolvedVars)) .+          throwError+            . onErrorMessages (replaceTypes currentSubst)+            . errorMessage' ss+            $ AmbiguousTypeVariables generalized (S.toList unsolvedVars)        -- Check skolem variables did not escape their scope       skolemEscapeCheck val'

@@ -321,7 +321,7 @@   go :: A.Value -> A.Parser (Type a)   go = typeFromJSON defaultAnn annFromJSON --- These overlapping instances exist to preserve compatability for common+-- These overlapping instances exist to preserve compatibility for common -- instances which have a sensible default for missing annotations. instance {-# OVERLAPPING #-} A.FromJSON (Type SourceAnn) where   parseJSON = typeFromJSON (pure NullSourceAnn) A.parseJSON

@@ -0,0 +1,14 @@+module Main where++import Effect.Console (log)++class C a++class FD a b | a -> b++fn1 :: forall a b. FD a b => C b => a -> String+fn1 _ = ""++fn2 x = fn1 x++main = log "Done"

@@ -34,6 +34,12 @@             = x clunky1 a _ = a +clunky1_refutable :: Int -> Int -> Int+clunky1_refutable 0 a | x <- max a a+                      , x > 5+                      = x+clunky1_refutable a _ = a+ clunky2 :: Int -> Int -> Int clunky2 a b | x <- max a b             , x > 5

@@ -7,7 +7,7 @@ data Unit = Unit  -- This is only a warning as the `Prelude` import is implicit. If `Unit` was--- named explicitly in an import list, then this refernce to `Unit`+-- named explicitly in an import list, then this reference to `Unit` -- would be a `ScopeConflict` error instead. test :: Unit test = const Unit unit