packages feed

zeolite-lang 0.1.3.1 → 0.2.0.0

raw patch · 35 files changed

+1333/−527 lines, 35 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Cli.CompileMetadata: RecompileMetadata :: String -> String -> [String] -> [String] -> [String] -> [String] -> [String] -> CompileMode -> String -> RecompileMetadata
- Cli.CompileMetadata: allowedExtraTypes :: [String]
- Cli.CompileMetadata: createCachePath :: String -> IO ()
- Cli.CompileMetadata: data RecompileMetadata
- Cli.CompileMetadata: eraseCachedData :: String -> IO ()
- Cli.CompileMetadata: findSourceFiles :: String -> String -> IO ([String], [String], [String])
- Cli.CompileMetadata: fixPath :: String -> String
- Cli.CompileMetadata: getCacheRelativePath :: String -> String
- Cli.CompileMetadata: getCachedPath :: String -> String -> String -> String
- Cli.CompileMetadata: getIncludePathsForDeps :: [CompileMetadata] -> [String]
- Cli.CompileMetadata: getNamespacesForDeps :: [CompileMetadata] -> [String]
- Cli.CompileMetadata: getObjectFileResolver :: [CategoryIdentifier] -> [ObjectFile] -> [Namespace] -> [CategoryName] -> [String]
- Cli.CompileMetadata: getObjectFilesForDeps :: [CompileMetadata] -> [ObjectFile]
- Cli.CompileMetadata: getRealPathsForDeps :: [CompileMetadata] -> [String]
- Cli.CompileMetadata: getRequiresFromDeps :: [CompileMetadata] -> [CategoryIdentifier]
- Cli.CompileMetadata: getSourceFilesForDeps :: [CompileMetadata] -> [String]
- Cli.CompileMetadata: instance GHC.Read.Read Cli.CompileMetadata.CategoryIdentifier
- Cli.CompileMetadata: instance GHC.Read.Read Cli.CompileMetadata.CompileMetadata
- Cli.CompileMetadata: instance GHC.Read.Read Cli.CompileMetadata.ObjectFile
- Cli.CompileMetadata: instance GHC.Read.Read Cli.CompileMetadata.RecompileMetadata
- Cli.CompileMetadata: instance GHC.Show.Show Cli.CompileMetadata.RecompileMetadata
- Cli.CompileMetadata: isPathConfigured :: String -> IO Bool
- Cli.CompileMetadata: isPathUpToDate :: String -> IO Bool
- Cli.CompileMetadata: loadMetadata :: String -> IO CompileMetadata
- Cli.CompileMetadata: loadPrivateDeps :: [CompileMetadata] -> IO (Bool, [CompileMetadata])
- Cli.CompileMetadata: loadPublicDeps :: [String] -> IO (Bool, [CompileMetadata])
- Cli.CompileMetadata: resolveCategoryDeps :: [String] -> [CompileMetadata] -> [CategoryIdentifier]
- Cli.CompileMetadata: resolveObjectDeps :: String -> [([String], CxxOutput)] -> [CompileMetadata] -> [ObjectFile]
- Cli.CompileMetadata: sortCompiledFiles :: [String] -> ([String], [String], [String])
- Cli.CompileMetadata: tryLoadRecompile :: String -> IO (Maybe RecompileMetadata)
- Cli.CompileMetadata: writeCachedFile :: String -> String -> String -> String -> IO ()
- Cli.CompileMetadata: writeMetadata :: String -> CompileMetadata -> IO ()
- Cli.CompileMetadata: writeRecompile :: String -> RecompileMetadata -> IO ()
- Cli.CompileOptions: OnlyShowPath :: CompileMode
- Cli.CompileOptions: instance GHC.Read.Read Cli.CompileOptions.CompileMode
- Cli.CompileOptions: isOnlyShowPath :: CompileMode -> Bool
- Cli.Compiler: rootPath :: IO FilePath
+ Cli.CompileMetadata: ModuleConfig :: String -> String -> [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> CompileMode -> String -> ModuleConfig
+ Cli.CompileMetadata: [cmVersionHash] :: CompileMetadata -> String
+ Cli.CompileMetadata: [rmExternalDefs] :: ModuleConfig -> [String]
+ Cli.CompileMetadata: data ModuleConfig
+ Cli.CompileMetadata: instance GHC.Classes.Eq Cli.CompileMetadata.CompileMetadata
+ Cli.CompileMetadata: instance GHC.Classes.Eq Cli.CompileMetadata.ModuleConfig
+ Cli.CompileMetadata: instance GHC.Classes.Eq Cli.CompileMetadata.ObjectFile
+ Cli.CompileMetadata: instance GHC.Show.Show Cli.CompileMetadata.ModuleConfig
+ Cli.CompileOptions: [coExternalDefs] :: CompileOptions -> [String]
+ Cli.ParseCompileOptions: tryFastModes :: [String] -> IO ()
+ Cli.ParseMetadata: autoReadConfig :: (ConfigFormat a, CompileErrorM m) => String -> String -> m a
+ Cli.ParseMetadata: autoWriteConfig :: (ConfigFormat a, CompileErrorM m) => a -> m String
+ Cli.ParseMetadata: class ConfigFormat a
+ Cli.ParseMetadata: instance Cli.ParseMetadata.ConfigFormat Cli.CompileMetadata.CategoryIdentifier
+ Cli.ParseMetadata: instance Cli.ParseMetadata.ConfigFormat Cli.CompileMetadata.CompileMetadata
+ Cli.ParseMetadata: instance Cli.ParseMetadata.ConfigFormat Cli.CompileMetadata.ModuleConfig
+ Cli.ParseMetadata: instance Cli.ParseMetadata.ConfigFormat Cli.CompileMetadata.ObjectFile
+ Cli.ParseMetadata: instance Cli.ParseMetadata.ConfigFormat Cli.CompileOptions.CompileMode
+ Cli.ProcessMetadata: allowedExtraTypes :: [String]
+ Cli.ProcessMetadata: createCachePath :: String -> IO ()
+ Cli.ProcessMetadata: eraseCachedData :: String -> IO ()
+ Cli.ProcessMetadata: findSourceFiles :: String -> String -> IO ([String], [String], [String])
+ Cli.ProcessMetadata: fixPath :: String -> String
+ Cli.ProcessMetadata: getCacheRelativePath :: String -> String
+ Cli.ProcessMetadata: getCachedPath :: String -> String -> String -> String
+ Cli.ProcessMetadata: getIncludePathsForDeps :: [CompileMetadata] -> [String]
+ Cli.ProcessMetadata: getNamespacesForDeps :: [CompileMetadata] -> [String]
+ Cli.ProcessMetadata: getObjectFileResolver :: [CategoryIdentifier] -> [ObjectFile] -> [Namespace] -> [CategoryName] -> [String]
+ Cli.ProcessMetadata: getObjectFilesForDeps :: [CompileMetadata] -> [ObjectFile]
+ Cli.ProcessMetadata: getRealPathsForDeps :: [CompileMetadata] -> [String]
+ Cli.ProcessMetadata: getRequiresFromDeps :: [CompileMetadata] -> [CategoryIdentifier]
+ Cli.ProcessMetadata: getSourceFilesForDeps :: [CompileMetadata] -> [String]
+ Cli.ProcessMetadata: isPathConfigured :: String -> IO Bool
+ Cli.ProcessMetadata: isPathUpToDate :: String -> String -> IO Bool
+ Cli.ProcessMetadata: loadMetadata :: String -> IO CompileMetadata
+ Cli.ProcessMetadata: loadPrivateDeps :: String -> [CompileMetadata] -> IO (Bool, [CompileMetadata])
+ Cli.ProcessMetadata: loadPublicDeps :: String -> [String] -> IO (Bool, [CompileMetadata])
+ Cli.ProcessMetadata: resolveCategoryDeps :: [String] -> [CompileMetadata] -> [CategoryIdentifier]
+ Cli.ProcessMetadata: resolveObjectDeps :: String -> [([String], CxxOutput)] -> [CompileMetadata] -> [ObjectFile]
+ Cli.ProcessMetadata: sortCompiledFiles :: [String] -> ([String], [String], [String])
+ Cli.ProcessMetadata: tryLoadRecompile :: String -> IO (Maybe ModuleConfig)
+ Cli.ProcessMetadata: writeCachedFile :: String -> String -> String -> String -> IO ()
+ Cli.ProcessMetadata: writeMetadata :: String -> CompileMetadata -> IO ()
+ Cli.ProcessMetadata: writeRecompile :: String -> ModuleConfig -> IO ()
+ CompilerCxx.Category: [cnExternal] :: CategoryModule c -> [String]
+ Config.LoadConfig: compilerVersion :: String
+ Config.LoadConfig: rootPath :: IO FilePath
+ Config.Programs: getCompilerHash :: CompilerBackend b => b -> String
+ Test.ParseMetadata: tests :: [IO (CompileInfo ())]
- Cli.CompileMetadata: CompileMetadata :: String -> String -> [String] -> [String] -> [CategoryIdentifier] -> [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> [ObjectFile] -> CompileMetadata
+ Cli.CompileMetadata: CompileMetadata :: String -> String -> String -> [String] -> [String] -> [CategoryIdentifier] -> [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> [ObjectFile] -> CompileMetadata
- Cli.CompileMetadata: [rmExtraFiles] :: RecompileMetadata -> [String]
+ Cli.CompileMetadata: [rmExtraFiles] :: ModuleConfig -> [String]
- Cli.CompileMetadata: [rmExtraPaths] :: RecompileMetadata -> [String]
+ Cli.CompileMetadata: [rmExtraPaths] :: ModuleConfig -> [String]
- Cli.CompileMetadata: [rmExtraRequires] :: RecompileMetadata -> [String]
+ Cli.CompileMetadata: [rmExtraRequires] :: ModuleConfig -> [String]
- Cli.CompileMetadata: [rmMode] :: RecompileMetadata -> CompileMode
+ Cli.CompileMetadata: [rmMode] :: ModuleConfig -> CompileMode
- Cli.CompileMetadata: [rmOutputName] :: RecompileMetadata -> String
+ Cli.CompileMetadata: [rmOutputName] :: ModuleConfig -> String
- Cli.CompileMetadata: [rmPath] :: RecompileMetadata -> String
+ Cli.CompileMetadata: [rmPath] :: ModuleConfig -> String
- Cli.CompileMetadata: [rmPrivateDeps] :: RecompileMetadata -> [String]
+ Cli.CompileMetadata: [rmPrivateDeps] :: ModuleConfig -> [String]
- Cli.CompileMetadata: [rmPublicDeps] :: RecompileMetadata -> [String]
+ Cli.CompileMetadata: [rmPublicDeps] :: ModuleConfig -> [String]
- Cli.CompileMetadata: [rmRoot] :: RecompileMetadata -> String
+ Cli.CompileMetadata: [rmRoot] :: ModuleConfig -> String
- Cli.CompileOptions: CompileOptions :: HelpMode -> [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> String -> CompileMode -> String -> ForceMode -> CompileOptions
+ Cli.CompileOptions: CompileOptions :: HelpMode -> [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> String -> [String] -> CompileMode -> String -> ForceMode -> CompileOptions
- CompilerCxx.Category: CategoryModule :: CategoryMap c -> [Namespace] -> [AnyCategory c] -> [PrivateSource c] -> CategoryModule c
+ CompilerCxx.Category: CategoryModule :: CategoryMap c -> [Namespace] -> [AnyCategory c] -> [PrivateSource c] -> [String] -> CategoryModule c
- CompilerCxx.Category: compileCategoryDeclaration :: (Show c, CompileErrorM m, MergeableM m) => CategoryMap c -> AnyCategory c -> m CxxOutput
+ CompilerCxx.Category: compileCategoryDeclaration :: (Show c, CompileErrorM m, MergeableM m) => CategoryMap c -> [Namespace] -> AnyCategory c -> m CxxOutput

Files

ChangeLog.md view
@@ -1,5 +1,15 @@ # Revision history for zeolite-lang +## 0.2.0.0  -- 2020-05-03++* **[breaking]** Requires that `concrete` categories defined in `.cpp` files be+  listed as `external` in `.zeolite-module`. This allows the compiler to ensure+  that all categories have a definition, which helps avoid linker errors.++* **[breaking]** Gives `.zeolite-module` configs a proper file format.++* **[new]** Adds version checking to cached module data.+ ## 0.1.3.0  -- 2020-05-01  * **[new]** Adds support for more versions of GHC.
base/.zeolite-module view
@@ -1,1 +1,48 @@-RecompileMetadata {rmRoot = "..", rmPath = "base", rmPublicDeps = [], rmPrivateDeps = [], rmExtraFiles = ["base/builtin.cpp","base/builtin.hpp","base/category-header.hpp","base/category-source.cpp","base/argv.cpp","base/builtin.cpp","base/category-source.hpp","base/cycle-check.hpp","base/function.hpp","base/logging.cpp","base/logging.hpp","base/types.cpp","base/types.hpp","capture-thread/include/thread-capture.h","capture-thread/include/thread-crosser.h","capture-thread/src/thread-crosser.cc"], rmExtraPaths = ["base","capture-thread/include"], rmExtraRequires = ["Bool","Char","Int","Float","String","AsBool","AsChar","AsInt","AsFloat","AsString","Formatted","Equals","LessThan","ReadPosition"], rmMode = CompileIncremental, rmOutputName = ""}+root: ".."+path: "base"+extra_files: [+  "base/builtin.cpp"+  "base/builtin.hpp"+  "base/category-header.hpp"+  "base/category-source.cpp"+  "base/argv.cpp"+  "base/builtin.cpp"+  "base/category-source.hpp"+  "base/cycle-check.hpp"+  "base/function.hpp"+  "base/logging.cpp"+  "base/logging.hpp"+  "base/types.cpp"+  "base/types.hpp"+  "capture-thread/include/thread-capture.h"+  "capture-thread/include/thread-crosser.h"+  "capture-thread/src/thread-crosser.cc"+]+extra_paths: [+  "base"+  "capture-thread/include"+]+always_include: [+  Bool+  Char+  Int+  Float+  String+  AsBool+  AsChar+  AsInt+  AsFloat+  AsString+  Formatted+  Equals+  LessThan+  ReadPosition+]+external: [+  Bool+  Char+  Int+  Float+  String+]+mode: incremental
bin/unit-tests.hs view
@@ -16,12 +16,11 @@  -- Author: Kevin P. Barry [ta0kira@gmail.com] -{-# LANGUAGE Safe #-}- import Base.CompileError import Test.Common import qualified Test.DefinedCategory as DefinedCategoryTest import qualified Test.IntegrationTest as IntegrationTestTest+import qualified Test.ParseMetadata   as ParseMetadataTest import qualified Test.Parser          as ParserTest import qualified Test.Procedure       as ProcedureTest import qualified Test.TypeCategory    as TypeCategoryTest@@ -32,6 +31,7 @@ main = runAllTests $ concat [     labelWith "DefinedCategoryTest" DefinedCategoryTest.tests,     labelWith "TypeInstanceTest"    TypeInstanceTest.tests,+    labelWith "ParseMetadataTest"   ParseMetadataTest.tests,     labelWith "ParserTest"          ParserTest.tests,     labelWith "TypeCategoryTest"    TypeCategoryTest.tests,     labelWith "ProcedureTest"       ProcedureTest.tests,
bin/zeolite-setup.hs view
@@ -18,6 +18,7 @@  import Control.Monad (when) import System.Directory+import System.Environment import System.Exit import System.IO @@ -28,6 +29,8 @@  main :: IO () main = do+  args <- getArgs+  when (not $ null args) $ hPutStrLn stderr $ "Ignoring extra arguments: " ++ show args   f <- localConfigPath   isFile <- doesFileExist f   when isFile $ do@@ -123,6 +126,7 @@       coExtraPaths = [],       coExtraRequires = [],       coSourcePrefix = path,+      coExternalDefs = [],       coMode = CompileRecompile,       coOutputName = "",       coForce = ForceAll
bin/zeolite.hs view
@@ -31,6 +31,7 @@ main :: IO () main = do   args <- getArgs+  tryFastModes args   let options = parseCompileOptions args >>= validateCompileOptions   compile options where     compile co
− example/regex/regex-test.0rp
@@ -1,3 +0,0 @@-concrete RegexTest {-  @type runTests () -> ()-}
lib/file/.zeolite-module view
@@ -1,1 +1,14 @@-RecompileMetadata {rmRoot = "..", rmPath = "file", rmPublicDeps = ["../util"], rmPrivateDeps = [], rmExtraFiles = ["file/Category_RawFileReader.cpp","file/Category_RawFileWriter.cpp"], rmExtraPaths = [], rmExtraRequires = [], rmMode = CompileIncremental, rmOutputName = ""}+root: ".."+path: "file"+public_deps: [+  "../util"+]+extra_files: [+  "file/Category_RawFileReader.cpp"+  "file/Category_RawFileWriter.cpp"+]+external: [+  RawFileReader+  RawFileWriter+]+mode: incremental
lib/util/.zeolite-module view
@@ -1,1 +1,13 @@-RecompileMetadata {rmRoot = "..", rmPath = "util", rmPublicDeps = [], rmPrivateDeps = [], rmExtraFiles = ["util/Category_Argv.cpp","util/Category_SimpleInput.cpp","util/Category_SimpleOutput.cpp"], rmExtraPaths = [], rmExtraRequires = [], rmMode = CompileIncremental, rmOutputName = ""}+root: ".."+path: "util"+extra_files: [+  "util/Category_Argv.cpp"+  "util/Category_SimpleInput.cpp"+  "util/Category_SimpleOutput.cpp"+]+external: [+  Argv+  SimpleInput+  SimpleOutput+]+mode: incremental
src/Cli/CompileMetadata.hs view
@@ -21,57 +21,20 @@ module Cli.CompileMetadata (   CategoryIdentifier(..),   CompileMetadata(..),+  ModuleConfig(..),   ObjectFile(..),-  RecompileMetadata(..),-  allowedExtraTypes,-  createCachePath,-  eraseCachedData,-  findSourceFiles,-  fixPath,-  getCachedPath,-  getCacheRelativePath,-  getIncludePathsForDeps,-  getNamespacesForDeps,-  getObjectFilesForDeps,-  getObjectFileResolver,-  getRealPathsForDeps,-  getRequiresFromDeps,-  getSourceFilesForDeps,   isCategoryObjectFile,-  isPathConfigured,-  isPathUpToDate,-  loadPrivateDeps,-  loadPublicDeps,-  loadMetadata,   mergeObjectFiles,-  resolveCategoryDeps,-  resolveObjectDeps,-  sortCompiledFiles,-  tryLoadRecompile,-  writeCachedFile,-  writeMetadata,-  writeRecompile, ) where -import Control.Applicative ((<|>))-import Control.Monad (when)-import Data.List (nub,isSuffixOf)-import Data.Maybe (isJust)-import System.Directory-import System.Exit (exitFailure)-import System.FilePath-import System.IO-import qualified Data.Map as Map-import qualified Data.Set as Set+import Data.List (nub) -import Cli.CompileOptions (CompileMode)-import CompilerCxx.Category (CxxOutput(..))-import Types.TypeCategory-import Types.TypeInstance+import Cli.CompileOptions   data CompileMetadata =   CompileMetadata {+    cmVersionHash :: String,     cmPath :: String,     cmNamespace :: String, -- TODO: Use Namespace here?     cmPublicDeps :: [String],@@ -86,7 +49,7 @@     cmCxxFiles :: [String],     cmObjectFiles :: [ObjectFile]   }-  deriving (Show,Read)+  deriving (Eq,Show)  data ObjectFile =   CategoryObjectFile {@@ -97,7 +60,7 @@   OtherObjectFile {     oofFile :: String   }-  deriving (Show,Read)+  deriving (Eq,Show)  data CategoryIdentifier =   CategoryIdentifier {@@ -108,19 +71,19 @@   UnresolvedCategory {     ucCategory :: String   }-  deriving (Eq,Ord,Show,Read)+  deriving (Eq,Ord,Show)  mergeObjectFiles :: ObjectFile -> ObjectFile -> ObjectFile mergeObjectFiles (CategoryObjectFile c rs1 fs1) (CategoryObjectFile _ rs2 fs2) =-  CategoryObjectFile c (rs1 ++ rs2) (fs1 ++ fs2)+  CategoryObjectFile c (nub $ rs1 ++ rs2) (nub $ fs1 ++ fs2) mergeObjectFiles o _ = o  isCategoryObjectFile :: ObjectFile -> Bool isCategoryObjectFile (CategoryObjectFile _ _ _) = True isCategoryObjectFile (OtherObjectFile _)        = False -data RecompileMetadata =-  RecompileMetadata {+data ModuleConfig =+  ModuleConfig {     rmRoot :: String,     rmPath :: String,     rmPublicDeps :: [String],@@ -128,283 +91,8 @@     rmExtraFiles :: [String],     rmExtraPaths :: [String],     rmExtraRequires :: [String],+    rmExternalDefs :: [String],     rmMode :: CompileMode,     rmOutputName :: String   }-  deriving (Show,Read)--cachedDataPath :: String-cachedDataPath = ".zeolite-cache"--recompileFilename :: String-recompileFilename = ".zeolite-module"--metadataFilename :: String-metadataFilename = "metadata.txt"--allowedExtraTypes :: [String]-allowedExtraTypes = [".hpp",".cpp",".h",".cc",".a",".o"]--loadMetadata :: String -> IO CompileMetadata-loadMetadata p = do-  let f = p </> cachedDataPath </> metadataFilename-  isFile <- doesFileExist p-  when isFile $ do-    hPutStrLn stderr $ "Path \"" ++ p ++ "\" is not a directory."-    exitFailure-  isDir <- doesDirectoryExist p-  when (not isDir) $ do-    hPutStrLn stderr $ "Path \"" ++ p ++ "\" does not exist."-    exitFailure-  filePresent <- doesFileExist f-  when (not filePresent) $ do-    hPutStrLn stderr $ "Module \"" ++ p ++ "\" has not been compiled yet."-    exitFailure-  c <- readFile f-  m <- check $ (reads c :: [(CompileMetadata,String)])-  return m where-    check [(cm,"")] = return cm-    check [(cm,"\n")] = return cm-    check _ = do-      hPutStrLn stderr $ "Could not parse metadata from \"" ++ p ++ "\"; please recompile."-      exitFailure--tryLoadMetadata :: String -> IO (Maybe CompileMetadata)-tryLoadMetadata p = tryLoadData $ (p </> cachedDataPath </> metadataFilename)--tryLoadRecompile :: String -> IO (Maybe RecompileMetadata)-tryLoadRecompile p = tryLoadData $ (p </> recompileFilename)--tryLoadData :: Read a => String -> IO (Maybe a)-tryLoadData f = do-  filePresent <- doesFileExist f-  if not filePresent-    then return Nothing-    else do-      c <- readFile f-      check (reads c) where-        check [(cm,"")]   = return (Just cm)-        check [(cm,"\n")] = return (Just cm)-        check _           = return Nothing--isPathUpToDate :: String -> IO Bool-isPathUpToDate p = do-  m <- tryLoadMetadata p-  case m of-       Nothing -> return False-       Just _ -> do-         (fr,_) <- loadDepsCommon True (\m2 -> cmPublicDeps m2 ++ cmPrivateDeps m2) [p]-         return fr--isPathConfigured :: String -> IO Bool-isPathConfigured p = tryLoadRecompile p >>= return . isJust--writeMetadata :: String -> CompileMetadata -> IO ()-writeMetadata p m = do-  p' <- canonicalizePath p-  hPutStrLn stderr $ "Writing metadata for \"" ++ p' ++ "\"."-  writeCachedFile p' "" metadataFilename (show m ++ "\n")--writeRecompile :: String -> RecompileMetadata -> IO ()-writeRecompile p m = do-  p' <- canonicalizePath p-  hPutStrLn stderr $ "Updating config for \"" ++ p' ++ "\"."-  writeFile (p </> recompileFilename) (show m ++ "\n")--eraseCachedData :: String -> IO ()-eraseCachedData p = do-  let d  = p </> cachedDataPath-  dirExists <- doesDirectoryExist d-  when dirExists $ removeDirectoryRecursive d--createCachePath :: String -> IO ()-createCachePath p = do-  let f = p </> cachedDataPath-  exists <- doesDirectoryExist f-  when (not exists) $ createDirectoryIfMissing False f--writeCachedFile :: String -> String -> String -> String -> IO ()-writeCachedFile p ns f c = do-  createCachePath p-  createDirectoryIfMissing False $ p </> cachedDataPath </> ns-  writeFile (getCachedPath p ns f) c--getCachedPath :: String -> String -> String -> String-getCachedPath p ns f = fixPath $ p </> cachedDataPath </> ns </> f--getCacheRelativePath :: String -> String-getCacheRelativePath f = ".." </> f--findSourceFiles :: String -> String -> IO ([String],[String],[String])-findSourceFiles p0 p = do-  let absolute = p0 </> p-  isFile <- doesFileExist absolute-  when isFile $ do-    hPutStrLn stderr $ "Path \"" ++ absolute ++ "\" is not a directory."-    exitFailure-  isDir <- doesDirectoryExist absolute-  when (not isDir) $ do-    hPutStrLn stderr $ "Path \"" ++ absolute ++ "\" does not exist."-    exitFailure-  ds <- getDirectoryContents absolute >>= return . map (p </>)-  let ps = filter (isSuffixOf ".0rp") ds-  let xs = filter (isSuffixOf ".0rx") ds-  let ts = filter (isSuffixOf ".0rt") ds-  return (ps,xs,ts)--getRealPathsForDeps :: [CompileMetadata] -> [String]-getRealPathsForDeps = map cmPath--getSourceFilesForDeps :: [CompileMetadata] -> [String]-getSourceFilesForDeps = concat . map extract where-  extract m = map (cmPath m </>) (cmPublicFiles m)--getRequiresFromDeps :: [CompileMetadata] -> [CategoryIdentifier]-getRequiresFromDeps = concat . map cmExtraRequires--getNamespacesForDeps :: [CompileMetadata] -> [String]-getNamespacesForDeps = filter (not . null) . map cmNamespace--getIncludePathsForDeps :: [CompileMetadata] -> [String]-getIncludePathsForDeps = concat . map cmSubdirs--getObjectFilesForDeps :: [CompileMetadata] -> [ObjectFile]-getObjectFilesForDeps = concat . map cmObjectFiles--loadPublicDeps :: [String] -> IO (Bool,[CompileMetadata])-loadPublicDeps = loadDepsCommon False cmPublicDeps--loadPrivateDeps :: [CompileMetadata] -> IO (Bool,[CompileMetadata])-loadPrivateDeps ms = do-  (fr,new) <- loadDepsCommon False (\m -> cmPublicDeps m ++ cmPrivateDeps m) toFind-  return (fr,ms ++ existing ++ new) where-    paths = concat $ map (\m -> cmPublicDeps m ++ cmPrivateDeps m) ms-    (existing,toFind) = foldl splitByExisting ([],[]) $ nub paths-    byPath = Map.fromList $ map (\m -> (cmPath m,m)) ms-    splitByExisting (es,fs) p =-      case p `Map.lookup` byPath of-          Just m  -> (es ++ [m],fs)-          Nothing -> (es,fs ++ [p])--loadDepsCommon :: Bool -> (CompileMetadata -> [String]) -> [String] -> IO (Bool,[CompileMetadata])-loadDepsCommon s f ps = fmap snd $ fixedPaths >>= collect (Set.empty,(True,[])) where-  fixedPaths = sequence $ map canonicalizePath ps-  collect xa@(pa,(fr,xs)) (p:ps2)-    | p `Set.member` pa = collect xa ps2-    | otherwise = do-        when (not s) $ hPutStrLn stderr $ "Loading metadata for dependency \"" ++ p ++ "\"."-        m <- loadMetadata p-        fresh <- checkModuleFreshness p m-        when (not s && not fresh) $-          hPutStrLn stderr $ "Module \"" ++ p ++ "\" is out of date and should be recompiled."-        collect (p `Set.insert` pa,(fresh && fr,xs ++ [m])) (ps2 ++ f m)-  collect xa _ = return xa--fixPath :: String -> String-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--sortCompiledFiles :: [String] -> ([String],[String],[String])-sortCompiledFiles = foldl split ([],[],[]) where-  split fs@(hxx,cxx,os) f-    | isSuffixOf ".hpp" f = (hxx++[f],cxx,os)-    | isSuffixOf ".h"   f = (hxx++[f],cxx,os)-    | isSuffixOf ".cpp" f = (hxx,cxx++[f],os)-    | isSuffixOf ".cc"  f = (hxx,cxx++[f],os)-    | isSuffixOf ".a"   f = (hxx,cxx,os++[f])-    | isSuffixOf ".o"   f = (hxx,cxx,os++[f])-    | otherwise = fs--checkModuleFreshness :: String -> CompileMetadata -> IO Bool-checkModuleFreshness p (CompileMetadata p2 _ is is2 _ _ _ ps xs ts hxx cxx _) = do-  time <- getModificationTime $ getCachedPath p "" metadataFilename-  (ps2,xs2,ts2) <- findSourceFiles p ""-  let e1 = checkMissing ps ps2-  let e2 = checkMissing xs xs2-  let e3 = checkMissing ts ts2-  rm <- check time (p </> recompileFilename)-  f1 <- sequence $ map (\p3 -> check time $ getCachedPath p3 "" metadataFilename) $ is ++ is2-  f2 <- sequence $ map (check time . (p2 </>)) $ ps ++ xs-  f3 <- sequence $ map (check time . getCachedPath p2 "") $ hxx ++ cxx-  let fresh = not $ any id $ [rm,e1,e2,e3] ++ f1 ++ f2 ++ f3-  return fresh where-    check time f = do-      exists <- doesFileOrDirExist f-      if not exists-         then return True-         else do-           time2 <- getModificationTime f-           return (time2 > time)-    checkMissing s0 s1 = not $ null $ (Set.fromList s1) `Set.difference` (Set.fromList s0)-    doesFileOrDirExist f2 = do-      existF <- doesFileExist f2-      if existF-        then return True-        else doesDirectoryExist f2--getObjectFileResolver :: [CategoryIdentifier] -> [ObjectFile] -> [Namespace] -> [CategoryName] -> [String]-getObjectFileResolver ce os ns ds = resolved ++ nonCategories where-  categories    = filter isCategoryObjectFile os-  nonCategories = map oofFile $ filter (not . isCategoryObjectFile) os-  categoryMap = Map.fromList $ map keyByCategory2 categories-  keyByCategory2 o = ((ciCategory $ cofCategory o,ciNamespace $ cofCategory o),o)-  objectMap = Map.fromList $ map keyBySpec categories-  keyBySpec o = (cofCategory o,o)-  directDeps = concat $ map (resolveDep2 . show) ds-  directResolved = map cofCategory directDeps ++ ce-  resolveDep2 d = unwrap $ foldl (<|>) Nothing allChecks <|> Just [] where-    allChecks = map (\n -> (d,n) `Map.lookup` categoryMap >>= return . (:[])) (map show ns ++ [""])-    unwrap (Just xs) = xs-    unwrap _         = []-  (_,_,resolved) = collectAll Set.empty Set.empty directResolved-  collectAll ca fa [] = (ca,fa,[])-  collectAll ca fa (c:cs)-    | c `Set.member` ca = collectAll ca fa cs-    | otherwise =-      case c `Map.lookup` objectMap of-           Just (CategoryObjectFile _ ds2 fs) -> (ca',fa'',fs') where-             (ca',fa',fs0) = collectAll (c `Set.insert` ca) fa (ds2 ++ cs)-             fa'' = fa' `Set.union` (Set.fromList fs)-             fs' = (filter (not . flip elem fa') fs) ++ fs0-           _ -> collectAll ca fa cs--resolveObjectDeps :: String -> [([String],CxxOutput)] -> [CompileMetadata] -> [ObjectFile]-resolveObjectDeps p os deps = resolvedCategories ++ nonCategories where-  categories = filter (isJust . coCategory . snd) os-  publicNamespaces = getNamespacesForDeps deps-  nonCategories = map OtherObjectFile $ concat $ map fst $ filter (not . isJust . coCategory . snd) os-  resolvedCategories = Map.elems $ Map.fromListWith mergeObjectFiles $ map resolveCategory categories-  categoryMap = Map.fromList $ directCategories ++ depCategories-  directCategories = map (keyByCategory . cxxToId) $ map snd categories-  depCategories = map keyByCategory $ concat $ map categoriesToIds deps-  categoriesToIds dep = map (\c -> CategoryIdentifier (cmPath dep) c (cmNamespace dep)) (cmCategories dep)-  cxxToId (CxxOutput (Just c) _ ns _ _ _) = CategoryIdentifier p (show c) (show ns)-  cxxToId _                               = undefined-  resolveCategory (fs,ca@(CxxOutput _ _ _ ns2 ds _)) =-    (cxxToId ca,CategoryObjectFile (cxxToId ca) rs fs) where-      rs = concat $ map (resolveDep categoryMap (map show ns2 ++ publicNamespaces) . show) ds--resolveCategoryDeps :: [String] -> [CompileMetadata] -> [CategoryIdentifier]-resolveCategoryDeps cs deps = resolvedCategories where-  publicNamespaces = getNamespacesForDeps deps-  resolvedCategories = concat $ map (resolveDep categoryMap publicNamespaces) cs-  categoryMap = Map.fromList depCategories-  depCategories = map (keyByCategory . cofCategory) $ filter isCategoryObjectFile $ concat $ map cmObjectFiles deps--keyByCategory :: CategoryIdentifier -> ((String,String),CategoryIdentifier)-keyByCategory c = ((ciCategory c,ciNamespace c),c)--resolveDep :: Map.Map (String,String) CategoryIdentifier -> [String] -> String -> [CategoryIdentifier]-resolveDep cm ns d = unwrap $ foldl (<|>) Nothing allChecks where-  allChecks = map (\n -> (d,n) `Map.lookup` cm >>= return . (:[])) ns-  unwrap (Just xs) = xs-  unwrap _         = [UnresolvedCategory d]+  deriving (Eq,Show)
src/Cli/CompileOptions.hs view
@@ -29,7 +29,6 @@   isCompileRecompile,   isCreateTemplates,   isExecuteTests,-  isOnlyShowPath,   maybeDisableHelp, ) where @@ -44,6 +43,7 @@     coExtraPaths :: [String],     coExtraRequires :: [String],     coSourcePrefix :: String,+    coExternalDefs :: [String],     coMode :: CompileMode,     coOutputName :: String,     coForce :: ForceMode@@ -60,6 +60,7 @@     coExtraPaths = [],     coExtraRequires = [],     coSourcePrefix = "",+    coExternalDefs = [],     coMode = CompileUnspecified,     coOutputName = "",     coForce = DoNotForce@@ -70,7 +71,6 @@ data ForceMode = DoNotForce | AllowRecompile | ForceRecompile | ForceAll deriving (Eq,Ord,Show)  data CompileMode =-  OnlyShowPath |   CompileBinary {     cbCategory :: String,     cbFunction :: String@@ -82,11 +82,7 @@   CompileRecompile |   CreateTemplates |   CompileUnspecified-  deriving (Eq,Read,Show)--isOnlyShowPath :: CompileMode -> Bool-isOnlyShowPath OnlyShowPath = True-isOnlyShowPath _            = False+  deriving (Eq,Show)  isCompileBinary :: CompileMode -> Bool isCompileBinary (CompileBinary _ _) = True
src/Cli/Compiler.hs view
@@ -17,7 +17,6 @@ -- Author: Kevin P. Barry [ta0kira@gmail.com]  module Cli.Compiler (-  rootPath,   runCompiler, ) where @@ -34,6 +33,7 @@ import Base.Mergeable import Cli.CompileMetadata import Cli.CompileOptions+import Cli.ProcessMetadata import Cli.TestRunner -- Not safe, due to Text.Regex.TDFA. import Compilation.CompileInfo import CompilerCxx.Category@@ -47,19 +47,11 @@ import Types.TypeCategory import Types.TypeInstance -import Paths_zeolite_lang (getDataFileName) --rootPath :: IO FilePath-rootPath = getDataFileName ""- runCompiler :: CompileOptions -> IO ()-runCompiler (CompileOptions _ _ _ _ _ _ _ _ OnlyShowPath _ _) = do-  p <- rootPath >>= canonicalizePath-  hPutStrLn stdout p-runCompiler (CompileOptions _ _ _ ds _ _ _ p (ExecuteTests tp) _ f) = do+runCompiler (CompileOptions _ _ _ ds _ _ _ p _ (ExecuteTests tp) _ f) = do   (backend,resolver) <- loadConfig-  ds' <- sequence $ map (preloadModule resolver) ds+  ds' <- sequence $ map (preloadModule backend resolver) ds   let possibleTests = Set.fromList $ concat $ map getTestsFromPreload ds'   case Set.toList $ allowTests `Set.difference` possibleTests of        [] -> return ()@@ -71,12 +63,12 @@   let passed = sum $ map (fst . fst) allResults   let failed = sum $ map (snd . fst) allResults   processResults passed failed (mergeAllM $ map snd allResults) where-    preloadModule r d = do+    preloadModule b r d = do       m <- loadMetadata (p </> d)       base <- resolveBaseModule r-      (fr1,deps1) <- loadPublicDeps [base,p </> d]+      (fr1,deps1) <- loadPublicDeps (getCompilerHash b) [base,p </> d]       checkAllowedStale fr1 f-      (fr2,deps2) <- loadPrivateDeps deps1+      (fr2,deps2) <- loadPrivateDeps (getCompilerHash b) deps1       checkAllowedStale fr2 f       return (d,m,deps1,deps2)     getTestsFromPreload (_,m,_,_) = cmTestFiles m@@ -106,12 +98,13 @@       | otherwise = do           hPutStrLn stderr $ "\nPassed: " ++ show passed ++ " test(s), Failed: " ++ show failed ++ " test(s)"           hPutStrLn stderr $ "Zeolite tests passed."-runCompiler (CompileOptions h _ _ ds _ _ _ p CompileRecompile _ f) = do-  fmap mergeAll $ sequence $ map recompileSingle ds where-    recompileSingle d0 = do+runCompiler (CompileOptions h _ _ ds _ _ _ p _ CompileRecompile _ f) = do+  (backend,_) <- loadConfig+  fmap mergeAll $ sequence $ map (recompileSingle $ getCompilerHash backend) ds where+    recompileSingle h2 d0 = do       let d = p </> d0       rm <- tryLoadRecompile d-      upToDate <- isPathUpToDate d+      upToDate <- isPathUpToDate h2 d       maybeCompile rm upToDate where         maybeCompile Nothing _ = do           hPutStrLn stderr $ "Path " ++ d0 ++ " has not been configured or compiled yet."@@ -119,7 +112,7 @@         maybeCompile (Just rm') upToDate           | f < ForceAll && upToDate = hPutStrLn stderr $ "Path " ++ d0 ++ " is up to date."           | otherwise = do-              let (RecompileMetadata p2 d is is2 es ep ec m o) = rm'+              let (ModuleConfig p2 d is is2 es ep ec ex m o) = rm'               -- In case the module is manually configured with a p such as "..",               -- since the absolute path might not be known ahead of time.               absolute <- canonicalizePath (p </> d0)@@ -133,16 +126,17 @@                   coExtraPaths = ep,                   coExtraRequires = ec,                   coSourcePrefix = fixed,+                  coExternalDefs = ex,                   coMode = m,                   coOutputName = o,                   coForce = if f == ForceAll then ForceRecompile else AllowRecompile                 }               runCompiler recompile-runCompiler (CompileOptions _ is is2 ds es ep ec p m o f) = do+runCompiler (CompileOptions _ is is2 ds es ep ec p ex m o f) = do   (backend,resolver) <- loadConfig   as  <- fmap fixPaths $ sequence $ map (resolveModule resolver p) is   as2 <- fmap fixPaths $ sequence $ map (resolveModule resolver p) is2-  (fr,deps) <- loadPublicDeps (as ++ as2)+  (fr,deps) <- loadPublicDeps (getCompilerHash backend) (as ++ as2)   checkAllowedStale fr f   if isCreateTemplates m       then sequence_ $ map (processTemplates deps) ds@@ -162,7 +156,7 @@         exitFailure       eraseCachedData (p </> d)       absolute <- canonicalizePath p-      let rm = RecompileMetadata {+      let rm = ModuleConfig {         rmRoot = absolute,         rmPath = d,         rmPublicDeps = as,@@ -170,6 +164,7 @@         rmExtraFiles = sort es,         rmExtraPaths = sort ep,         rmExtraRequires = sort ec,+        rmExternalDefs = ex,         rmMode = m,         rmOutputName = o       }@@ -182,7 +177,7 @@       deps2 <- if isBase                   then return deps                   else do-                    (fr,bpDeps) <- loadPublicDeps [base]+                    (fr,bpDeps) <- loadPublicDeps (getCompilerHash b) [base]                     checkAllowedStale fr f                     return $ bpDeps ++ deps       let ss = fixPaths $ getSourceFilesForDeps deps2@@ -207,7 +202,8 @@           formatWarnings fs           let (pc,mf,fs') = getCompileSuccess fs           let ss = map (\ns -> getCachedPath (p </> d) ns "") $ nub $ filter (not . null) $ map show $ [ns0] ++ map coNamespace fs'-          let paths' = paths ++ ep' ++ ss+          ss' <- sequence $ map canonicalizePath ss+          let paths' = paths ++ ep' ++ ss'           let hxx   = filter (isSuffixOf ".hpp" . coFilename)       fs'           let other = filter (not . isSuffixOf ".hpp" . coFilename) fs'           os1 <- sequence $ map (writeOutputFile b (show ns0) paths' d) $ hxx ++ other@@ -222,13 +218,14 @@           path <- canonicalizePath $ p </> d           let os1' = resolveObjectDeps path os1 deps           let cm0 = CompileMetadata {+              cmVersionHash = getCompilerHash b,               cmPath = path,               cmNamespace = show ns0,               cmPublicDeps = as,               cmPrivateDeps = as2,               cmExtraRequires = [],               cmCategories = sort $ map show pc,-              cmSubdirs = sort $ ss ++ ep',+              cmSubdirs = sort $ ss' ++ ep',               cmPublicFiles = sort ps,               cmPrivateFiles = sort xs,               cmTestFiles = sort ts,@@ -238,6 +235,7 @@             }           let ec' = resolveCategoryDeps ec (cm0:deps)           let cm = CompileMetadata {+              cmVersionHash = cmVersionHash cm0,               cmPath = cmPath cm0,               cmNamespace = cmNamespace cm0,               cmPublicDeps = cmPublicDeps cm0,@@ -326,7 +324,8 @@           cnBase = tm1,           cnNamespaces = ns0:ns2,           cnPublic = cs'',-          cnPrivate = xa+          cnPrivate = xa,+          cnExternal = ex         }       xx <- compileCategoryModule cm       let pc = map getCategoryName cs''@@ -359,8 +358,8 @@           hPutStr h $ concat $ map (++ "\n") content           hClose h           base <- resolveBaseModule r-          (_,bpDeps) <- loadPublicDeps [base]-          (_,deps2) <- loadPrivateDeps (bpDeps ++ deps)+          (_,bpDeps) <- loadPublicDeps (getCompilerHash b) [base]+          (_,deps2) <- loadPrivateDeps (getCompilerHash b) (bpDeps ++ deps)           let paths = fixPaths $ getIncludePathsForDeps deps2           let os    = getObjectFilesForDeps deps2           let req2 = getRequiresFromDeps deps2
src/Cli/ParseCompileOptions.hs view
@@ -19,17 +19,22 @@ module Cli.ParseCompileOptions (   optionHelpText,   parseCompileOptions,+  tryFastModes,   validateCompileOptions, ) where  import Control.Monad (when) import Data.List (intercalate,isSuffixOf)+import System.Directory+import System.Exit import System.FilePath (takeExtension)+import System.IO import Text.Regex.TDFA -- Not safe!  import Base.CompileError-import Cli.CompileMetadata (allowedExtraTypes) import Cli.CompileOptions+import Cli.ProcessMetadata (allowedExtraTypes)+import Config.LoadConfig (compilerVersion,rootPath)   optionHelpText :: [String]@@ -40,7 +45,8 @@     "zeolite [options...] -r [paths...]",     "zeolite [options...] -t [paths...]",     "zeolite [options...] --templates [paths...]",-    "zeolite [options...] --get-path",+    "zeolite --get-path",+    "zeolite --version",     "",     "Modes:",     "  -c: Only compile the individual files. (default)",@@ -49,6 +55,7 @@     "  -t: Only execute tests, without other compilation.",     "  --templates: Only create C++ templates for undefined categories in .0rp sources.",     "  --get-path: Show the data path and immediately exit.",+    "  --version: Show the compiler version and immediately exit.",     "",     "Options:",     "  -e [path|file]: Include an extra source file or path during compilation.",@@ -67,6 +74,22 @@ defaultMainFunc :: String defaultMainFunc = "run" +tryFastModes :: [String] -> IO ()+tryFastModes ("--get-path":os) = do+  when (not $ null os) $ hPutStrLn stderr $ "Ignoring extra arguments: " ++ show os+  p <- rootPath >>= canonicalizePath+  hPutStrLn stdout p+  if null os+     then exitSuccess+     else exitFailure+tryFastModes ("--version":os) = do+  when (not $ null os) $ hPutStrLn stderr $ "Ignoring extra arguments: " ++ show os+  hPutStrLn stdout compilerVersion+  if null os+     then exitSuccess+     else exitFailure+tryFastModes _ = return ()+ parseCompileOptions :: CompileErrorM m => [String] -> m CompileOptions parseCompileOptions = parseAll emptyCompileOptions . zip ([1..] :: [Int]) where   parseAll co [] = return co@@ -89,96 +112,92 @@    parseSingle _ [] = undefined -  parseSingle (CompileOptions _ is is2 ds es ep ec p m o f) ((_,"-h"):os) =-    return (os,CompileOptions HelpNeeded is is2 ds es ep ec p m o f)+  parseSingle (CompileOptions _ is is2 ds es ep ec p ex m o f) ((_,"-h"):os) =+    return (os,CompileOptions HelpNeeded is is2 ds es ep ec p ex m o f) -  parseSingle (CompileOptions h is is2 ds es ep ec p m o _) ((_,"-f"):os) =-    return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p m o ForceAll)+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o _) ((_,"-f"):os) =+    return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p ex m o ForceAll) -  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,"-c"):os)+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o f) ((n,"-c"):os)     | m /= CompileUnspecified = argError n "-c" "Compiler mode already set."-    | otherwise = return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p CompileIncremental o f)+    | otherwise = return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p ex CompileIncremental o f) -  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,"-r"):os)+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o f) ((n,"-r"):os)     | m /= CompileUnspecified = argError n "-r" "Compiler mode already set."-    | otherwise = return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p CompileRecompile o f)--  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,"-t"):os)-    | m /= CompileUnspecified = argError n "-t" "Compiler mode already set."-    | otherwise = return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p (ExecuteTests []) o f)+    | otherwise = return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p ex CompileRecompile o f) -  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,"--templates"):os)+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o f) ((n,"-t"):os)     | m /= CompileUnspecified = argError n "-t" "Compiler mode already set."-    | otherwise = return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p CreateTemplates o f)+    | otherwise = return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p ex (ExecuteTests []) o f) -  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,"--get-path"):os)+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o f) ((n,"--templates"):os)     | m /= CompileUnspecified = argError n "-t" "Compiler mode already set."-    | otherwise = return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p OnlyShowPath o f)+    | otherwise = return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p ex CreateTemplates o f) -  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,"-m"):os)+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o f) ((n,"-m"):os)     | m /= CompileUnspecified = argError n "-m" "Compiler mode already set."     | otherwise = update os where       update ((n2,c):os2) =  do         (t,fn) <- check $ break (== '.') c         checkCategoryName n2 t  "-m"         checkFunctionName n2 fn "-m"-        return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p (CompileBinary t fn) o f) where+        return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p ex (CompileBinary t fn) o f) where           check (t,"")     = return (t,defaultMainFunc)           check (t,'.':fn) = return (t,fn)           check _          = argError n2 "-m" $ "Invalid entry point \"" ++ c ++ "\"."       update _ = argError n "-m" "Requires a category name." -  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,"-o"):os)+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o f) ((n,"-o"):os)     | not $ null o = argError n "-o" "Output name already set."     | otherwise = update os where       update ((n2,o2):os2) = do         checkPathName n2 o2 "-o"-        return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p m o2 f)+        return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p ex m o2 f)       update _ = argError n "-o" "Requires an output name." -  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,"-i"):os) = update os where+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o f) ((n,"-i"):os) = update os where     update ((n2,d):os2)       | isSuffixOf ".0rp" d = argError n2 d "Cannot directly include .0rp source files."       | isSuffixOf ".0rx" d = argError n2 d "Cannot directly include .0rx source files."       | isSuffixOf ".0rt" d = argError n2 d "Cannot directly include .0rt test files."       | otherwise = do           checkPathName n2 d "-i"-          return (os2,CompileOptions (maybeDisableHelp h) (is ++ [d]) is2 ds es ep ec p m o f)+          return (os2,CompileOptions (maybeDisableHelp h) (is ++ [d]) is2 ds es ep ec p ex m o f)     update _ = argError n "-i" "Requires a source path." -  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,"-I"):os) = update os where+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o f) ((n,"-I"):os) = update os where     update ((n2,d):os2)       | isSuffixOf ".0rp" d = argError n2 d "Cannot directly include .0rp source files."       | isSuffixOf ".0rx" d = argError n2 d "Cannot directly include .0rx source files."       | isSuffixOf ".0rt" d = argError n2 d "Cannot directly include .0rt test files."       | otherwise = do           checkPathName n2 d "-i"-          return (os2,CompileOptions (maybeDisableHelp h) is (is2 ++ [d]) ds es ep ec p m o f)+          return (os2,CompileOptions (maybeDisableHelp h) is (is2 ++ [d]) ds es ep ec p ex m o f)     update _ = argError n "-I" "Requires a source path." -  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,"-e"):os) = update os where+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o f) ((n,"-e"):os) = update os where     update ((n2,e):os2)       | any (flip isSuffixOf e) allowedExtraTypes = do           checkPathName n2 e "-e"-          return (os2,CompileOptions (maybeDisableHelp h) is is2 ds (es ++ [e]) ep ec p m o f)+          return (os2,CompileOptions (maybeDisableHelp h) is is2 ds (es ++ [e]) ep ec p ex m o f)       | takeExtension e == "" || e == "." = do           checkPathName n2 e "-e"-          return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es (ep ++ [e]) ec p m o f)+          return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es (ep ++ [e]) ec p ex m o f)       | otherwise = argError n2 "-e" $ "Only " ++ intercalate ", " allowedExtraTypes ++                                        " and directory sources are allowed."     update _ = argError n "-e" "Requires a source filename." -  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,"-p"):os)+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o f) ((n,"-p"):os)     | not $ null p = argError n "-p" "Path prefix already set."     | otherwise = update os where       update ((n2,p2):os2) = do         checkPathName n2 p2 "-p"-        return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p2 m o f)+        return (os2,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p2 ex m o f)       update _ = argError n "-p" "Requires a path prefix."    parseSingle _ ((n,o@('-':_)):_) = argError n o "Unknown option." -  parseSingle (CompileOptions h is is2 ds es ep ec p m o f) ((n,d):os)+  parseSingle (CompileOptions h is is2 ds es ep ec p ex m o f) ((n,d):os)       | isSuffixOf ".0rp" d = argError n d "Cannot directly include .0rp source files."       | isSuffixOf ".0rx" d = argError n d "Cannot directly include .0rx source files."       | isSuffixOf ".0rt" d = do@@ -186,13 +205,13 @@           argError n d "Test mode (-t) must be enabled before listing any .0rt test files."         checkPathName n d ""         let (ExecuteTests tp) = m-        return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p (ExecuteTests $ tp ++ [d]) o f)+        return (os,CompileOptions (maybeDisableHelp h) is is2 ds es ep ec p ex (ExecuteTests $ tp ++ [d]) o f)       | otherwise = do         checkPathName n d ""-        return (os,CompileOptions (maybeDisableHelp h) is is2 (ds ++ [d]) es ep ec p m o f)+        return (os,CompileOptions (maybeDisableHelp h) is is2 (ds ++ [d]) es ep ec p ex m o f)  validateCompileOptions :: CompileErrorM m => CompileOptions -> m CompileOptions-validateCompileOptions co@(CompileOptions h is is2 ds es ep _ p m o _)+validateCompileOptions co@(CompileOptions h is is2 ds es ep _ _ _ m o _)   | h /= HelpNotNeeded = return co    | (not $ null o) && (isCompileIncremental m) =@@ -217,21 +236,10 @@   | (not $ null $ es ++ ep) && (isCompileRecompile m) =     compileError "Extra files (-e) are not allowed in recompile mode (-r)." -  | (not $ null p) && (isOnlyShowPath m) =-    compileError "Path prefix (-p) is not allowed in path mode (---get-path)."-  | (not $ null o) && (isOnlyShowPath m) =-    compileError "Output filename (-o) is not allowed in path mode (---get-path)."-  | (not $ null $ is ++ is2) && (isOnlyShowPath m) =-    compileError "Include paths (-i/-I) are not allowed in path mode (---get-path)."-  | (not $ null $ es ++ ep) && (isOnlyShowPath m) =-    compileError "Extra files (-e) are not allowed in path mode (---get-path)."-  | (not $ null ds) && (isOnlyShowPath m) =-    compileError "Input paths are not allowed in path mode (---get-path)."-   | length ds > 1 && length (es ++ ep) > 0 =     compileError "Extra files and paths (-e) cannot be used with multiple input paths, to avoid ambiguity." -  | not (isOnlyShowPath m) && null ds =+  | null ds =     compileError "Please specify at least one input path."   | (length ds /= 1) && (isCompileBinary m) =     compileError "Specify exactly one input path for binary mode (-m)."
+ src/Cli/ParseMetadata.hs view
@@ -0,0 +1,320 @@+{- -----------------------------------------------------------------------------+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]++module Cli.ParseMetadata (+  ConfigFormat,+  autoReadConfig,+  autoWriteConfig,+) where++import Control.Monad (when)+import Text.Parsec+import Text.Parsec.String++import Base.CompileError+import Cli.CompileMetadata+import Cli.CompileOptions+import Parser.Common+import Parser.TypeCategory ()+import Parser.TypeInstance ()+import Text.Regex.TDFA -- Not safe!+import Types.TypeCategory (FunctionName)+import Types.TypeInstance (CategoryName)+++class ConfigFormat a where+  readConfig :: Parser a+  writeConfig :: CompileErrorM m => a -> m [String]++autoReadConfig :: (ConfigFormat a, CompileErrorM m) => String -> String -> m a+autoReadConfig f s  = unwrap parsed where+  parsed = parse (between optionalSpace endOfDoc readConfig) f s+  unwrap (Left e)  = compileError (show e)+  unwrap (Right t) = return t++autoWriteConfig ::  (ConfigFormat a, CompileErrorM m) => a -> m String+autoWriteConfig = fmap unlines . writeConfig++structOpen :: Parser ()+structOpen = sepAfter (string_ "{")++structClose :: Parser ()+structClose = sepAfter (string_ "}")++indents :: [String] -> [String]+indents = map indent++indent :: String -> String+indent = ("  " ++)++prependFirst :: String -> [String] -> [String]+prependFirst s0 (s:ss) = (s0 ++ s):ss+prependFirst s0 _      = [s0]++validateCategoryName :: CompileErrorM m => String -> m ()+validateCategoryName c =+    when (not $ c =~ "^[A-Z][A-Za-z0-9]*$") $+      compileError $ "Invalid category name: \"" ++ c ++ "\""++parseCategoryName :: Parser String+parseCategoryName = fmap show (sourceParser :: Parser CategoryName)++validateFunctionName :: CompileErrorM m => String -> m ()+validateFunctionName f =+    when (not $ f =~ "^[a-z][A-Za-z0-9]*$") $+      compileError $ "Invalid function name: \"" ++ f ++ "\""++parseFunctionName :: Parser String+parseFunctionName = fmap show (sourceParser :: Parser FunctionName)++validateHash :: CompileErrorM m => String -> m ()+validateHash h =+    when (not $ h =~ "^[A-Za-z0-9]+$") $+      compileError $ "Version hash must be a hex string: \"" ++ h ++ "\""++parseHash :: Parser String+parseHash = labeled "version hash" $ sepAfter (many1 hexDigit)++validateNamespace :: CompileErrorM m => String -> m ()+validateNamespace ns =+    when (not $ ns =~ "^[A-Za-z][A-Za-z0-9_]*$") $+      compileError $ "Invalid category namespace: \"" ++ ns ++ "\""++parseNamespace :: Parser String+parseNamespace = labeled "namespace" $ do+    b <- lower+    e <- sepAfter $ many (alphaNum <|> char '_')+    return (b:e)++parseQuoted :: Parser String+parseQuoted = labeled "quoted string" $ do+  string_ "\""+  ss <- manyTill stringChar (string_ "\"")+  optionalSpace+  return ss++parseList :: Parser a -> Parser [a]+parseList p = labeled "list" $ do+  sepAfter (string_ "[")+  xs <- manyTill (sepAfter p) (string_ "]")+  optionalSpace+  return xs++parseOptional :: String -> a -> Parser a -> Parser a+parseOptional l def p = parseRequired l p <|> return def++parseRequired :: String -> Parser a -> Parser a+parseRequired l p = do+    try $ sepAfter (string_ l)+    p++instance ConfigFormat CompileMetadata where+  readConfig = do+    h <-   parseRequired "version_hash:"  parseHash+    p <-   parseRequired "path:"          parseQuoted+    ns <-  parseRequired "namespace:"     parseNamespace+    is <-  parseRequired "public_deps:"   (parseList parseQuoted)+    is2 <- parseRequired "private_deps:"  (parseList parseQuoted)+    es <-  parseRequired "extra:"         (parseList readConfig)+    cs <-  parseRequired "categories:"    (parseList parseCategoryName)+    ds <-  parseRequired "subdirs:"       (parseList parseQuoted)+    ps <-  parseRequired "public_files:"  (parseList parseQuoted)+    xs <-  parseRequired "private_files:" (parseList parseQuoted)+    ts <-  parseRequired "test_files:"    (parseList parseQuoted)+    hxx <- parseRequired "hxx_files:"     (parseList parseQuoted)+    cxx <- parseRequired "cxx_files:"     (parseList parseQuoted)+    os <-  parseRequired "object_files:"  (parseList readConfig)+    return (CompileMetadata h p ns is is2 es cs ds ps xs ts hxx cxx os)+  writeConfig m = do+    validateHash (cmVersionHash m)+    validateNamespace (cmNamespace m)+    _ <- collectAllOrErrorM $ map validateCategoryName (cmCategories m)+    extra   <- fmap concat $ collectAllOrErrorM $ map writeConfig $ cmExtraRequires m+    objects <- fmap concat $ collectAllOrErrorM $ map writeConfig $ cmObjectFiles m+    return $ [+        "version_hash: " ++ (cmVersionHash m),+        "path: " ++ (show $ cmPath m),+        "namespace: " ++ (cmNamespace m),+        "public_deps: ["+      ] ++ indents (map show $ cmPublicDeps m) ++ [+        "]",+        "private_deps: ["+      ] ++ indents (map show $ cmPrivateDeps m) ++ [+        "]",+        "extra: ["+      ] ++ indents extra ++ [+        "]",+        "categories: ["+      ] ++ indents (cmCategories m) ++ [+        "]",+        "subdirs: ["+      ] ++ indents (map show $ cmSubdirs m) ++ [+        "]",+        "public_files: ["+      ] ++ indents (map show $ cmPublicFiles m) ++ [+        "]",+        "private_files: ["+      ] ++ indents (map show $ cmPrivateFiles m) ++ [+        "]",+        "test_files: ["+      ] ++ indents (map show $ cmTestFiles m) ++ [+        "]",+        "hxx_files: ["+      ] ++ indents (map show $ cmHxxFiles m) ++ [+        "]",+        "cxx_files: ["+      ] ++ indents (map show $ cmCxxFiles m) ++ [+        "]",+        "object_files: ["+      ] ++ indents objects ++ [+        "]"+      ]++instance ConfigFormat ObjectFile where+  readConfig = category <|> other where+    category = do+      sepAfter (string_ "category_object")+      structOpen+      c <-  parseRequired "category:" readConfig+      rs <- parseRequired "requires:" (parseList readConfig)+      fs <- parseRequired "files:"    (parseList parseQuoted)+      structClose+      return (CategoryObjectFile c rs fs)+    other = do+      sepAfter (string_ "other_object")+      structOpen+      f <- parseRequired "file:" parseQuoted+      structClose+      return (OtherObjectFile f)+  writeConfig (CategoryObjectFile c rs fs) = do+    category <- writeConfig c+    requires <- fmap concat $ collectAllOrErrorM $ map writeConfig rs+    return $ [+        "category_object {"+      ] ++ indents ("category: " `prependFirst` category) ++ [+        indent "requires: ["+      ] ++ (indents . indents) requires ++ [+        indent "]",+        indent "files: ["+      ] ++ (indents . indents) (map show fs) ++ [+        indent "]",+        "}"+      ]+  writeConfig (OtherObjectFile f) = do+    return $ [+        "other_object {",+        indent ("file: " ++ show f),+        "}"+      ]++instance ConfigFormat CategoryIdentifier where+  readConfig = category <|> unresolved where+    category = do+      sepAfter (string_ "category")+      structOpen+      c <-  parseRequired "name:"      parseCategoryName+      ns <- parseRequired "namespace:" parseNamespace+      p <-  parseRequired "path:"      parseQuoted+      structClose+      return (CategoryIdentifier p c ns)+    unresolved = do+      sepAfter (string_ "unresolved")+      structOpen+      c <- parseRequired "name:" parseCategoryName+      structClose+      return (UnresolvedCategory c)+  writeConfig (CategoryIdentifier p c ns) = do+    validateCategoryName c+    validateNamespace ns+    return $ [+        "category {",+        indent $ "name: " ++ c,+        indent $ "namespace: " ++ ns,+        indent $ "path: " ++ show p,+        "}"+      ]+  writeConfig (UnresolvedCategory c) = do+    validateCategoryName c+    return $ ["unresolved { " ++ "name: " ++ c ++ " " ++ "}"]++instance ConfigFormat ModuleConfig where+  readConfig = do+      p <-   parseOptional "root:"           "" parseQuoted+      d <-   parseRequired "path:"              parseQuoted+      is <-  parseOptional "public_deps:"    [] (parseList parseQuoted)+      is2 <- parseOptional "private_deps:"   [] (parseList parseQuoted)+      es <-  parseOptional "extra_files:"    [] (parseList parseQuoted)+      ep <-  parseOptional "extra_paths:"    [] (parseList parseQuoted)+      ec <-  parseOptional "always_include:" [] (parseList parseCategoryName)+      ex <-  parseOptional "external:"       [] (parseList parseCategoryName)+      m <-   parseRequired "mode:"              readConfig+      o <-   parseOptional "output:"         "" parseQuoted+      return (ModuleConfig p d is is2 es ep ec ex m o)+  writeConfig m = do+    _ <- collectAllOrErrorM $ map validateCategoryName (rmExtraRequires m)+    _ <- collectAllOrErrorM $ map validateCategoryName (rmExternalDefs m)+    mode <- writeConfig (rmMode m)+    return $ [+        "root: " ++ show (rmRoot m),+        "path: " ++ show (rmPath m),+        "public_deps: ["+      ] ++ indents (map show $ rmPublicDeps m) ++ [+        "]",+        "private_deps: ["+      ] ++ indents (map show $ rmPrivateDeps m) ++ [+        "]",+        "extra_files: ["+      ] ++ indents (map show $ rmExtraFiles m) ++ [+        "]",+        "extra_paths: ["+      ] ++ indents (map show $ rmExtraPaths m) ++ [+        "]",+        "always_include: ["+      ] ++ indents (rmExtraRequires m) ++ [+        "]",+        "external: ["+      ] ++ indents (rmExternalDefs m) ++ [+        "]"+      ] ++ "mode: " `prependFirst` mode ++ output where+      output = if null (rmOutputName m)+                  then []+                  else ["output: " ++ show (rmOutputName m)]++instance ConfigFormat CompileMode where+  readConfig = labeled "compile mode" $ binary <|> incremental where+    binary = do+      sepAfter (string_ "binary")+      structOpen+      c <- parseRequired "category:" parseCategoryName+      f <- parseRequired "function:" parseFunctionName+      structClose+      return (CompileBinary c f)+    incremental = do+      sepAfter (string_ "incremental")+      return CompileIncremental+  writeConfig (CompileBinary c f) = do+    validateCategoryName c+    validateFunctionName f+    return $ [+        "binary {",+        indent ("category: " ++ c),+        indent ("function: " ++ f),+        "}"+      ]+  writeConfig CompileIncremental = return ["incremental"]+  writeConfig _ = compileError "Invalid compile mode"
+ src/Cli/ProcessMetadata.hs view
@@ -0,0 +1,364 @@+{- -----------------------------------------------------------------------------+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]++module Cli.ProcessMetadata (+  allowedExtraTypes,+  createCachePath,+  eraseCachedData,+  findSourceFiles,+  fixPath,+  getCachedPath,+  getCacheRelativePath,+  getIncludePathsForDeps,+  getNamespacesForDeps,+  getObjectFilesForDeps,+  getObjectFileResolver,+  getRealPathsForDeps,+  getRequiresFromDeps,+  getSourceFilesForDeps,+  isPathConfigured,+  isPathUpToDate,+  loadPrivateDeps,+  loadPublicDeps,+  loadMetadata,+  resolveCategoryDeps,+  resolveObjectDeps,+  sortCompiledFiles,+  tryLoadRecompile,+  writeCachedFile,+  writeMetadata,+  writeRecompile,+) where++import Control.Applicative ((<|>))+import Control.Monad (when)+import Data.List (nub,isSuffixOf)+import Data.Maybe (isJust)+import System.Directory+import System.Exit (exitFailure)+import System.FilePath+import System.IO+import qualified Data.Map as Map+import qualified Data.Set as Set++import Base.CompileError+import Cli.CompileMetadata+import Cli.ParseMetadata -- Not safe, due to Text.Regex.TDFA.+import Compilation.CompileInfo+import CompilerCxx.Category (CxxOutput(..))+import Types.TypeCategory+import Types.TypeInstance+++cachedDataPath :: String+cachedDataPath = ".zeolite-cache"++recompileFilename :: String+recompileFilename = ".zeolite-module"++metadataFilename :: String+metadataFilename = "compile-metadata"++allowedExtraTypes :: [String]+allowedExtraTypes = [".hpp",".cpp",".h",".cc",".a",".o"]++loadMetadata :: String -> IO CompileMetadata+loadMetadata p = do+  let f = p </> cachedDataPath </> metadataFilename+  isFile <- doesFileExist p+  when isFile $ do+    hPutStrLn stderr $ "Path \"" ++ p ++ "\" is not a directory."+    exitFailure+  isDir <- doesDirectoryExist p+  when (not isDir) $ do+    hPutStrLn stderr $ "Path \"" ++ p ++ "\" does not exist."+    exitFailure+  filePresent <- doesFileExist f+  when (not filePresent) $ do+    hPutStrLn stderr $ "Module \"" ++ p ++ "\" has not been compiled yet."+    exitFailure+  c <- readFile f+  let m = autoReadConfig f c+  if isCompileError m+     then do+       hPutStrLn stderr $ "Could not parse metadata from \"" ++ p ++ "\"; please recompile."+       hPutStrLn stderr $ show (getCompileError m)+       exitFailure+     else return (getCompileSuccess m)++tryLoadMetadata :: String -> IO (Maybe CompileMetadata)+tryLoadMetadata p = tryLoadData $ (p </> cachedDataPath </> metadataFilename)++tryLoadRecompile :: String -> IO (Maybe ModuleConfig)+tryLoadRecompile p = tryLoadData $ (p </> recompileFilename)++tryLoadData :: ConfigFormat a => String -> IO (Maybe a)+tryLoadData f = do+  filePresent <- doesFileExist f+  if not filePresent+    then return Nothing+    else do+      c <- readFile f+      let m = autoReadConfig f c+      if isCompileError m+         then do+           hPutStrLn stderr $ "Could not parse config file:"+           hPutStrLn stderr $ show (getCompileError m)+           return Nothing+         else return $ Just (getCompileSuccess m)++isPathUpToDate :: String -> String -> IO Bool+isPathUpToDate h p = do+  m <- tryLoadMetadata p+  case m of+       Nothing -> return False+       Just _ -> do+         (fr,_) <- loadDepsCommon True h (\m2 -> cmPublicDeps m2 ++ cmPrivateDeps m2) [p]+         return fr++isPathConfigured :: String -> IO Bool+isPathConfigured p = tryLoadRecompile p >>= return . isJust++writeMetadata :: String -> CompileMetadata -> IO ()+writeMetadata p m = do+  p' <- canonicalizePath p+  hPutStrLn stderr $ "Writing metadata for \"" ++ p' ++ "\"."+  let m' = autoWriteConfig m+  if isCompileError m'+     then do+       hPutStrLn stderr $ "Could not serialize metadata."+       hPutStrLn stderr $ show (getCompileError m')+       exitFailure+     else writeCachedFile p' "" metadataFilename (getCompileSuccess m')++writeRecompile :: String -> ModuleConfig -> IO ()+writeRecompile p m = do+  p' <- canonicalizePath p+  hPutStrLn stderr $ "Updating config for \"" ++ p' ++ "\"."+  let m' = autoWriteConfig m+  if isCompileError m'+     then do+       hPutStrLn stderr $ "Could not serialize module config."+       hPutStrLn stderr $ show (getCompileError m')+       exitFailure+     else writeFile (p </> recompileFilename) (getCompileSuccess m')++eraseCachedData :: String -> IO ()+eraseCachedData p = do+  let d  = p </> cachedDataPath+  dirExists <- doesDirectoryExist d+  when dirExists $ removeDirectoryRecursive d++createCachePath :: String -> IO ()+createCachePath p = do+  let f = p </> cachedDataPath+  exists <- doesDirectoryExist f+  when (not exists) $ createDirectoryIfMissing False f++writeCachedFile :: String -> String -> String -> String -> IO ()+writeCachedFile p ns f c = do+  createCachePath p+  createDirectoryIfMissing False $ p </> cachedDataPath </> ns+  writeFile (getCachedPath p ns f) c++getCachedPath :: String -> String -> String -> String+getCachedPath p ns f = fixPath $ p </> cachedDataPath </> ns </> f++getCacheRelativePath :: String -> String+getCacheRelativePath f = ".." </> f++findSourceFiles :: String -> String -> IO ([String],[String],[String])+findSourceFiles p0 p = do+  let absolute = p0 </> p+  isFile <- doesFileExist absolute+  when isFile $ do+    hPutStrLn stderr $ "Path \"" ++ absolute ++ "\" is not a directory."+    exitFailure+  isDir <- doesDirectoryExist absolute+  when (not isDir) $ do+    hPutStrLn stderr $ "Path \"" ++ absolute ++ "\" does not exist."+    exitFailure+  ds <- getDirectoryContents absolute >>= return . map (p </>)+  let ps = filter (isSuffixOf ".0rp") ds+  let xs = filter (isSuffixOf ".0rx") ds+  let ts = filter (isSuffixOf ".0rt") ds+  return (ps,xs,ts)++getRealPathsForDeps :: [CompileMetadata] -> [String]+getRealPathsForDeps = map cmPath++getSourceFilesForDeps :: [CompileMetadata] -> [String]+getSourceFilesForDeps = concat . map extract where+  extract m = map (cmPath m </>) (cmPublicFiles m)++getRequiresFromDeps :: [CompileMetadata] -> [CategoryIdentifier]+getRequiresFromDeps = concat . map cmExtraRequires++getNamespacesForDeps :: [CompileMetadata] -> [String]+getNamespacesForDeps = filter (not . null) . map cmNamespace++getIncludePathsForDeps :: [CompileMetadata] -> [String]+getIncludePathsForDeps = concat . map cmSubdirs++getObjectFilesForDeps :: [CompileMetadata] -> [ObjectFile]+getObjectFilesForDeps = concat . map cmObjectFiles++loadPublicDeps :: String -> [String] -> IO (Bool,[CompileMetadata])+loadPublicDeps h = loadDepsCommon False h cmPublicDeps++loadPrivateDeps :: String -> [CompileMetadata] -> IO (Bool,[CompileMetadata])+loadPrivateDeps h ms = do+  (fr,new) <- loadDepsCommon False h (\m -> cmPublicDeps m ++ cmPrivateDeps m) toFind+  return (fr,ms ++ existing ++ new) where+    paths = concat $ map (\m -> cmPublicDeps m ++ cmPrivateDeps m) ms+    (existing,toFind) = foldl splitByExisting ([],[]) $ nub paths+    byPath = Map.fromList $ map (\m -> (cmPath m,m)) ms+    splitByExisting (es,fs) p =+      case p `Map.lookup` byPath of+          Just m  -> (es ++ [m],fs)+          Nothing -> (es,fs ++ [p])++loadDepsCommon :: Bool -> String -> (CompileMetadata -> [String]) -> [String] -> IO (Bool,[CompileMetadata])+loadDepsCommon s h f ps = fmap snd $ fixedPaths >>= collect (Set.empty,(True,[])) where+  fixedPaths = sequence $ map canonicalizePath ps+  collect xa@(pa,(fr,xs)) (p:ps2)+    | p `Set.member` pa = collect xa ps2+    | otherwise = do+        when (not s) $ hPutStrLn stderr $ "Loading metadata for dependency \"" ++ p ++ "\"."+        m <- loadMetadata p+        fresh <- checkModuleFreshness p m+        when (not s && not fresh) $+          hPutStrLn stderr $ "Module \"" ++ p ++ "\" is out of date and should be recompiled."+        let sameVersion = checkModuleVersionHash h m+        when (not s && not sameVersion) $+          hPutStrLn stderr $ "Module \"" ++ p ++ "\" was compiled with a different compiler setup."+        collect (p `Set.insert` pa,(sameVersion && fresh && fr,xs ++ [m])) (ps2 ++ f m)+  collect xa _ = return xa++fixPath :: String -> String+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++sortCompiledFiles :: [String] -> ([String],[String],[String])+sortCompiledFiles = foldl split ([],[],[]) where+  split fs@(hxx,cxx,os) f+    | isSuffixOf ".hpp" f = (hxx++[f],cxx,os)+    | isSuffixOf ".h"   f = (hxx++[f],cxx,os)+    | isSuffixOf ".cpp" f = (hxx,cxx++[f],os)+    | isSuffixOf ".cc"  f = (hxx,cxx++[f],os)+    | isSuffixOf ".a"   f = (hxx,cxx,os++[f])+    | isSuffixOf ".o"   f = (hxx,cxx,os++[f])+    | otherwise = fs++checkModuleVersionHash :: String -> CompileMetadata -> Bool+checkModuleVersionHash h m = cmVersionHash m == h++checkModuleFreshness :: String -> CompileMetadata -> IO Bool+checkModuleFreshness p (CompileMetadata _ p2 _ is is2 _ _ _ ps xs ts hxx cxx _) = do+  time <- getModificationTime $ getCachedPath p "" metadataFilename+  (ps2,xs2,ts2) <- findSourceFiles p ""+  let e1 = checkMissing ps ps2+  let e2 = checkMissing xs xs2+  let e3 = checkMissing ts ts2+  rm <- check time (p </> recompileFilename)+  f1 <- sequence $ map (\p3 -> check time $ getCachedPath p3 "" metadataFilename) $ is ++ is2+  f2 <- sequence $ map (check time . (p2 </>)) $ ps ++ xs+  f3 <- sequence $ map (check time . getCachedPath p2 "") $ hxx ++ cxx+  let fresh = not $ any id $ [rm,e1,e2,e3] ++ f1 ++ f2 ++ f3+  return fresh where+    check time f = do+      exists <- doesFileOrDirExist f+      if not exists+         then return True+         else do+           time2 <- getModificationTime f+           return (time2 > time)+    checkMissing s0 s1 = not $ null $ (Set.fromList s1) `Set.difference` (Set.fromList s0)+    doesFileOrDirExist f2 = do+      existF <- doesFileExist f2+      if existF+        then return True+        else doesDirectoryExist f2++getObjectFileResolver :: [CategoryIdentifier] -> [ObjectFile] -> [Namespace] -> [CategoryName] -> [String]+getObjectFileResolver ce os ns ds = resolved ++ nonCategories where+  categories    = filter isCategoryObjectFile os+  nonCategories = map oofFile $ filter (not . isCategoryObjectFile) os+  categoryMap = Map.fromList $ map keyByCategory2 categories+  keyByCategory2 o = ((ciCategory $ cofCategory o,ciNamespace $ cofCategory o),o)+  objectMap = Map.fromList $ map keyBySpec categories+  keyBySpec o = (cofCategory o,o)+  directDeps = concat $ map (resolveDep2 . show) ds+  directResolved = map cofCategory directDeps ++ ce+  resolveDep2 d = unwrap $ foldl (<|>) Nothing allChecks <|> Just [] where+    allChecks = map (\n -> (d,n) `Map.lookup` categoryMap >>= return . (:[])) (map show ns ++ [""])+    unwrap (Just xs) = xs+    unwrap _         = []+  (_,_,resolved) = collectAll Set.empty Set.empty directResolved+  collectAll ca fa [] = (ca,fa,[])+  collectAll ca fa (c:cs)+    | c `Set.member` ca = collectAll ca fa cs+    | otherwise =+      case c `Map.lookup` objectMap of+           Just (CategoryObjectFile _ ds2 fs) -> (ca',fa'',fs') where+             (ca',fa',fs0) = collectAll (c `Set.insert` ca) fa (ds2 ++ cs)+             fa'' = fa' `Set.union` (Set.fromList fs)+             fs' = (filter (not . flip elem fa') fs) ++ fs0+           _ -> collectAll ca fa cs++resolveObjectDeps :: String -> [([String],CxxOutput)] -> [CompileMetadata] -> [ObjectFile]+resolveObjectDeps p os deps = resolvedCategories ++ nonCategories where+  categories = filter (isJust . coCategory . snd) os+  publicNamespaces = getNamespacesForDeps deps+  nonCategories = map OtherObjectFile $ concat $ map fst $ filter (not . isJust . coCategory . snd) os+  resolvedCategories = Map.elems $ Map.fromListWith mergeObjectFiles $ map resolveCategory categories+  categoryMap = Map.fromList $ directCategories ++ depCategories+  directCategories = map (keyByCategory . cxxToId) $ map snd categories+  depCategories = map keyByCategory $ concat $ map categoriesToIds deps+  categoriesToIds dep = map (\c -> CategoryIdentifier (cmPath dep) c (cmNamespace dep)) (cmCategories dep)+  cxxToId (CxxOutput (Just c) _ ns _ _ _) = CategoryIdentifier p (show c) (show ns)+  cxxToId _                               = undefined+  resolveCategory (fs,ca@(CxxOutput _ _ _ ns2 ds _)) =+    (cxxToId ca,CategoryObjectFile (cxxToId ca) (filter (/= cxxToId ca) rs) fs) where+      rs = concat $ map (resolveDep categoryMap (map show ns2 ++ publicNamespaces) . show) ds++resolveCategoryDeps :: [String] -> [CompileMetadata] -> [CategoryIdentifier]+resolveCategoryDeps cs deps = resolvedCategories where+  publicNamespaces = getNamespacesForDeps deps+  resolvedCategories = concat $ map (resolveDep categoryMap publicNamespaces) cs+  categoryMap = Map.fromList depCategories+  depCategories = map (keyByCategory . cofCategory) $ filter isCategoryObjectFile $ concat $ map cmObjectFiles deps++keyByCategory :: CategoryIdentifier -> ((String,String),CategoryIdentifier)+keyByCategory c = ((ciCategory c,ciNamespace c),c)++resolveDep :: Map.Map (String,String) CategoryIdentifier -> [String] -> String -> [CategoryIdentifier]+resolveDep cm (n:ns) d =+  case (d,n) `Map.lookup` cm of+       Just xs -> [xs]+       Nothing -> resolveDep cm ns d+resolveDep _ _ d = [UnresolvedCategory d]
src/Cli/TestRunner.hs view
@@ -32,6 +32,7 @@ import Base.CompileError import Base.Mergeable import Cli.CompileMetadata+import Cli.ProcessMetadata import Compilation.CompileInfo import CompilerCxx.Category import CompilerCxx.Naming@@ -124,7 +125,8 @@               psNamespace = ns1,               psCategory = cs',               psDefine = ds-            }]+            }],+          cnExternal = []         }       xx <- compileCategoryModule cm       tm' <- includeNewTypes tm cs'
src/CompilerCxx/Category.hs view
@@ -70,7 +70,8 @@     cnBase :: CategoryMap c,     cnNamespaces :: [Namespace],     cnPublic :: [AnyCategory c],-    cnPrivate :: [PrivateSource c]+    cnPrivate :: [PrivateSource c],+    cnExternal :: [String]   }  data PrivateSource c =@@ -82,41 +83,59 @@  compileCategoryModule :: (Show c, CompileErrorM m, MergeableM m) =>   CategoryModule c -> m [CxxOutput]-compileCategoryModule (CategoryModule tm ns cs xa) = do+compileCategoryModule (CategoryModule tm ns cs xa ex) = do+  checkSupefluous $ Set.toList $ es `Set.difference` ca   tm' <- includeNewTypes tm cs-  hxx <- collectAllOrErrorM $ map (compileCategoryDeclaration tm') cs+  hxx <- collectAllOrErrorM $ map (compileCategoryDeclaration tm' ns) cs   let interfaces = filter (not . isValueConcrete) cs   cxx <- collectAllOrErrorM $ map compileInterfaceDefinition interfaces-  xa2 <- collectAllOrErrorM $ map compileInternal xa+  xa2 <- collectAllOrErrorM $ map (compileInternal ns) xa   let xx = concat $ map snd xa2-  let dm = Map.fromListWith (++) $ map (\d -> (dcName d,[d])) $ concat $ map fst xa2-  checkDuplicates dm cs+  let dm = mapByName $ concat $ map fst xa2+  checkDefined dm $ filter isValueConcrete cs   return $ hxx ++ cxx ++ xx where-    compileInternal (PrivateSource ns1 cs2 ds) = do+    compileInternal ns0 (PrivateSource ns1 cs2 ds) = do       let cs' = cs++cs2       tm' <- includeNewTypes tm cs'-      hxx <- collectAllOrErrorM $ map (compileCategoryDeclaration tm') cs2+      hxx <- collectAllOrErrorM $ map (compileCategoryDeclaration tm' ns0) cs2       let interfaces = filter (not . isValueConcrete) cs2       cxx1 <- collectAllOrErrorM $ map compileInterfaceDefinition interfaces       cxx2 <- collectAllOrErrorM $ map (compileDefinition tm' (ns1:ns)) ds+      let dm = mapByName ds+      checkDefined dm $ filter isValueConcrete cs2       return (ds,hxx ++ cxx1 ++ cxx2)     compileDefinition tm2 ns2 d = do       tm2' <- mergeInternalInheritance tm2 d       compileConcreteDefinition tm2' ns2 d-    checkDuplicates dm = mergeAllM . map (check dm)-    check dm t =-      case getCategoryName t `Map.lookup` dm of-           Nothing -> return ()-           Just [_] -> return ()-           Just ds ->+    mapByName = Map.fromListWith (++) . map (\d -> (dcName d,[d]))+    ca = Set.fromList $ map (show . getCategoryName) $ filter isValueConcrete cs+    es = Set.fromList ex+    checkDefined dm = mergeAllM . map (checkSingle dm)+    checkSingle dm t =+      case ((show $ getCategoryName t) `Set.member` es, getCategoryName t `Map.lookup` dm) of+           (False,Just [_]) -> return ()+           (True,Nothing)   -> return ()+           (True,Just [d]) ->+             compileError ("Public category " ++ show (getCategoryName t) +++                           formatFullContextBrace (getCategoryContext t) +++                           " was declared external but is also defined at " ++ formatFullContext (dcContext d))+           (False,Nothing) ->+             compileError ("Public category " ++ show (getCategoryName t) +++                           formatFullContextBrace (getCategoryContext t) +++                           " has not been defined or declared external")+           (_,Just ds) ->              flip reviseError ("Public category " ++ show (getCategoryName t) ++                                formatFullContextBrace (getCategoryContext t) ++                                " is defined " ++ show (length ds) ++ " times") $                mergeAllM $ map (\d -> compileError $ "Defined at " ++ formatFullContext (dcContext d)) ds+    checkSupefluous es2+      | null es2 = return ()+      | otherwise = compileError $ "External categories either not concrete or not present: " +++                                   intercalate ", " es2  compileModuleMain :: (Show c, CompileErrorM m, MergeableM m) =>   CategoryModule c -> CategoryName -> FunctionName -> m CxxOutput-compileModuleMain (CategoryModule tm _ cs xa) n f = do+compileModuleMain (CategoryModule tm _ cs xa _) n f = do   xx <- fmap concat $ collectAllOrErrorM $ filter (not . isCompileError) $ map maybeCompileMain xa   reconcile xx where     maybeCompileMain (PrivateSource _ cs2 ds) = do@@ -133,12 +152,12 @@     reconcile _   = compileErrorM $ "Multiple matches for main category " ++ show n  compileCategoryDeclaration :: (Show c, CompileErrorM m, MergeableM m) =>-  CategoryMap c -> AnyCategory c -> m CxxOutput-compileCategoryDeclaration _ t =+  CategoryMap c -> [Namespace] -> AnyCategory c -> m CxxOutput+compileCategoryDeclaration _ ns t =   return $ CxxOutput (Just $ getCategoryName t)                      (headerFilename name)                      (getCategoryNamespace t)-                     [getCategoryNamespace t]+                     (ns ++ [getCategoryNamespace t])                      (filter (not . isBuiltinCategory) $ Set.toList $ cdRequired file)                      (cdOutput file) where     file = mergeAll $ [
src/Config/LoadConfig.hs view
@@ -22,16 +22,21 @@   Backend(..),   LocalConfig(..),   Resolver(..),+  compilerVersion,   localConfigPath,   loadConfig,+  rootPath, ) where  import Config.Paths import Config.Programs  import Control.Monad (when)-import GHC.IO.Handle+import Data.Hashable (hash) import Data.List (intercalate,isSuffixOf)+import Data.Version (showVersion)+import GHC.IO.Handle+import Numeric (showHex) import System.Directory import System.Exit import System.FilePath@@ -39,7 +44,7 @@ import System.Posix.Process (ProcessStatus(..),executeFile,forkProcess,getProcessStatus) import System.Posix.Temp (mkstemps) -import Paths_zeolite_lang (getDataFileName)+import Paths_zeolite_lang (getDataFileName,version)   loadConfig :: IO (Backend,Resolver)@@ -58,6 +63,12 @@       hPutStrLn stderr "Zeolite configuration is corrupt. Please rerun zeolite-setup."       exitFailure +rootPath :: IO FilePath+rootPath = getDataFileName ""++compilerVersion :: String+compilerVersion = showVersion version+ data Backend =   UnixBackend {     ucCxxBinary :: String,@@ -76,7 +87,7 @@   deriving (Read,Show)  localConfigFilename :: String-localConfigFilename = "local-config.txt"+localConfigFilename = ".local-config"  localConfigPath :: IO FilePath localConfigPath = getDataFileName localConfigFilename >>= canonicalizePath@@ -121,6 +132,7 @@         hDuplicateTo h1 stdout         hDuplicateTo h2 stderr         executeFile b True [] Nothing+  getCompilerHash b = flip showHex "" $ abs $ hash $ compilerVersion ++ show b  executeProcess :: String -> [String] -> IO () executeProcess c os = do
src/Config/Programs.hs view
@@ -29,6 +29,7 @@ class CompilerBackend b where   runCxxCommand :: b -> CxxCommand -> IO String   runTestCommand :: b -> TestCommand -> IO TestCommandResult+  getCompilerHash :: b -> String  data CxxCommand =   CompileToObject {
+ src/Test/ParseMetadata.hs view
@@ -0,0 +1,282 @@+{- -----------------------------------------------------------------------------+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]++module Test.ParseMetadata (tests) where++import Control.Monad (when)+import Text.Regex.TDFA -- Not safe!++import Base.CompileError+import Compilation.CompileInfo+import Cli.CompileMetadata+import Cli.CompileOptions+import Cli.ParseMetadata++tests :: [IO (CompileInfo ())]+tests = [+    checkWriteThenRead $ CompileMetadata {+      cmVersionHash = "0123456789ABCDEFabcdef",+      cmPath = "/home/project/special",+      cmNamespace = "public_ABCDEF",+      cmPublicDeps = [+        "/home/project/public-dep1",+        "/home/project/public-dep2"+      ],+      cmPrivateDeps = [+        "/home/project/private-dep1",+        "/home/project/private-dep2"+      ],+      cmExtraRequires = [+        CategoryIdentifier {+          ciPath = "/home/project/private-dep1",+          ciCategory = "PrivateCategory",+          ciNamespace = "private_123456"+        },+        UnresolvedCategory {+          ucCategory = "UnresolvedCategory"+        }+      ],+      cmCategories = [+        "MyCategory",+        "MyOtherCategory"+      ],+      cmSubdirs = [+        "/home/project/special/subdir1",+        "/home/project/special/subdir2"+      ],+      cmPublicFiles = [+        "/home/project/special/category1.0rp",+        "/home/project/special/category2.0rp"+      ],+      cmPrivateFiles = [+        "/home/project/special/category1.0rx",+        "/home/project/special/category2.0rx"+      ],+      cmTestFiles = [+        "/home/project/special/category1.0rt",+        "/home/project/special/category2.0rt"+      ],+      cmHxxFiles = [+        "/home/project/special/category1.hpp",+        "/home/project/special/category2.hpp"+      ],+      cmCxxFiles = [+        "/home/project/special/category1.cpp",+        "/home/project/special/category2.cpp"+      ],+      cmObjectFiles = [+        CategoryObjectFile {+          cofCategory = CategoryIdentifier {+            ciPath = "/home/project/special",+            ciCategory = "SpecialCategory",+            ciNamespace = "public_ABCDEF"+          },+          cofRequires = [+            CategoryIdentifier {+              ciPath = "/home/project/private-dep1",+              ciCategory = "PrivateCategory",+              ciNamespace = "private_123456"+            },+            UnresolvedCategory {+              ucCategory = "UnresolvedCategory"+            }+          ],+          cofFiles = [+            "/home/project/special/object1.o",+            "/home/project/special/object1.o"+          ]+        }+      ]+    },++    checkWriteFail "bad hash" $ CompileMetadata {+      cmVersionHash = "bad hash",+      cmPath = "/home/project/special",+      cmNamespace = "public_ABCDEF",+      cmPublicDeps = [],+      cmPrivateDeps = [],+      cmExtraRequires = [],+      cmCategories = [],+      cmSubdirs = [],+      cmPublicFiles = [],+      cmPrivateFiles = [],+      cmTestFiles = [],+      cmHxxFiles = [],+      cmCxxFiles = [],+      cmObjectFiles = []+    },++    checkWriteFail "bad namespace" $ CompileMetadata {+      cmVersionHash = "0123456789ABCDEFabcdef",+      cmPath = "/home/project/special",+      cmNamespace = "bad namespace",+      cmPublicDeps = [],+      cmPrivateDeps = [],+      cmExtraRequires = [],+      cmCategories = [],+      cmSubdirs = [],+      cmPublicFiles = [],+      cmPrivateFiles = [],+      cmTestFiles = [],+      cmHxxFiles = [],+      cmCxxFiles = [],+      cmObjectFiles = []+    },++    checkWriteFail "bad category" $ CompileMetadata {+      cmVersionHash = "0123456789ABCDEFabcdef",+      cmPath = "/home/project/special",+      cmNamespace = "public_ABCDEF",+      cmPublicDeps = [],+      cmPrivateDeps = [],+      cmExtraRequires = [],+      cmCategories = [+        "bad category"+      ],+      cmSubdirs = [],+      cmPublicFiles = [],+      cmPrivateFiles = [],+      cmTestFiles = [],+      cmHxxFiles = [],+      cmCxxFiles = [],+      cmObjectFiles = []+    },++    checkWriteThenRead $ ModuleConfig {+      rmRoot = "/home/projects",+      rmPath = "special",+      rmPublicDeps = [+        "/home/project/public-dep1",+        "/home/project/public-dep2"+      ],+      rmPrivateDeps = [+        "/home/project/private-dep1",+        "/home/project/private-dep2"+      ],+      rmExtraFiles = [+        "extra1.cpp",+        "extra2.cpp"+      ],+      rmExtraPaths = [+        "extra1",+        "extra2"+      ],+      rmExtraRequires = [+        "Extra1",+        "Extra2"+      ],+      rmExternalDefs = [+        "External1",+        "External1"+      ],+      rmMode = CompileIncremental,+      rmOutputName = "binary"+    },++    checkWriteFail "bad category" $ ModuleConfig {+      rmRoot = "/home/projects",+      rmPath = "special",+      rmPublicDeps = [],+      rmPrivateDeps = [],+      rmExtraFiles = [],+      rmExtraPaths = [],+      rmExtraRequires = [+        "bad category"+      ],+      rmExternalDefs = [],+      rmMode = CompileIncremental,+      rmOutputName = ""+    },++    checkWriteFail "bad category" $ ModuleConfig {+      rmRoot = "/home/projects",+      rmPath = "special",+      rmPublicDeps = [],+      rmPrivateDeps = [],+      rmExtraFiles = [],+      rmExtraPaths = [],+      rmExtraRequires = [],+      rmExternalDefs = [+        "bad category"+      ],+      rmMode = CompileIncremental,+      rmOutputName = ""+    },++    checkWriteFail "bad category" $ CategoryIdentifier {+      ciPath = "/home/project/special",+      ciCategory = "bad category",+      ciNamespace = "public_ABCDEF"+    },++    checkWriteFail "bad namespace" $ CategoryIdentifier {+      ciPath = "/home/project/special",+      ciCategory = "bad namespace",+      ciNamespace = "SpecialCategory"+    },++    checkWriteFail "bad category" $ UnresolvedCategory {+      ucCategory = "bad category"+    },++    checkWriteThenRead $ CompileBinary {+      cbCategory = "SpecialCategory",+      cbFunction = "specialFunction"+    },++    checkWriteFail "bad category" $ CompileBinary {+      cbCategory = "bad category",+      cbFunction = "specialFunction"+    },++    checkWriteFail "bad function" $ CompileBinary {+      cbCategory = "SpecialCategory",+      cbFunction = "bad function"+    },++    checkWriteThenRead $ CompileIncremental,++    checkWriteFail "compile mode" $ ExecuteTests { etInclude = [] },+    checkWriteFail "compile mode" $ CompileRecompile,+    checkWriteFail "compile mode" $ CreateTemplates,+    checkWriteFail "compile mode" $ CompileUnspecified+  ]++checkWriteThenRead :: (Eq a, Show a, ConfigFormat a) => a -> IO (CompileInfo ())+checkWriteThenRead m = return $ do+  text <- fmap spamComments $ autoWriteConfig m+  m' <- autoReadConfig "(string)" text+  when (m' /= m) $+    compileError $ "Failed to match after write/read\n" +++                   "Before:\n" ++ show m ++ "\n" +++                   "After:\n" ++ show m' ++ "\n" +++                   "Intermediate:\n" ++ text where+   spamComments = unlines . map (++ " // spam") . lines++checkWriteFail :: ConfigFormat a => String -> a -> IO (CompileInfo ())+checkWriteFail p m = return $ do+  let m' = autoWriteConfig m+  check m'+  where+    check c+      | isCompileError c = do+          let text = show (getCompileError c)+          when (not $ text =~ p) $+            compileError $ "Expected pattern " ++ show p ++ " in error output but got\n" ++ text+      | otherwise =+          compileError $ "Expected write failure but got\n" ++ getCompileSuccess c
tests/.zeolite-module view
@@ -1,1 +1,7 @@-RecompileMetadata {rmRoot = "..", rmPath = "tests", rmPublicDeps = ["visibility","visibility2"], rmPrivateDeps = [], rmExtraFiles = [], rmExtraPaths = [], rmExtraRequires = [], rmMode = CompileIncremental, rmOutputName = ""}+root: ".."+path: "tests"+public_deps: [+  "visibility"+  "visibility2"+]+mode: incremental
+ tests/check-defs/.zeolite-module view
@@ -0,0 +1,6 @@+root: "../.."+path: "tests/check-defs"+external: [+  External+]+mode: incremental
+ tests/check-defs/README.md view
@@ -0,0 +1,22 @@+# Multiple Definition Failure++Compiling this module should **always fail**. It tests a compiler check that+ensures that `concrete` categories have exactly one definition or are declared+in the `external:` section of `.zeolite-module`.++To compile:++```shell+ZEOLITE_PATH=$(zeolite --get-path)+zeolite -p $ZEOLITE_PATH -r tests/check-defs+```++The compiler errors should look something like this:++```text+Compiler errors:+Public category Type ["tests/check-defs/public.0rp" (line 19, column 1)] is defined 2 times+  Defined at "tests/check-defs/private2.0rx" (line 19, column 1)+  Defined at "tests/check-defs/private1.0rx" (line 19, column 1)+Public category Undefined ["tests/check-defs/public.0rp" (line 21, column 1)] has not been defined or declared external+```
+ tests/check-defs/private1.0rx view
@@ -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]++define Type {}
+ tests/check-defs/private2.0rx view
@@ -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]++define Type {}
+ tests/check-defs/public.0rp view
@@ -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]++concrete Type {}++concrete Undefined {}++concrete External {}
− tests/multiple-defs/.zeolite-module
@@ -1,1 +0,0 @@-RecompileMetadata {rmRoot = "../..", rmPath = "tests/multiple-defs", rmPublicDeps = [], rmPrivateDeps = [], rmExtraFiles = [], rmExtraPaths = [], rmExtraRequires = [], rmMode = CompileIncremental, rmOutputName = ""}
− tests/multiple-defs/README.md
@@ -1,20 +0,0 @@-# Multiple Definition Failure--Compiling this module should **always fail**. It tests a compiler check that-ensures that multiple `.0rx` files do not define the same `concrete` category-from a `.0rp` file.--To compile:--```shell-ZEOLITE_PATH=$(zeolite --get-path)-zeolite -p $ZEOLITE_PATH -r tests/multiple-defs-```--The compiler error should look something like this:--```text-Public category Type ["tests/multiple-defs/public.0rp" (line 19, column 1)] is defined 2 times-  Defined at "tests/multiple-defs/private2.0rx" (line 19, column 1)-  Defined at "tests/multiple-defs/private1.0rx" (line 19, column 1)-```
− tests/multiple-defs/private1.0rx
@@ -1,19 +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]--define Type {}
− tests/multiple-defs/private2.0rx
@@ -1,19 +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]--define Type {}
− tests/multiple-defs/public.0rp
@@ -1,19 +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]--concrete Type {}
tests/visibility/.zeolite-module view
@@ -1,1 +1,6 @@-RecompileMetadata {rmRoot = "..", rmPath = "visibility", rmPublicDeps = [], rmPrivateDeps = ["internal"], rmExtraFiles = [], rmExtraPaths = [], rmExtraRequires = [], rmMode = CompileIncremental, rmOutputName = ""}+root: ".."+path: "visibility"+private_deps: [+  "internal"+]+mode: incremental
tests/visibility/internal/.zeolite-module view
@@ -1,1 +1,3 @@-RecompileMetadata {rmRoot = "../..", rmPath = "visibility/internal", rmPublicDeps = [], rmPrivateDeps = [], rmExtraFiles = [], rmExtraPaths = [], rmExtraRequires = [], rmMode = CompileIncremental, rmOutputName = ""}+root: "../.."+path: "visibility/internal"+mode: incremental
tests/visibility2/.zeolite-module view
@@ -1,1 +1,6 @@-RecompileMetadata {rmRoot = "..", rmPath = "visibility2", rmPublicDeps = [], rmPrivateDeps = ["internal"], rmExtraFiles = [], rmExtraPaths = [], rmExtraRequires = [], rmMode = CompileIncremental, rmOutputName = ""}+root: ".."+path: "visibility2"+private_deps: [+  "internal"+]+mode: incremental
tests/visibility2/internal/.zeolite-module view
@@ -1,1 +1,3 @@-RecompileMetadata {rmRoot = "../..", rmPath = "visibility2/internal", rmPublicDeps = [], rmPrivateDeps = [], rmExtraFiles = [], rmExtraPaths = [], rmExtraRequires = [], rmMode = CompileIncremental, rmOutputName = ""}+root: "../.."+path: "visibility2/internal"+mode: incremental
zeolite-lang.cabal view
@@ -1,7 +1,7 @@ cabal-version:       2.2  name:                zeolite-lang-version:             0.1.3.1+version:             0.2.0.0 synopsis:            Zeolite is a statically-typed, general-purpose programming language.  description:@@ -67,9 +67,6 @@                      base/*.0rp,                      base/*.cpp,                      base/*.hpp,-                     base/.zeolite-module,-                     base/*.0rp,-                     base/*.cpp,                      capture-thread/include/*.h,                      capture-thread/src/*.cc,                      example/hello/README.md,@@ -93,10 +90,10 @@                      lib/util/*.cpp,                      tests/.zeolite-module,                      tests/*.0rt,-                     tests/multiple-defs/README.md,-                     tests/multiple-defs/.zeolite-module,-                     tests/multiple-defs/*.0rp,-                     tests/multiple-defs/*.0rx,+                     tests/check-defs/README.md,+                     tests/check-defs/.zeolite-module,+                     tests/check-defs/*.0rp,+                     tests/check-defs/*.0rx,                      tests/visibility/.zeolite-module,                      tests/visibility/*.0rp,                      tests/visibility/*.0rx,@@ -127,6 +124,8 @@                        Cli.CompileOptions,                        Cli.Compiler,                        Cli.ParseCompileOptions,+                       Cli.ParseMetadata,+                       Cli.ProcessMetadata,                        Cli.TestRunner,                        Compilation.CompileInfo,                        Compilation.CompilerState,@@ -150,6 +149,7 @@                        Test.Common,                        Test.DefinedCategory,                        Test.IntegrationTest,+                       Test.ParseMetadata,                        Test.Parser,                        Test.Procedure,                        Test.TypeCategory,