zeolite-lang 0.7.1.0 → 0.8.0.0

raw patch · 37 files changed

+1027/−312 lines, 37 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +42/−0
• base/types.cpp +11/−0
• base/types.hpp +3/−1
• example/hello/README.md +1/−1
• example/tree/README.md +1/−1
• src/Base/CompileInfo.hs +3/−2
• src/Cli/Compiler.hs +52/−58
• src/Cli/Paths.hs +0/−34
• src/Cli/RunCompiler.hs +4/−3
• src/Cli/TestRunner.hs +7/−2
• src/Compilation/CompilerState.hs +29/−8
• src/Compilation/ProcedureContext.hs +118/−44
• src/CompilerCxx/CategoryContext.hs +14/−5
• src/CompilerCxx/Procedure.hs +61/−38
• src/Config/LocalConfig.hs +2/−1
• src/Module/Paths.hs +55/−0
• src/Module/ProcessMetadata.hs +33/−19
• src/Types/Pragma.hs +24/−1
• tests/cli-tests.sh +45/−8
• tests/module-only/README.md +5/−5
• tests/module-only2/.zeolite-module +3/−0
• tests/module-only2/README.md +20/−0
• tests/module-only2/private1.0rp +21/−0
• tests/module-only2/private2.0rp +23/−0
• tests/module-only2/public.0rp +21/−0
• tests/named-returns.0rt +23/−0
• tests/scoped.0rt +177/−67
• tests/unreachable.0rt +103/−11
• tests/warn-public/.zeolite-module +7/−0
• tests/warn-public/README.md +18/−0
• tests/warn-public/internal/.zeolite-module +3/−0
• tests/warn-public/internal/public.0rp +19/−0
• tests/warn-public/internal2/.zeolite-module +3/−0
• tests/warn-public/internal2/public.0rp +19/−0
• tests/warn-public/private.0rp +23/−0
• tests/warn-public/public.0rp +21/−0
• zeolite-lang.cabal +13/−3

@@ -1,5 +1,47 @@ # Revision history for zeolite-lang +## 0.8.0.0  -- 2020-08-07++### Language++* **[breaking]** Makes the semantics of `cleanup` more consistent:++  * **[breaking]** Disallows statements that modify `return` values within+    `cleanup` blocks, i.e., `return` with values and assigning named returns.++  * **[new]** Allows `cleanup` to access named returns that are initialized+    within the corresponding `in` statement. Previously, access required+    initialization *before* the `in` statement.++  * **[new]** An explicit *positional* return (e.g., `return 1, 2`) will assign+    the values to the respective named returns, if applicable. This will make+    the actual return values available within `cleanup`.++    ```text+    @type get () -> (Int)+    get () (foo) {   // foo is the name of the return variable+      cleanup {+        \ bar(foo)   // foo has been initialized by the time this is called+      } in return 1  // 1 is assigned to foo here+    }+    ```++  * **[fix]** Adds unwinding of `cleanup` blocks when used with `break` and+  `continue`, respecting loop boundaries. Previously, `cleanup` was ignored.++* **[breaking]** Skips compilation of unreachable statements. The target+  use-case is temporary changes to code that circumvent parts of a procedure,+  e.g., an early `return` for the purposes of debugging.++* **[breaking]** Marks statements following `break` and `continue` as+  unreachable.++### Compiler CLI++* **[behavior]** Adds a compiler warning for `public_deps` that are not required+  by public `.0rp` sources within the same module, since they are potentially+  just cluttering the public namespace of the module.+ ## 0.7.1.0  -- 2020-07-13  ### Language

@@ -39,6 +39,17 @@   return *args_[0]; } +ReturnTuple& ReturnTuple::operator =(ReturnTuple &&other) {+  if (Size() != other.Size()) {+    FAIL() << "ReturnTuple size mismatch in assignment: " << Size()+           << " (expected) " << other.Size() << " (actual)";+  }+  for (int i = 0; i < Size(); ++i) {+    At(i) = std::move(other.At(i));+  }+  return *this;+}+ int ReturnTuple::Size() const {   return returns_.size(); }

@@ -149,7 +149,7 @@   ReturnTuple(int size) : returns_(size) {}    ReturnTuple(ReturnTuple&&) = default;-  ReturnTuple& operator =(ReturnTuple&&) = default;+  ReturnTuple& operator =(ReturnTuple&&);    template<class...Ts>   explicit ReturnTuple(Ts... returns) : returns_{std::move(returns)...} {}@@ -177,7 +177,9 @@   private:   ArgTuple(const ArgTuple&) = delete;+  ArgTuple(ArgTuple&&) = delete;   ArgTuple& operator =(const ArgTuple&) = delete;+  ArgTuple& operator =(ArgTuple&&) =  delete;    std::vector<const S<TypeValue>*> args_; };

@@ -10,7 +10,7 @@ ZEOLITE_PATH=$(zeolite --get-path)  # Compile the example.-zeolite -p "$ZEOLITE_PATH" -i lib/util -m HelloDemo example/hello+zeolite -p "$ZEOLITE_PATH" -I lib/util -m HelloDemo example/hello  # Execute the compiled binary. $ZEOLITE_PATH/example/hello/HelloDemo

@@ -10,7 +10,7 @@ ZEOLITE_PATH=$(zeolite --get-path)  # Compile the example.-zeolite -p "$ZEOLITE_PATH" -i lib/util -m TreeDemo example/tree+zeolite -p "$ZEOLITE_PATH" -I lib/util -m TreeDemo example/tree  # Run the unit tests. zeolite -p "$ZEOLITE_PATH" -t example/tree

@@ -109,13 +109,14 @@ tryCompileInfoIO :: String -> CompileInfoIO a -> IO a tryCompileInfoIO message x = do   x' <- toCompileInfo $ x `reviseErrorM` message+  let warnings = map (\w -> "Warning: " ++ w ++ "\n") (getCompileWarnings x')   if isCompileError x'      then do-       hPutStr stderr $ concat $ map (++ "\n") (getCompileWarnings x')+       hPutStr stderr $ concat warnings        hPutStr stderr $ show $ getCompileError x'        exitFailure      else do-       hPutStr stderr $ concat $ map (++ "\n") (getCompileWarnings x')+       hPutStr stderr $ concat warnings        return $ getCompileSuccess x'  data CompileMessage =

@@ -38,13 +38,13 @@ import Base.CompileError import Base.CompileInfo import Cli.CompileOptions-import Cli.Paths import Cli.Programs import Cli.TestRunner -- Not safe, due to Text.Regex.TDFA. import Compilation.ProcedureContext (ExprMap) import CompilerCxx.Category import CompilerCxx.Naming import Module.CompileMetadata+import Module.Paths import Module.ProcessMetadata import Parser.SourceFile import Types.Builtin@@ -102,8 +102,13 @@                  return $ bpDeps ++ deps1   ns0 <- createPublicNamespace p d   let ex = concat $ map getSourceCategories es-  (cm,(pc,tc)) <- loadLanguageModule p ns0 ex em ps deps1' deps2-  xa <- mapErrorsM (loadPrivateSource p) xs+  cs <- loadModuleGlobals resolver p ns0 ps deps1' deps2+  let cm = createLanguageModule ex em cs+  let cs2 = filter (not . hasCodeVisibility FromDependency) cs+  let pc = map (getCategoryName . wvData) $ filter (not . hasCodeVisibility ModuleOnly) cs2+  let tc = map (getCategoryName . wvData) $ filter (hasCodeVisibility ModuleOnly)       cs2+  let dc = map (getCategoryName . wvData) $ filter (hasCodeVisibility FromDependency) $ filter (not . hasCodeVisibility ModuleOnly) cs+  xa <- mapErrorsM (loadPrivateSource resolver p) xs   (xx1,xx2) <- compileLanguageModule cm xa   mf <- maybeCreateMain cm xa m   let fs' = xx1++xx2@@ -126,6 +131,7 @@   let (osCat,osOther) = partitionEithers os2   path <- errorFromIO $ canonicalizePath $ p </> d   let os1' = resolveObjectDeps (deps1' ++ deps2) path path (os1 ++ osCat)+  warnPublic resolver (p </> d) pc dc os1' is   let cm2 = CompileMetadata {       cmVersionHash = compilerHash,       cmPath = path,@@ -241,13 +247,14 @@       fmap (:[]) $ compileModuleMain cm2 xs2 n f2     maybeCreateMain _ _ _ = return [] -createModuleTemplates :: FilePath -> FilePath -> [CompileMetadata] -> [CompileMetadata] -> CompileInfoIO ()-createModuleTemplates p d deps1 deps2 = do+createModuleTemplates :: PathIOHandler r => r -> FilePath -> FilePath ->+  [CompileMetadata] -> [CompileMetadata] -> CompileInfoIO ()+createModuleTemplates resolver p d deps1 deps2 = do   ns0 <- createPublicNamespace p d   (ps,xs,_) <- findSourceFiles p d-  (LanguageModule _ _ _ cs0 ps0 ts0 cs1 ps1 ts1 _ _,_) <--    fmap (fmap fst) $ loadLanguageModule p ns0 [] Map.empty ps deps1 deps2-  xs' <- zipWithContents p xs+  (LanguageModule _ _ _ cs0 ps0 ts0 cs1 ps1 ts1 _ _) <-+    fmap (createLanguageModule [] Map.empty) $ loadModuleGlobals resolver p ns0 ps deps1 deps2+  xs' <- zipWithContents resolver p xs   ds <- mapErrorsM parseInternalSource xs'   let ds2 = concat $ map (\(_,_,d2) -> d2) ds   tm <- foldM includeNewTypes defaultCategories [cs0,cs1,ps0,ps1,ts0,ts1]@@ -267,12 +274,12 @@  runModuleTests :: (PathIOHandler r, CompilerBackend b) => r -> b -> FilePath ->   [FilePath] -> LoadedTests -> CompileInfoIO [((Int,Int),CompileInfo ())]-runModuleTests _ backend base tp (LoadedTests p d m em deps1 deps2) = do+runModuleTests resolver backend base tp (LoadedTests p d m em deps1 deps2) = do   let paths = base:(getIncludePathsForDeps deps1)   mapErrorsM_ showSkipped $ filter (not . isTestAllowed) $ cmTestFiles m-  ts' <- zipWithContents p $ map (d </>) $ filter isTestAllowed $ cmTestFiles m+  ts' <- zipWithContents resolver p $ map (d </>) $ filter isTestAllowed $ cmTestFiles m   path <- errorFromIO $ canonicalizePath (p </> d)-  (cm,_) <- loadLanguageModule path NoNamespace [] em [] deps1 []+  cm <- fmap (createLanguageModule [] em) $ loadModuleGlobals resolver path NoNamespace [] deps1 []   mapErrorsM (runSingleTest backend cm path paths (m:deps2)) ts' where     allowTests = Set.fromList tp     isTestAllowed t = if null allowTests then True else t `Set.member` allowTests@@ -284,58 +291,45 @@ createPrivateNamespace :: FilePath -> FilePath -> CompileInfoIO Namespace createPrivateNamespace p f = (errorFromIO $ canonicalizePath (p </> f)) >>= return . StaticNamespace . privateNamespace -zipWithContents :: FilePath -> [FilePath] -> CompileInfoIO [(FilePath,String)]-zipWithContents p fs = fmap (zip $ map fixPath fs) $ mapM (errorFromIO . readFile . (p </>)) fs--loadPrivateSource :: FilePath -> FilePath -> CompileInfoIO (PrivateSource SourcePos)-loadPrivateSource p f = do-  [f'] <- zipWithContents p [f]+loadPrivateSource :: PathIOHandler r => r -> FilePath -> FilePath -> CompileInfoIO (PrivateSource SourcePos)+loadPrivateSource resolver p f = do+  [f'] <- zipWithContents resolver p [f]   ns <- createPrivateNamespace p f   (pragmas,cs,ds) <- parseInternalSource f'   let cs' = map (setCategoryNamespace ns) cs   let testing = any isTestsOnly pragmas   return $ PrivateSource ns testing cs' ds -loadLanguageModule :: FilePath -> Namespace -> [CategoryName] ->-  ExprMap SourcePos -> [FilePath] -> [CompileMetadata] -> [CompileMetadata] ->-  CompileInfoIO (LanguageModule SourcePos,([CategoryName],[CategoryName]))-loadLanguageModule p ns2 ex em fs deps1 deps2 = do-  let public = Set.fromList $ map cmPath deps1-  let deps2' = filter (\cm -> not $ cmPath cm `Set.member` public) deps2-  let ns0 = filter (not . isNoNamespace) $ getNamespacesForDeps deps1-  let ns1 = filter (not . isNoNamespace) $ getNamespacesForDeps deps2'-  (ps0,_,  tsA0,_)    <- fmap merge $ mapErrorsM processAll deps1-  (ps1,_,  tsA1,_)    <- fmap merge $ mapErrorsM processAll deps2'-  (ps2,xs2,tsA2,tsB2) <- loadAllPublic "" fs-  let cm = LanguageModule {-      lmPublicNamespaces = ns0,-      lmPrivateNamespaces = ns1,-      lmLocalNamespaces = [ns2],-      lmPublicDeps = ps0,-      lmPrivateDeps = ps1,-      lmTestingDeps = tsA0++tsA1,-      lmPublicLocal = map (setCategoryNamespace ns2) ps2,-      lmPrivateLocal = map (setCategoryNamespace ns2) xs2,-      lmTestingLocal = map (setCategoryNamespace ns2) $ tsA2 ++ tsB2,+createLanguageModule :: [CategoryName] -> ExprMap c ->+  [WithVisibility (AnyCategory c)] -> LanguageModule c+createLanguageModule ex em cs = lm where+  lm = LanguageModule {+      lmPublicNamespaces  = map wvData $ apply ns [with    FromDependency,without ModuleOnly,without TestsOnly],+      lmPrivateNamespaces = map wvData $ apply ns [with    FromDependency,with    ModuleOnly,without TestsOnly],+      lmLocalNamespaces   = map wvData $ apply ns [without FromDependency],+      lmPublicDeps        = map wvData $ apply cs [with    FromDependency,without ModuleOnly,without TestsOnly],+      lmPrivateDeps       = map wvData $ apply cs [with    FromDependency,with    ModuleOnly,without TestsOnly],+      lmTestingDeps       = map wvData $ apply cs [with    FromDependency,with TestsOnly],+      lmPublicLocal       = map wvData $ apply cs [without FromDependency,without ModuleOnly,without TestsOnly],+      lmPrivateLocal      = map wvData $ apply cs [without FromDependency,with    ModuleOnly,without TestsOnly],+      lmTestingLocal      = map wvData $ apply cs [without FromDependency,with TestsOnly],       lmExternal = ex,-      lmExprMap = em+      lmExprMap  = em     }-  return (cm,(map getCategoryName $ ps2++tsA2,map getCategoryName $ xs2++tsB2)) where-    loadPublic p2 p3 = parsePublicSource p3 >>= return . uncurry (partition p2)-    partition p2 pragmas cs-      -- Allow ModuleOnly when the path is the same. Only needed for tests.-      | p2 == p && (any isTestsOnly pragmas) = ([],[],cs,[])-      | p2 == p                              = (cs,[],[],[])-      | (any isModuleOnly pragmas) && (any isTestsOnly pragmas) = ([],[],[],cs)-      | (any isTestsOnly pragmas)                               = ([],[],cs,[])-      | (any isModuleOnly pragmas)                              = ([],cs,[],[])-      | otherwise                                               = (cs,[],[],[])-    processAll dep = do-      let dep' = getSourceFilesForDeps [dep]-      loadAllPublic (cmPath dep) dep'-    loadAllPublic p2 fs2 = do-      fs2' <- zipWithContents p fs2-      as <- mapErrorsM (loadPublic p2) fs2'-      return $ merge as-    merge = foldl merge4 ([],[],[],[])-    merge4 (ps1,xs1,tsA1,tsB1) (ps2,xs2,tsA2,tsB2) = (ps1++ps2,xs1++xs2,tsA1++tsA2,tsB1++tsB2)+  ns = map (mapCodeVisibility getCategoryNamespace) cs+  with    v = hasCodeVisibility v+  without v = not . hasCodeVisibility v+  apply = foldr filter++warnPublic :: PathIOHandler r => r -> FilePath -> [CategoryName] ->+  [CategoryName] -> [ObjectFile] -> [FilePath] -> CompileInfoIO ()+warnPublic resolver p pc dc os = mapErrorsM_ checkPublic where+  checkPublic d = do+    d2 <- resolveModule resolver p d+    when (not $ d2 `Set.member` neededPublic) $ compileWarningM $ "Dependency \"" ++ d ++ "\" does not need to be public"+  pc' = Set.fromList pc+  dc' = Set.fromList dc+  neededPublic = Set.fromList $ concat $ map checkDep os+  checkDep (CategoryObjectFile (CategoryIdentifier _ n _) ds _)+    | n `Set.member` pc' = map ciPath $ filter ((`Set.member` dc') . ciCategory) ds+  checkDep _ = []

@@ -1,34 +0,0 @@-{- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry--Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at--    http://www.apache.org/licenses/LICENSE-2.0--Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.------------------------------------------------------------------------------ -}---- Author: Kevin P. Barry [ta0kira@gmail.com]--{-# LANGUAGE Safe #-}--module Cli.Paths (-  PathIOHandler(..),-) where--import Control.Monad.IO.Class--import Base.CompileError---class PathIOHandler r where-  resolveModule     :: (MonadIO m, CompileErrorM m) => r -> FilePath -> FilePath -> m FilePath-  isSystemModule    :: (MonadIO m, CompileErrorM m) => r -> FilePath -> FilePath -> m Bool-  resolveBaseModule :: (MonadIO m, CompileErrorM m) => r -> m FilePath-  isBaseModule      :: (MonadIO m, CompileErrorM m) => r -> FilePath -> m Bool

@@ -24,6 +24,7 @@ import Data.List (intercalate) import System.Directory import System.FilePath+import System.IO import System.Posix.Temp (mkdtemp) import qualified Data.Map as Map import qualified Data.Set as Set@@ -33,9 +34,9 @@ import Base.Mergeable import Cli.CompileOptions import Cli.Compiler-import Cli.Paths import Cli.Programs import Module.CompileMetadata+import Module.Paths import Module.ProcessMetadata  @@ -72,7 +73,7 @@         (fromCompileInfo rs) <??           ("\nPassed: " ++ show passed ++ " test(s), Failed: " ++ show failed ++ " test(s)")       | otherwise =-        compileWarningM $ "\nPassed: " ++ show passed ++ " test(s), Failed: " ++ show failed ++ " test(s)"+        errorFromIO $ hPutStrLn stderr $ "\nPassed: " ++ show passed ++ " test(s), Failed: " ++ show failed ++ " test(s)"  runCompiler resolver backend (CompileOptions _ is is2 _ _ _ p (CompileFast c fn f2) f) = do   dir <- errorFromIO $ mkdtemp "/tmp/zfast_"@@ -167,7 +168,7 @@     deps1 <- loadPublicDeps compilerHash f Map.empty (base:as)     deps2 <- loadPublicDeps compilerHash f (mapMetadata deps1) as2     path <- errorFromIO $ canonicalizePath p-    createModuleTemplates path d deps1 deps2 <?? ("In module \"" ++ d' ++ "\"")+    createModuleTemplates resolver path d deps1 deps2 <?? ("In module \"" ++ d' ++ "\"")  runCompiler resolver backend (CompileOptions h is is2 ds es ep p m f) = mapM_ compileSingle ds where   compileSingle d = do

@@ -37,6 +37,7 @@ import CompilerCxx.Category import CompilerCxx.Naming import Module.CompileMetadata+import Module.Paths import Module.ProcessMetadata import Parser.SourceFile import Types.IntegrationTest@@ -111,10 +112,14 @@            (TestCommandResult s2' out err) <- runTestCommand b command            case (s2,s2') of                 (True,False) -> mergeAllM $ map compileErrorM $ warnings ++ err ++ out-                (False,True) -> compileErrorM "Expected runtime failure"+                (False,True) ->+                  if null warnings+                     then compileErrorM "Expected runtime failure"+                     else mergeAllM [compileErrorM "Expected runtime failure",+                                     (mergeAllM $ map compileErrorM warnings) <?? "\nOutput from compiler:"]                 _ -> do                   let result2 = checkContent rs es warnings err out-                  when (not $ isCompileError result) $ errorFromIO $ removeDirectoryRecursive dir+                  when (not $ isCompileError result2) $ errorFromIO $ removeDirectoryRecursive dir                   fromCompileInfo result2      compileAll e cs ds = do

@@ -28,6 +28,7 @@   CompilerState,   ExpressionType,   LoopSetup(..),+  JumpType(..),   MemberValue(..),   ReturnVariable(..),   (<???),@@ -56,12 +57,14 @@   csRequiresTypes,   csResolver,   csSameType,-  csSetNoReturn,+  csSetJumpType,   csSetNoTrace,+  csStartCleanup,   csStartLoop,   csUpdateAssigned,   csWrite,   getCleanContext,+  isLoopBoundary,   resetBackgroundStateT,   runDataCompiler, ) where@@ -108,11 +111,12 @@   ccPrimNamedReturns :: a -> m [ReturnVariable]   ccIsUnreachable :: a -> m Bool   ccIsNamedReturns :: a -> m Bool-  ccSetNoReturn :: a -> m a+  ccSetJumpType :: a -> JumpType -> m a   ccStartLoop :: a -> LoopSetup s -> m a   ccGetLoop :: a -> m (LoopSetup s)+  ccStartCleanup :: a -> m a   ccPushCleanup :: a -> CleanupSetup a s -> m a-  ccGetCleanup :: a -> m (CleanupSetup a s)+  ccGetCleanup :: a -> JumpType -> m (CleanupSetup a s)   ccExprLookup :: a -> [c] -> String -> m (Expression c)   ccSetNoTrace :: a -> Bool -> m a   ccGetNoTrace :: a -> m Bool@@ -145,8 +149,22 @@   CleanupSetup {     csReturnContext :: [a],     csCleanup :: s-  }+  } |+  LoopBoundary +isLoopBoundary :: CleanupSetup a s -> Bool+isLoopBoundary LoopBoundary = True+isLoopBoundary _            = False++data JumpType =+  NextStatement |+  JumpContinue |+  JumpBreak |+  JumpReturn |+  JumpFailCall |+  JumpMax  -- Max value for use as initial state in folds.+  deriving (Eq,Ord,Show)+ instance Show c => Show (VariableValue c) where   show (VariableValue c _ t _) = show t ++ formatFullContextBrace c @@ -232,20 +250,23 @@ csIsNamedReturns :: CompilerContext c m s a => CompilerState a m Bool csIsNamedReturns = fmap ccIsNamedReturns get >>= lift -csSetNoReturn :: CompilerContext c m s a => CompilerState a m ()-csSetNoReturn = fmap ccSetNoReturn get >>= lift >>= put+csSetJumpType :: CompilerContext c m s a => JumpType -> CompilerState a m ()+csSetJumpType j = fmap (\x -> ccSetJumpType x j) get >>= lift >>= put  csStartLoop :: CompilerContext c m s a => LoopSetup s -> CompilerState a m () csStartLoop l = fmap (\x -> ccStartLoop x l) get >>= lift >>= put +csStartCleanup :: CompilerContext c m s a => CompilerState a m ()+csStartCleanup = fmap (\x -> ccStartCleanup x) get >>= lift >>= put+ csGetLoop :: CompilerContext c m s a => CompilerState a m (LoopSetup s) csGetLoop = fmap ccGetLoop get >>= lift  csPushCleanup :: CompilerContext c m s a => CleanupSetup a s -> CompilerState a m () csPushCleanup l = fmap (\x -> ccPushCleanup x l) get >>= lift >>= put -csGetCleanup :: CompilerContext c m s a => CompilerState a m (CleanupSetup a s)-csGetCleanup = fmap ccGetCleanup get >>= lift+csGetCleanup :: CompilerContext c m s a => JumpType -> CompilerState a m (CleanupSetup a s)+csGetCleanup j = fmap (\x -> ccGetCleanup x j) get >>= lift  csExprLookup :: CompilerContext c m s a => [c] -> String -> CompilerState a m (Expression c) csExprLookup c n = fmap (\x -> ccExprLookup x c n) get >>= lift

@@ -58,12 +58,15 @@     pcFunctions :: Map.Map FunctionName (ScopedFunction c),     pcVariables :: Map.Map VariableName (VariableValue c),     pcReturns :: ReturnValidation c,+    pcJumpType :: JumpType,+    pcIsNamed :: Bool,     pcPrimNamed :: [ReturnVariable],     pcRequiredTypes :: Set.Set CategoryName,     pcOutput :: [String],     pcDisallowInit :: Bool,     pcLoopSetup :: LoopSetup [String],-    pcCleanupSetup :: CleanupSetup (ProcedureContext c) [String],+    pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]],+    pcInCleanup :: Bool,     pcExprMap :: ExprMap c,     pcNoTrace :: Bool   }@@ -75,10 +78,10 @@     vpReturns :: Positional (PassedValue c)   } |   ValidateNames {+    vnNames :: Positional VariableName,     vnTypes :: Positional (PassedValue c),     vnRemaining :: Map.Map VariableName (PassedValue c)-  } |-  UnreachableCode+  }  instance (Show c, MergeableM m, CompileErrorM m) =>   CompilerContext c m [String] (ProcedureContext c) where@@ -106,12 +109,15 @@       pcFunctions = pcFunctions ctx,       pcVariables = pcVariables ctx,       pcReturns = pcReturns ctx,+      pcJumpType = pcJumpType ctx,+      pcIsNamed = pcIsNamed ctx,       pcPrimNamed = pcPrimNamed ctx,       pcRequiredTypes = Set.union (pcRequiredTypes ctx) ts,       pcOutput = pcOutput ctx,       pcDisallowInit = pcDisallowInit ctx,       pcLoopSetup = pcLoopSetup ctx,       pcCleanupSetup = pcCleanupSetup ctx,+      pcInCleanup = pcInCleanup ctx,       pcExprMap = pcExprMap ctx,       pcNoTrace = pcNoTrace ctx     }@@ -226,13 +232,13 @@     case n `Map.lookup` pcVariables ctx of           (Just v) -> return v           _ -> compileErrorM $ "Variable " ++ show n ++ " is not defined" ++-                              formatFullContextBrace c+                               formatFullContextBrace c   ccAddVariable ctx c n t = do     case n `Map.lookup` pcVariables ctx of           Nothing -> return ()           (Just v) -> compileErrorM $ "Variable " ++ show n ++-                                    formatFullContextBrace c ++-                                    " is already defined: " ++ show v+                                      formatFullContextBrace c +++                                      " is already defined: " ++ show v     return $ ProcedureContext {         pcScope = pcScope ctx,         pcType = pcType ctx,@@ -247,18 +253,21 @@         pcFunctions = pcFunctions ctx,         pcVariables = Map.insert n t (pcVariables ctx),         pcReturns = pcReturns ctx,+        pcJumpType = pcJumpType ctx,+        pcIsNamed = pcIsNamed ctx,         pcPrimNamed = pcPrimNamed ctx,         pcRequiredTypes = pcRequiredTypes ctx,         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,         pcCleanupSetup = pcCleanupSetup ctx,+        pcInCleanup = pcInCleanup ctx,         pcExprMap = pcExprMap ctx,         pcNoTrace = pcNoTrace ctx       }   ccCheckVariableInit ctx c n =     case pcReturns ctx of-         ValidateNames _ na -> when (n `Map.member` na) $+         ValidateNames _ _ na -> when (n `Map.member` na) $            compileErrorM $ "Named return " ++ show n ++ " might not be initialized" ++ formatFullContextBrace c          _ -> return ()   ccWrite ctx ss = return $@@ -276,12 +285,15 @@       pcFunctions = pcFunctions ctx,       pcVariables = pcVariables ctx,       pcReturns = pcReturns ctx,+      pcJumpType = pcJumpType ctx,+      pcIsNamed = pcIsNamed ctx,       pcPrimNamed = pcPrimNamed ctx,       pcRequiredTypes = pcRequiredTypes ctx,       pcOutput = pcOutput ctx ++ ss,       pcDisallowInit = pcDisallowInit ctx,       pcLoopSetup = pcLoopSetup ctx,       pcCleanupSetup = pcCleanupSetup ctx,+      pcInCleanup = pcInCleanup ctx,       pcExprMap = pcExprMap ctx,       pcNoTrace = pcNoTrace ctx     }@@ -300,17 +312,20 @@         pcFunctions = pcFunctions ctx,         pcVariables = pcVariables ctx,         pcReturns = pcReturns ctx,+        pcJumpType = pcJumpType ctx,+        pcIsNamed = pcIsNamed ctx,         pcPrimNamed = pcPrimNamed ctx,         pcRequiredTypes = pcRequiredTypes ctx,         pcOutput = [],         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,         pcCleanupSetup = pcCleanupSetup ctx,+        pcInCleanup = pcInCleanup ctx,         pcExprMap = pcExprMap ctx,         pcNoTrace = pcNoTrace ctx       }   ccUpdateAssigned ctx n = update (pcReturns ctx) where-    update (ValidateNames ts ra) = return $ ProcedureContext {+    update (ValidateNames ns ts ra) = return $ ProcedureContext {         pcScope = pcScope ctx,         pcType = pcType ctx,         pcExtParams = pcExtParams ctx,@@ -323,13 +338,16 @@         pcParamScopes = pcParamScopes ctx,         pcFunctions = pcFunctions ctx,         pcVariables = pcVariables ctx,-        pcReturns = ValidateNames ts $ Map.delete n ra,+        pcReturns = ValidateNames ns ts $ Map.delete n ra,+        pcJumpType = pcJumpType ctx,+        pcIsNamed = pcIsNamed ctx,         pcPrimNamed = pcPrimNamed ctx,         pcRequiredTypes = pcRequiredTypes ctx,         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,         pcCleanupSetup = pcCleanupSetup ctx,+        pcInCleanup = pcInCleanup ctx,         pcExprMap = pcExprMap ctx,         pcNoTrace = pcNoTrace ctx       }@@ -347,30 +365,34 @@       pcParamScopes = pcParamScopes ctx,       pcFunctions = pcFunctions ctx,       pcVariables = pcVariables ctx,-      pcReturns = combineSeries (pcReturns ctx) inherited,+      pcReturns = returns,+      pcJumpType = jump,+      pcIsNamed = pcIsNamed ctx,       pcPrimNamed = pcPrimNamed ctx,       pcRequiredTypes = pcRequiredTypes ctx,       pcOutput = pcOutput ctx,       pcDisallowInit = pcDisallowInit ctx,       pcLoopSetup = pcLoopSetup ctx,       pcCleanupSetup = pcCleanupSetup ctx,+      pcInCleanup = pcInCleanup ctx,       pcExprMap = pcExprMap ctx,       pcNoTrace = pcNoTrace ctx     }     where-      inherited = foldr combineParallel UnreachableCode (map pcReturns cs)-      combineSeries _ UnreachableCode = UnreachableCode-      combineSeries UnreachableCode _ = UnreachableCode-      combineSeries r@(ValidatePositions _) _ = r-      combineSeries _ r@(ValidatePositions _) = r-      combineSeries (ValidateNames ts ra1) (ValidateNames _ ra2) = ValidateNames ts $ Map.intersection ra1 ra2-      combineParallel UnreachableCode r = r-      combineParallel r UnreachableCode = r-      combineParallel (ValidateNames ts ra1) (ValidateNames _ ra2) = ValidateNames ts $ Map.union ra1 ra2-      combineParallel r@(ValidatePositions _) _ = r-      combineParallel _ r@(ValidatePositions _) = r+      (returns,jump) = combineSeries (pcReturns ctx,pcJumpType ctx) inherited+      combineSeries (r@(ValidatePositions _),j1) (_,j2) = (r,max j1 j2)+      combineSeries (_,j1) (r@(ValidatePositions _),j2) = (r,max j1 j2)+      combineSeries (ValidateNames ns ts ra1,j1) (ValidateNames _ _ ra2,j2) = (ValidateNames ns ts $ Map.intersection ra1 ra2,max j1 j2)+      inherited = foldr combineParallel (ValidateNames (Positional []) (Positional []) Map.empty,JumpMax) $ zip (map pcReturns cs) (map pcJumpType cs)+      combineParallel (_,j1) (r,j2)+        -- Ignore a branch if it jumps to a higher scope.+        | (if pcInCleanup ctx then j1 > JumpReturn else j1 > NextStatement) = (r,min j1 j2)+      combineParallel (ValidateNames ns ts ra1,j1) (ValidateNames _ _ ra2,j2) = (ValidateNames ns ts $ Map.union ra1 ra2,min j1 j2)+      combineParallel (r@(ValidatePositions _),j1) (_,j2) = (r,min j1 j2)+      combineParallel (_,j1) (r@(ValidatePositions _),j2) = (r,min j1 j2)   ccRegisterReturn ctx c vs = do-    check (pcReturns ctx)+    when (pcInCleanup ctx) $ compileErrorM $ "Explicit return at " ++ formatFullContext c ++ " not allowed in cleanup"+    returns <- check (pcReturns ctx)     return $ ProcedureContext {         pcScope = pcScope ctx,         pcType = pcType ctx,@@ -384,13 +406,16 @@         pcParamScopes = pcParamScopes ctx,         pcFunctions = pcFunctions ctx,         pcVariables = pcVariables ctx,-        pcReturns = UnreachableCode,+        pcReturns = returns,+        pcJumpType = JumpReturn,+        pcIsNamed = pcIsNamed ctx,         pcPrimNamed = pcPrimNamed ctx,         pcRequiredTypes = pcRequiredTypes ctx,         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,         pcCleanupSetup = pcCleanupSetup ctx,+        pcInCleanup = pcInCleanup ctx,         pcExprMap = pcExprMap ctx,         pcNoTrace = pcNoTrace ctx       }@@ -404,7 +429,7 @@           ("In procedure return at " ++ formatFullContext c)         processPairs_ checkReturnType rs (Positional $ zip ([0..] :: [Int]) $ pValues vs') <??           ("In procedure return at " ++ formatFullContext c)-        return ()+        return (ValidatePositions rs)         where           checkReturnType ta0@(PassedValue _ t0) (n,t) = do             r <- ccResolver ctx@@ -412,22 +437,20 @@             checkValueTypeMatch r pa t t0 <??               ("Cannot convert " ++ show t ++ " to " ++ show ta0 ++ " in return " ++                show n ++ " at " ++ formatFullContext c)-      check (ValidateNames ts ra) =+      check (ValidateNames ns ts ra) = do         case vs of-             Just _ -> check (ValidatePositions ts)-             Nothing -> mergeAllM $ map alwaysError $ Map.toList ra where-               alwaysError (n,t) = compileErrorM $ "Named return " ++ show n ++ " (" ++ show t ++-                                                  ") might not have been set before return at " ++-                                                  formatFullContext c-      check _ = return ()+             Just _ -> check (ValidatePositions ts) >> return ()+             Nothing -> mergeAllM $ map alwaysError $ Map.toList ra+        return (ValidateNames ns ts Map.empty)+      alwaysError (n,t) = compileErrorM $ "Named return " ++ show n ++ " (" ++ show t +++                                          ") might not have been set before return at " +++                                          formatFullContext c   ccPrimNamedReturns = return . pcPrimNamed-  ccIsUnreachable ctx = return $ match (pcReturns ctx) where-    match UnreachableCode = True-    match _                 = False-  ccIsNamedReturns ctx = return $ match (pcReturns ctx) where-    match (ValidateNames _ _) = True-    match _                   = False-  ccSetNoReturn ctx =+  ccIsUnreachable ctx+    | pcInCleanup ctx = return $ pcJumpType ctx > JumpReturn+    | otherwise       = return $ pcJumpType ctx > NextStatement+  ccIsNamedReturns = return . pcIsNamed+  ccSetJumpType ctx j =     return $ ProcedureContext {         pcScope = pcScope ctx,         pcType = pcType ctx,@@ -441,13 +464,16 @@         pcParamScopes = pcParamScopes ctx,         pcFunctions = pcFunctions ctx,         pcVariables = pcVariables ctx,-        pcReturns = UnreachableCode,+        pcReturns = pcReturns ctx,+        pcJumpType = j,+        pcIsNamed = pcIsNamed ctx,         pcPrimNamed = pcPrimNamed ctx,         pcRequiredTypes = pcRequiredTypes ctx,         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,         pcCleanupSetup = pcCleanupSetup ctx,+        pcInCleanup = pcInCleanup ctx,         pcExprMap = pcExprMap ctx,         pcNoTrace = pcNoTrace ctx       }@@ -466,17 +492,21 @@         pcFunctions = pcFunctions ctx,         pcVariables = pcVariables ctx,         pcReturns = pcReturns ctx,+        pcJumpType = pcJumpType ctx,+        pcIsNamed = pcIsNamed ctx,         pcPrimNamed = pcPrimNamed ctx,         pcRequiredTypes = pcRequiredTypes ctx,         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = l,-        pcCleanupSetup = pcCleanupSetup ctx,+        pcCleanupSetup = LoopBoundary:(pcCleanupSetup ctx),+        pcInCleanup = pcInCleanup ctx,         pcExprMap = pcExprMap ctx,         pcNoTrace = pcNoTrace ctx       }   ccGetLoop = return . pcLoopSetup-  ccPushCleanup ctx (CleanupSetup cs ss) =+  ccStartCleanup ctx = do+    let vars = protectReturns (pcReturns ctx) (pcVariables ctx)     return $ ProcedureContext {         pcScope = pcScope ctx,         pcType = pcType ctx,@@ -489,19 +519,60 @@         pcIntFilters = pcIntFilters ctx,         pcParamScopes = pcParamScopes ctx,         pcFunctions = pcFunctions ctx,+        pcVariables = vars,+        pcReturns = pcReturns ctx,+        pcJumpType = pcJumpType ctx,+        pcIsNamed = pcIsNamed ctx,+        pcPrimNamed = pcPrimNamed ctx,+        pcRequiredTypes = pcRequiredTypes ctx,+        pcOutput = pcOutput ctx,+        pcDisallowInit = pcDisallowInit ctx,+        pcLoopSetup = pcLoopSetup ctx,+        pcCleanupSetup = pcCleanupSetup ctx,+        pcInCleanup = True,+        pcExprMap = pcExprMap ctx,+        pcNoTrace = pcNoTrace ctx+      }+    where+      protectReturns (ValidateNames ns _ _) vs = foldr protect vs (pValues ns)+      protectReturns _                      vs = vs+      protect n vs =+        case n `Map.lookup` vs of+             Just (VariableValue c s@LocalScope t _) -> Map.insert n (VariableValue c s t False) vs+             _ -> vs+  ccPushCleanup ctx cs =+    return $ ProcedureContext {+        pcScope = pcScope ctx,+        pcType = pcType ctx,+        pcExtParams = pcExtParams ctx,+        pcIntParams = pcIntParams ctx,+        pcMembers = pcMembers ctx,+        pcCategories = pcCategories ctx,+        pcAllFilters = pcAllFilters ctx,+        pcExtFilters = pcExtFilters ctx,+        pcIntFilters = pcIntFilters ctx,+        pcParamScopes = pcParamScopes ctx,+        pcFunctions = pcFunctions ctx,         pcVariables = pcVariables ctx,         pcReturns = pcReturns ctx,+        pcJumpType = pcJumpType ctx,+        pcIsNamed = pcIsNamed ctx,         pcPrimNamed = pcPrimNamed ctx,         pcRequiredTypes = pcRequiredTypes ctx,         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,-        pcCleanupSetup = CleanupSetup (cs ++ (csReturnContext $ pcCleanupSetup ctx))-                                      (ss ++ (csCleanup $ pcCleanupSetup ctx)),+        pcCleanupSetup = cs:(pcCleanupSetup ctx),+        pcInCleanup = pcInCleanup ctx,         pcExprMap = pcExprMap ctx,         pcNoTrace = pcNoTrace ctx       }-  ccGetCleanup = return . pcCleanupSetup+  ccGetCleanup ctx j = return combined where+    combined+      | j == JumpReturn                   = combine $ filter    (not . isLoopBoundary) $ pcCleanupSetup ctx+      | j == JumpBreak || j == JumpReturn = combine $ takeWhile (not . isLoopBoundary) $ pcCleanupSetup ctx+      | otherwise = CleanupSetup [] []+    combine cs = CleanupSetup (concat $ map csReturnContext cs) (concat $ map csCleanup cs)   ccExprLookup ctx c n =     case n `Map.lookup` pcExprMap ctx of          Nothing -> compileErrorM $ "Env expression " ++ n ++ " is not defined" ++ formatFullContextBrace c@@ -521,12 +592,15 @@         pcFunctions = pcFunctions ctx,         pcVariables = pcVariables ctx,         pcReturns = pcReturns ctx,+        pcJumpType = pcJumpType ctx,+        pcIsNamed = pcIsNamed ctx,         pcPrimNamed = pcPrimNamed ctx,         pcRequiredTypes = pcRequiredTypes ctx,         pcOutput = pcOutput ctx,         pcDisallowInit = pcDisallowInit ctx,         pcLoopSetup = pcLoopSetup ctx,         pcCleanupSetup = pcCleanupSetup ctx,+        pcInCleanup = pcInCleanup ctx,         pcExprMap = pcExprMap ctx,         pcNoTrace = t       }

@@ -71,13 +71,16 @@       pcParamScopes = sa,       pcFunctions = fa,       pcVariables = Map.union builtin members,-      pcReturns = UnreachableCode,+      pcReturns = ValidatePositions (Positional []),+      pcJumpType = NextStatement,+      pcIsNamed = False,       pcPrimNamed = [],       pcRequiredTypes = Set.empty,       pcOutput = [],       pcDisallowInit = True,       pcLoopSetup = NotInLoop,-      pcCleanupSetup = CleanupSetup [] [],+      pcCleanupSetup = [],+      pcInCleanup = False,       pcExprMap = em,       pcNoTrace = False     }@@ -89,7 +92,7 @@                     (ExecutableProcedure _ _ _ _ as2 rs2 _) = do   rs' <- if isUnnamedReturns rs2             then return $ ValidatePositions rs1-            else fmap (ValidateNames rs1 . Map.fromList) $ processPairs pairOutput rs1 (nrNames rs2)+            else fmap (ValidateNames (fmap ovName $ nrNames rs2) rs1 . Map.fromList) $ processPairs pairOutput rs1 (nrNames rs2)   va' <- updateArgVariables va as1 as2   va'' <- updateReturnVariables va' rs1 rs2   let pa' = if s == CategoryScope@@ -130,12 +133,15 @@       pcFunctions = fa,       pcVariables = va'',       pcReturns = rs',+      pcJumpType = NextStatement,+      pcIsNamed = not (isUnnamedReturns rs2),       pcPrimNamed = ns,       pcRequiredTypes = Set.empty,       pcOutput = [],       pcDisallowInit = False,       pcLoopSetup = NotInLoop,-      pcCleanupSetup = CleanupSetup [] [],+      pcCleanupSetup = [],+      pcInCleanup = False,       pcExprMap = em,       pcNoTrace = False     }@@ -157,12 +163,15 @@     pcFunctions = Map.empty,     pcVariables = Map.empty,     pcReturns = ValidatePositions (Positional []),+    pcJumpType = NextStatement,+    pcIsNamed = False,     pcPrimNamed = [],     pcRequiredTypes = Set.empty,     pcOutput = [],     pcDisallowInit = False,     pcLoopSetup = NotInLoop,-    pcCleanupSetup = CleanupSetup [] [],+    pcCleanupSetup = [],+    pcInCleanup = False,     pcExprMap = em,     pcNoTrace = False   }

@@ -159,18 +159,17 @@                      CompilerContext c m [String] a) =>   a -> Procedure c -> CompilerState a m a compileProcedure ctx (Procedure _ ss) = do-  ctx' <- lift $ execStateT (sequence $ map compileOne ss) ctx+  ctx' <- lift $ execStateT (sequence $ map compile ss) ctx   return ctx' where-    compileOne s = do-      warnUnreachable s-      s' <- resetBackgroundStateT $ compileStatement s-      return s'-    warnUnreachable s = do+    compile s = do       unreachable <- csIsUnreachable-      lift $ when unreachable $-                  compileWarningM $ "Statement at " ++-                                    formatFullContext (getStatementContext s) ++-                                    " is unreachable"+      if unreachable+         then lift $ compileWarningM $ "Statement at " +++                                       formatFullContext (getStatementContext s) +++                                       " is unreachable (skipping compilation)"+         else do+           s' <- resetBackgroundStateT $ compileStatement s+           return s'  maybeSetTrace :: (Show c, CompileErrorM m, MergeableM m,                   CompilerContext c m [String] a) =>@@ -211,6 +210,10 @@        NotInLoop ->          lift $ compileErrorM $ "Using break outside of while is no allowed" ++ formatFullContextBrace c        _ -> return ()+  (CleanupSetup cs ss) <- csGetCleanup JumpBreak+  sequence_ $ map (csInheritReturns . (:[])) cs+  csWrite ss+  csSetJumpType JumpBreak   csWrite ["break;"] compileStatement (LoopContinue c) = do   loop <- csGetLoop@@ -218,6 +221,10 @@        NotInLoop ->          lift $ compileErrorM $ "Using continue outside of while is no allowed" ++ formatFullContextBrace c        _ -> return ()+  (CleanupSetup cs ss) <- csGetCleanup JumpContinue+  sequence_ $ map (csInheritReturns . (:[])) cs+  csWrite ss+  csSetJumpType JumpContinue   csWrite $ ["{"] ++ lsUpdate loop ++ ["}","continue;"] compileStatement (FailCall c e) = do   csRequiresTypes (Set.fromList [BuiltinFormatted,BuiltinString])@@ -229,7 +236,7 @@   fa <- csAllFilters   lift $ (checkValueTypeMatch_ r fa t0 formattedRequiredValue) <??     ("In fail call at " ++ formatFullContext c)-  csSetNoReturn+  csSetJumpType JumpFailCall   maybeSetTrace c   csWrite ["BUILTIN_FAIL(" ++ useAsUnwrapped e0 ++ ")"] compileStatement (IgnoreValues c e) = do@@ -394,40 +401,47 @@   ScopedBlock c -> CompilerState a m () compileScopedBlock s = do   let (vs,p,cl,st) = rewriteScoped s-  -- Capture context so we can discard scoped variable names.-  ctx0 <- getCleanContext   r <- csResolver   fa <- csAllFilters   sequence_ $ map (createVariable r fa) vs-  ctxP <- compileProcedure ctx0 p-  (ctxP',cl',ctxCl) <-+  -- Compile the scoped block for the base context of the statement and the+  -- cleanup block.+  ctxP0 <- getCleanContext >>= flip compileProcedure p+  -- Precompile the statement to get static analysis of returns, for use when+  -- compiling the cleanup block. The output will be discarded; the statement is+  -- compiled with cleanup below.+  ctxCl0 <- do+    ctxS0 <- lift $ execStateT (sequence $ map showVariable vs) ctxP0+    ctxS0' <- compileProcedure ctxS0 (Procedure [] [st])+    lift $ ccInheritReturns ctxP0 [ctxS0']+  (ctxP,cl',ctxCl) <-     case cl of          Just p2 -> do-           ctx0' <- lift $ ccClearOutput ctxP-           ctxCl <- compileProcedure ctx0' p2+           ctxCl0' <- lift $ ccStartCleanup ctxCl0+           ctxCl <- compileProcedure ctxCl0' p2            p2' <- lift $ ccGetOutput ctxCl            noTrace <- csGetNoTrace-           -- TODO: It might be helpful to add a new trace-context line for this-           -- so that the line that triggered the cleanup is still in the trace.            let p2'' = if noTrace-                      then []-                      else ["{",startCleanupTracing] ++ p2' ++ ["}"]-           ctxP' <- lift $ ccPushCleanup ctxP (CleanupSetup [ctxCl] p2'')-           return (ctxP',p2'',ctxCl)-         Nothing -> return (ctxP,[],ctxP)+                         then []+                         else ["{",startCleanupTracing] ++ p2' ++ ["}"]+           ctxP <- lift $ ccPushCleanup ctxP0 (CleanupSetup [ctxCl] p2'')+           return (ctxP,p2'',ctxCl)+         Nothing -> return (ctxP0,[],ctxP0)   -- Make variables to be created visible *after* p has been compiled so that p   -- can't refer to them.-  ctxP'' <- lift $ execStateT (sequence $ map showVariable vs) ctxP'-  ctxS <- compileProcedure ctxP'' (Procedure [] [st])-  csWrite ["{"]-  (lift $ ccGetOutput ctxS) >>= csWrite-  csWrite cl'-  csWrite ["}"]-  sequence_ $ map showVariable vs+  ctxP' <- lift $ execStateT (sequence $ map showVariable vs) ctxP+  ctxS <- compileProcedure ctxP' (Procedure [] [st])   (lift $ ccGetRequired ctxS)  >>= csRequiresTypes   (lift $ ccGetRequired ctxCl) >>= csRequiresTypes   csInheritReturns [ctxS]   csInheritReturns [ctxCl]+  csWrite ["{"]+  (lift $ ccGetOutput ctxS) >>= csWrite+  -- Skip fallthrough cleanup if the emitted output will be unreachable.+  unreachable <- lift $ ccIsUnreachable ctxCl0+  when (not unreachable) $ csWrite cl'+  csWrite ["}"]+  sequence_ $ map showVariable vs   where     createVariable r fa (c,t,n) = do       lift $ validateGeneralInstance r fa (vtType t) <??@@ -941,10 +955,11 @@   return $ scoped ++ paramName p expandGeneralInstance t = lift $ compileErrorM $ "Type " ++ show t ++ " contains unresolved types" -doImplicitReturn :: (Show c,CompilerContext c m [String] a) => [c] -> CompilerState a m ()+doImplicitReturn :: (CompileErrorM m, Show c, CompilerContext c m [String] a) =>+  [c] -> CompilerState a m () doImplicitReturn c = do   named <- csIsNamedReturns-  (CleanupSetup cs ss) <- csGetCleanup+  (CleanupSetup cs ss) <- csGetCleanup JumpReturn   when (not $ null ss) $ do     sequence_ $ map (csInheritReturns . (:[])) cs     csWrite ss@@ -959,13 +974,21 @@     assign (ReturnVariable i n t) =       "returns.At(" ++ show i ++ ") = " ++ useAsUnwrapped (readStoredVariable False t $ variableName n) ++ ";" -autoPositionalCleanup :: (CompilerContext c m [String] a) => ExprValue -> CompilerState a m ()+autoPositionalCleanup :: (CompileErrorM m, CompilerContext c m [String] a) =>+  ExprValue -> CompilerState a m () autoPositionalCleanup e = do-  (CleanupSetup cs ss) <- csGetCleanup+  (CleanupSetup cs ss) <- csGetCleanup JumpReturn   if null ss      then csWrite ["return " ++ useAsReturns e ++ ";"]      else do-       csWrite ["{","ReturnTuple returns = " ++ useAsReturns e ++ ";"]+       named <- csIsNamedReturns        sequence_ $ map (csInheritReturns . (:[])) cs-       csWrite ss-       csWrite ["return returns;","}"]+       if named+          then do+            csWrite ["returns = " ++ useAsReturns e ++ ";"]+            csWrite ss+            csWrite ["return returns;"]+          else do+            csWrite ["{","ReturnTuple returns = " ++ useAsReturns e ++ ";"]+            csWrite ss+            csWrite ["return returns;","}"]

@@ -42,8 +42,8 @@ import System.Posix.Temp (mkstemps)  import Base.CompileError-import Cli.Paths import Cli.Programs+import Module.Paths  import Paths_zeolite_lang (getDataFileName,version) @@ -150,6 +150,7 @@   isBaseModule r f = do     b <- resolveBaseModule r     return (f == b)+  zipWithContents _ p fs = fmap (zip $ map fixPath fs) $ mapM (errorFromIO . readFile . (p </>)) fs  potentialSystemPaths :: Resolver -> FilePath -> IO [FilePath] potentialSystemPaths (SimpleResolver ls ps) m = do

@@ -0,0 +1,55 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++{-# LANGUAGE Safe #-}++module Module.Paths (+  PathIOHandler(..),+  fixPath,+  fixPaths,+) where++import Control.Monad.IO.Class+import Data.List (nub,isSuffixOf)+import System.FilePath++import Base.CompileError+++class PathIOHandler r where+  resolveModule     :: (MonadIO m, CompileErrorM m) => r -> FilePath -> FilePath -> m FilePath+  isSystemModule    :: (MonadIO m, CompileErrorM m) => r -> FilePath -> FilePath -> m Bool+  resolveBaseModule :: (MonadIO m, CompileErrorM m) => r -> m FilePath+  isBaseModule      :: (MonadIO m, CompileErrorM m) => r -> FilePath -> m Bool+  zipWithContents   :: (MonadIO m, CompileErrorM m) => r -> FilePath -> [FilePath] -> m [(FilePath,String)]++fixPath :: FilePath -> FilePath+fixPath = foldl (</>) "" . process [] . map dropSlash . splitPath where+  dropSlash "/" = "/"+  dropSlash d+    | isSuffixOf "/" d = reverse $ tail $ reverse d+    | otherwise        = d+  process rs        (".":ds)  = process rs ds+  process ("..":rs) ("..":ds) = process ("..":"..":rs) ds+  process ("/":[])  ("..":ds) = process ("/":[]) ds+  process (_:rs)    ("..":ds) = process rs ds+  process rs        (d:ds)    = process (d:rs) ds+  process rs        _         = reverse rs++fixPaths :: [FilePath] -> [FilePath]+fixPaths = nub . map fixPath

@@ -21,8 +21,6 @@   createCachePath,   eraseCachedData,   findSourceFiles,-  fixPath,-  fixPaths,   getCachedPath,   getCacheRelativePath,   getExprMap,@@ -35,6 +33,7 @@   getSourceFilesForDeps,   isPathConfigured,   isPathUpToDate,+  loadModuleGlobals,   loadModuleMetadata,   loadPrivateDeps,   loadPublicDeps,@@ -51,7 +50,7 @@  import Control.Applicative ((<|>)) import Control.Monad (when)-import Data.List (nub,isSuffixOf)+import Data.List (isSuffixOf) import Data.Maybe (isJust) import System.Directory import System.FilePath@@ -68,6 +67,9 @@ import CompilerCxx.Category (CxxOutput(..)) import Module.CompileMetadata import Module.ParseMetadata -- Not safe, due to Text.Regex.TDFA.+import Module.Paths+import Parser.SourceFile+import Types.Pragma import Types.Procedure (Expression(Literal),ValueLiteral(..)) import Types.TypeCategory import Types.TypeInstance@@ -254,22 +256,6 @@          (autoReadConfig f c) <??             ("Could not parse metadata from \"" ++ p ++ "\"; please recompile") -fixPath :: FilePath -> FilePath-fixPath = foldl (</>) "" . process [] . map dropSlash . splitPath where-  dropSlash "/" = "/"-  dropSlash d-    | isSuffixOf "/" d = reverse $ tail $ reverse d-    | otherwise        = d-  process rs        (".":ds)  = process rs ds-  process ("..":rs) ("..":ds) = process ("..":"..":rs) ds-  process ("/":[])  ("..":ds) = process ("/":[]) ds-  process (_:rs)    ("..":ds) = process rs ds-  process rs        (d:ds)    = process (d:rs) ds-  process rs        _         = reverse rs--fixPaths :: [FilePath] -> [FilePath]-fixPaths = nub . map fixPath- sortCompiledFiles :: [FilePath] -> ([FilePath],[FilePath],[FilePath]) sortCompiledFiles = foldl split ([],[],[]) where   split fs@(hxx,cxx,os) f@@ -388,3 +374,31 @@        Just xs -> [xs]        Nothing -> resolveDep cm ns d resolveDep _ _ d = [UnresolvedCategory d]++loadModuleGlobals :: PathIOHandler r => r -> FilePath -> Namespace -> [FilePath] ->+  [CompileMetadata] -> [CompileMetadata] -> CompileInfoIO ([WithVisibility (AnyCategory SourcePos)])+loadModuleGlobals r p ns2 fs deps1 deps2 = do+  let public = Set.fromList $ map cmPath deps1+  let deps2' = filter (\cm -> not $ cmPath cm `Set.member` public) deps2+  cs0 <- fmap concat $ mapErrorsM (processDeps [FromDependency])            deps1+  cs1 <- fmap concat $ mapErrorsM (processDeps [FromDependency,ModuleOnly]) deps2'+  cs2 <- loadAllPublic ns2 fs+  return (cs0++cs1++cs2) where+    processDeps ss dep = do+      let fs2 = getSourceFilesForDeps [dep]+      cs <- loadAllPublic (cmNamespace dep) fs2+      let cs' = if cmPath dep /= p+                   -- Allow ModuleOnly if the dep is the same module being+                   -- compiled. (Tests load the module being tested as a dep.)+                   then filter (not . hasCodeVisibility ModuleOnly) cs+                   else cs+      return $ map (updateCodeVisibility (Set.union (Set.fromList ss))) cs'+    loadAllPublic ns fs2 = do+      fs2' <- zipWithContents r p fs2+      fmap concat $ mapErrorsM loadPublic fs2'+      where+        loadPublic p3 = do+          (pragmas,cs) <- parsePublicSource p3+          let tags = (if any isTestsOnly  pragmas then [TestsOnly]  else []) +++                     (if any isModuleOnly pragmas then [ModuleOnly] else [])+          return $ map (WithVisibility (Set.fromList tags) . setCategoryNamespace ns) cs

@@ -22,17 +22,40 @@   CodeVisibility(..),   Pragma(..),   TraceType(..),+  WithVisibility(..),   getPragmaContext,+  hasCodeVisibility,   isExprLookup,   isModuleOnly,   isNoTrace,   isSourceContext,   isTestsOnly,   isTraceCreation,+  mapCodeVisibility,+  updateCodeVisibility, ) where +import qualified Data.Set as Set -data CodeVisibility = ModuleOnly | TestsOnly deriving (Show)++data CodeVisibility = ModuleOnly | TestsOnly | FromDependency deriving (Eq,Ord,Show)++data WithVisibility a =+  WithVisibility {+    wvVisibility :: Set.Set CodeVisibility,+    wvData :: a+  }+  deriving (Show)++hasCodeVisibility :: CodeVisibility -> WithVisibility a -> Bool+hasCodeVisibility v = Set.member v . wvVisibility++mapCodeVisibility :: (a -> b) -> WithVisibility a -> WithVisibility b+mapCodeVisibility f (WithVisibility v x) = WithVisibility v (f x)++updateCodeVisibility :: (Set.Set CodeVisibility -> Set.Set CodeVisibility) ->+  WithVisibility a -> WithVisibility a+updateCodeVisibility f (WithVisibility v x) = WithVisibility (f v) x  data TraceType = NoTrace | TraceCreation deriving (Show) 

@@ -49,7 +49,7 @@   test_check_defs() {-  local output=$(do_zeolite -p "$ZEOLITE_PATH" -r tests/check-defs || true)+  local output=$(do_zeolite -p "$ZEOLITE_PATH" -r tests/check-defs -f || true)   if ! echo "$output" | egrep -q 'Type .+ is defined 2 times'; then     show_message 'Expected Type definition error from tests/check-defs:'     echo "$output" 1>&2@@ -64,7 +64,7 @@   test_tests_only() {-  local output=$(do_zeolite -p "$ZEOLITE_PATH" -r tests/tests-only || true)+  local output=$(do_zeolite -p "$ZEOLITE_PATH" -r tests/tests-only -f || true)   if ! echo "$output" | egrep -q 'Definition for Type1 .+ visible category'; then     show_message 'Expected Type1 definition error from tests/tests-only:'     echo "$output" 1>&2@@ -79,7 +79,7 @@   test_tests_only2() {-  local output=$(do_zeolite -p "$ZEOLITE_PATH" -r tests/tests-only2 || true)+  local output=$(do_zeolite -p "$ZEOLITE_PATH" -r tests/tests-only2 -f || true)   if ! echo "$output" | egrep -q 'main.+ Testing'; then     show_message 'Expected Testing definition error from tests/tests-only:'     echo "$output" 1>&2@@ -89,7 +89,7 @@   test_module_only() {-  local output=$(do_zeolite -p "$ZEOLITE_PATH" -R tests/module-only || true)+  local output=$(do_zeolite -p "$ZEOLITE_PATH" -R tests/module-only -f || true)   if ! echo "$output" | egrep -q 'Type1 not found'; then     show_message 'Expected Type1 definition error from tests/module-only:'     echo "$output" 1>&2@@ -103,6 +103,41 @@ }  +test_module_only2() {+  local output=$(do_zeolite -p "$ZEOLITE_PATH" -R tests/module-only2 -f || true)+  if ! echo "$output" | egrep -q 'Type1'; then+    show_message 'Expected Type1 definition error from tests/module-only2:'+    echo "$output" 1>&2+    return 1+  fi+  if echo "$output" | egrep -q 'Type2'; then+    show_message 'Unexpected Type2 definition error from tests/module-only2:'+    echo "$output" 1>&2+    return 1+  fi+  if echo "$output" | egrep -q 'private2'; then+    show_message 'Unexpected private2 definition error from tests/module-only2:'+    echo "$output" 1>&2+    return 1+  fi+}+++test_warn_public() {+  local output=$(do_zeolite -p "$ZEOLITE_PATH" -R tests/warn-public -f)+  if ! echo "$output" | egrep -q '"internal" .+ public'; then+    show_message 'Expected "internal" dependency warning from tests/warn-public:'+    echo "$output" 1>&2+    return 1+  fi+  if echo "$output" | egrep -q '"internal2" .+ public'; then+    show_message 'Unexpected "internal2" dependency warning from tests/warn-public:'+    echo "$output" 1>&2+    return 1+  fi+}++ test_templates() {   execute rm -f $ZEOLITE_PATH/tests/templates/Category_Templated.cpp   do_zeolite -p "$ZEOLITE_PATH" --templates tests/templates@@ -131,7 +166,7 @@   } } END-  do_zeolite -i lib/util --fast $category "$file"+  do_zeolite -I lib/util --fast $category "$file"   local output=$(execute "$PWD/$category")   if ! echo "$output" | fgrep -xq 'Hello World'; then     show_message 'Expected "Hello World" in program output:'@@ -175,20 +210,20 @@   local temp=$(execute mktemp -d)   local prev=$PWD   execute cd "$temp"-  do_zeolite -i fakedep -c "$temp" || { execute cd "$prev"; execute rm "$global"; return 1; }+  do_zeolite -I fakedep -c "$temp" || { execute cd "$prev"; execute rm "$global"; return 1; }   execute cd "$prev"   execute rm -r "$temp0" "$temp" "$global" || true }   test_example_hello() {-  do_zeolite -p "$ZEOLITE_PATH" -i lib/util -m HelloDemo example/hello -f+  do_zeolite -p "$ZEOLITE_PATH" -I lib/util -m HelloDemo example/hello -f   do_zeolite -p "$ZEOLITE_PATH" -t example/hello }   test_example_tree() {-  do_zeolite -p "$ZEOLITE_PATH" -i lib/util -m TreeDemo example/tree -f+  do_zeolite -p "$ZEOLITE_PATH" -I lib/util -m TreeDemo example/tree -f   do_zeolite -p "$ZEOLITE_PATH" -t example/tree } @@ -230,6 +265,8 @@   test_tests_only   test_tests_only2   test_module_only+  test_module_only2+  test_warn_public   test_templates   test_fast   test_bad_system_include

@@ -1,8 +1,7 @@-# `$ModuleOnly$` Pragma Test+# `$ModuleOnly$` Pragma Test - Dependency  Compiling this module should **always fail**. It tests that the `$ModuleOnly$`-pragma limits visibility to only `.0rx` and `.0rt` sources in the same module,-and `.0rp` sources in the same module that also have the `$ModuleOnly$` pragma.+pragma limits visibility to only `.0rx` and `.0rt` sources in the same module.  To compile: @@ -15,6 +14,7 @@  ```text Zeolite execution failed.-  In creation of val1 at "tests/module-only/private.0rx" (line 22, column 3)-    Type Type1 not found+  In compilation of module "/home/ta0kira/checkouts/zeolite/tests/module-only"+    In creation of val1 at "tests/module-only/private.0rx" (line 22, column 3)+      Type Type1 not found ```

@@ -0,0 +1,3 @@+root: "../.."+path: "tests/module-only2"+mode: incremental {}

@@ -0,0 +1,20 @@+# `$ModuleOnly$` Pragma Test - Local++Compiling this module should **always fail**. It tests that the `$ModuleOnly$`+pragma limits visibility to `.0rp` sources in the same module that also have the+`$ModuleOnly$` pragma.++To compile:++```shell+ZEOLITE_PATH=$(zeolite --get-path)+zeolite -p $ZEOLITE_PATH -R tests/module-only2+```++The compiler errors should look something like this:++```text+Zeolite execution failed.+  In compilation of module "/home/ta0kira/checkouts/zeolite/tests/module-only2"+    Type Type1 ["tests/module-only2/public.0rp" (line 20, column 3)] not found+```

@@ -0,0 +1,21 @@+/* -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++$ModuleOnly$++@value interface Type1 {}

@@ -0,0 +1,23 @@+/* -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++$ModuleOnly$++@value interface Type3 {+  refines Type1+}

@@ -0,0 +1,21 @@+/* -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++@value interface Type2 {+  refines Type1+}

@@ -242,3 +242,26 @@ concrete Test {   @type run () -> () }+++testcase "positional return sets named return" {+  crash Test$run()+  require "message"+}++define Test {+  @type get () -> (String)+  get () (value) {+    cleanup {+      fail(value)+    } in return "message"+  }++  run () {+    \ get()+  }+}++concrete Test {+  @type run () -> ()+}

@@ -260,51 +260,26 @@ }  -testcase "cleanup initializes named return" {-  success Test$run()+testcase "positional return sets named returns for cleanup" {+  crash Test$run()+  require "message"+  exclude "failed" }  define Test {-  @type get () -> (Int)-  get () (value) {-    scoped {-    } cleanup {-      value <- 1-    } in return _-  }--  run () {-    Int value <- get()-    if (value != 1) {+  // Using a second return ensures that assignment works properly when the+  // ReturnTuple is constructed during assignment.+  @type get () -> (String,Int)+  get () (value,value2) {+    value <- "failed"+    cleanup {       fail(value)-    }-  }-}--concrete Test {-  @type run () -> ()-}---testcase "cleanup overrides named return" {-  success Test$run()-}--define Test {-  @type get () -> (Int)-  get () (value) {-    value <- 1-    scoped {-    } cleanup {-      value <- 2-    } in return _+    } in return "message", 1   }    run () {-    Int value <- get()-    if (value != 2) {-      fail(value)-    }+    String value, _ <- get()+    fail(value)   } } @@ -366,35 +341,6 @@ }  -testcase "no infinite loop in cleanup return" {-  success Test$run()-}--define Test {-  @type get () -> (Int)-  get () {-    Int value <- 0-    scoped {-      value <- 1-    } cleanup {-      value <- 2-      return value-    } in return 3-  }--  run () {-    Int value <- get()-    if (value != 2) {-      fail(value)-    }-  }-}--concrete Test {-  @type run () -> ()-}-- testcase "multiple cleanup" {   success Test$run() }@@ -711,6 +657,170 @@     cleanup {       fail("Failed")     } in return _+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "partial cleanup with while and break" {+  success Test$run()+}++define Test {+  run () {+    Int x <- 0+    Int y <- 0+    Int z <- 0+    cleanup {+      x <- 1+    } in {+      while (true) {+        cleanup {+          y <- 2+        } in if (true) {+          cleanup {+            z <- 3+          } in if (true) {+            break+          }+        }+      }+      \ Testing$check<?>(x,0)+      \ Testing$check<?>(y,2)+      \ Testing$check<?>(z,3)+    }+    \ Testing$check<?>(x,1)+    \ Testing$check<?>(y,2)+    \ Testing$check<?>(z,3)+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "full cleanup with while and return" {+  success Test$run()+}++concrete Value {+  @type create () -> (Value)+  @value call () -> (Int,Int,Int)+  @value get () -> (Int,Int,Int)+}++define Value {+  @value Int x+  @value Int y+  @value Int z++  create () {+    return Value{ 0, 0, 0 }+  }++  call () {+    cleanup {+      x <- 1+    } in while (true) {+      cleanup {+        y <- 2+      } in if (true) {+        cleanup {+          z <- 3+        } in if (true) {+          return get()+        }+      }+    }+    fail("Failed")+  }++  get () {+    return x, y, z+  }+}++define Test {+  run () {+    Value value <- Value$create()+    scoped {+      Int x, Int y, Int z <- value.call()+    } in {+      \ Testing$check<?>(x,0)+      \ Testing$check<?>(y,0)+      \ Testing$check<?>(z,0)+    }+    scoped {+      Int x, Int y, Int z <- value.get()+    } in {+      \ Testing$check<?>(x,1)+      \ Testing$check<?>(y,2)+      \ Testing$check<?>(z,3)+    }+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "named return cannot be modified in cleanup" {+  error+  require compiler "assign.+value"+}++define Test {+  @type get () -> (String)+  get () (value) {+    cleanup {+      value <- "error"+    } in return "message"+  }++  run () {}+}++concrete Test {+  @type run () -> ()+}+++testcase "positional return not allowed in cleanup" {+  error+  require compiler "return.+cleanup"+}++define Test {+  @type get () -> (Int)+  get () (value) {+    cleanup {+      return 0+    } in \ empty+  }++  run () {}+}++concrete Test {+  @type run () -> ()+}+++testcase "default return not allowed in cleanup" {+  error+  require compiler "return.+cleanup"+}++define Test {+  run () {+    cleanup {+      return _+    } in \ empty   } } 

@@ -27,6 +27,7 @@     fail("Failed")     return 1   }+   run () {} } @@ -34,7 +35,25 @@   @type run () -> () } +testcase "unreachable not compiled" {+  success Test$run()+} +define Test {+  @category failedReturn () -> (Int)+  failedReturn () {+    fail("Failed")+    \ foo()+  }++  run () {}+}++concrete Test {+  @type run () -> ()+}++ testcase "warning statement after return" {   success Test$run()   require compiler "unreachable"@@ -46,6 +65,7 @@     return 0     return 1   }+   run () {} } @@ -69,6 +89,7 @@     }     return 3   }+   run () {} } @@ -89,6 +110,7 @@       return 1     } in return 2   }+   run () {} } @@ -97,9 +119,10 @@ }  -testcase "warning statement after cleanup return" {-  success Test$run()+testcase "warning statement after cleanup fail" {+  crash Test$run()   require compiler "unreachable"+  require "message" }  define Test {@@ -107,11 +130,14 @@   failedReturn () {     scoped {     } cleanup {-      return 1+      fail("message")     } in \ empty     return 2   }-  run () {}++  run () {+    \ failedReturn()+  } }  concrete Test {@@ -119,21 +145,87 @@ }  -testcase "warning statement in cleanup after scoped return" {-  success Test$run()+testcase "warning statement in cleanup after scoped fail" {+  crash Test$run()   require compiler "unreachable"+  require "message" }  define Test {-  @category failedReturn () -> (Int)+  @category failedReturn () -> ()   failedReturn () {     scoped {-      return 1+      fail("message")     } cleanup {-      return 2-    } in \ empty+      \ empty+    } in {}   }-  run () {}++  run () {+    \ failedReturn()+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "warning statement in cleanup after in fail" {+  crash Test$run()+  require compiler "unreachable"+  require "message"+}++define Test {+  @category failedReturn () -> ()+  failedReturn () {+    cleanup {+      \ empty+    } in fail("message")+  }++  run () {+    \ failedReturn()+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "warning statement after break" {+  success Test$run()+  require compiler "unreachable"+}++define Test {+  run () {+    while (false) {+      break+      fail("Failed")+    }+  }+}++concrete Test {+  @type run () -> ()+}+++testcase "warning statement after continue" {+  success Test$run()+  require compiler "unreachable"+}++define Test {+  run () {+    while (false) {+      continue+      fail("Failed")+    }+  } }  concrete Test {

@@ -0,0 +1,7 @@+root: "../.."+path: "tests/warn-public"+public_deps: [+  "internal"+  "internal2"+]+mode: incremental {}

@@ -0,0 +1,18 @@+# Public Dependency Warning++Compiling this module should succeed with a warning about a public dependency+that does not need to be public.++To compile:++```shell+ZEOLITE_PATH=$(zeolite --get-path)+zeolite -p $ZEOLITE_PATH -r tests/warn-public -f+```++The compiler output should look something like this:++```text+Warning: Dependency "internal" does not need to be public+Zeolite execution succeeded.+```

@@ -0,0 +1,3 @@+root: "../../.."+path: "tests/warn-public/internal"+mode: incremental {}

@@ -0,0 +1,19 @@+/* -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++@value interface Type1 {}

@@ -0,0 +1,3 @@+root: "../../.."+path: "tests/warn-public/internal2"+mode: incremental {}

@@ -0,0 +1,19 @@+/* -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++@value interface Type2 {}

@@ -0,0 +1,23 @@+/* -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++$ModuleOnly$++@value interface Type3 {+  refines Type1+}

@@ -0,0 +1,21 @@+/* -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++@value interface Type4 {+  refines Type2+}

@@ -1,7 +1,7 @@ cabal-version:       2.2  name:                zeolite-lang-version:             0.7.1.0+version:             0.8.0.0 synopsis:            Zeolite is a statically-typed, general-purpose programming language.  description:@@ -111,6 +111,9 @@                      tests/module-only/*.0rx,                      tests/module-only/internal/.zeolite-module,                      tests/module-only/internal/*.0rp,+                     tests/module-only2/README.md,+                     tests/module-only2/.zeolite-module,+                     tests/module-only2/*.0rp,                      tests/templates/README.md,                      tests/templates/.zeolite-module,                      tests/templates/*.0rp,@@ -134,7 +137,14 @@                      tests/visibility2/*.0rx,                      tests/visibility2/internal/.zeolite-module,                      tests/visibility2/internal/*.0rp,-                     tests/visibility2/internal/*.0rx+                     tests/visibility2/internal/*.0rx,+                     tests/warn-public/.zeolite-module,+                     tests/warn-public/*.0rp,+                     tests/warn-public/README.md,+                     tests/warn-public/internal/.zeolite-module,+                     tests/warn-public/internal/*.0rp,+                     tests/warn-public/internal2/.zeolite-module,+                     tests/warn-public/internal2/*.0rp   common defaults@@ -154,7 +164,6 @@                        Cli.CompileOptions,                        Cli.Compiler,                        Cli.ParseCompileOptions,-                       Cli.Paths,                        Cli.Programs,                        Cli.RunCompiler,                        Cli.TestRunner,@@ -170,6 +179,7 @@                        Config.LocalConfig,                        Module.CompileMetadata,                        Module.ParseMetadata,+                       Module.Paths,                        Module.ProcessMetadata,                        Parser.Common,                        Parser.DefinedCategory,