diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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. diff --git a/base/.zeolite-module b/base/.zeolite-module --- a/base/.zeolite-module +++ b/base/.zeolite-module @@ -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 diff --git a/bin/unit-tests.hs b/bin/unit-tests.hs --- a/bin/unit-tests.hs +++ b/bin/unit-tests.hs @@ -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, diff --git a/bin/zeolite-setup.hs b/bin/zeolite-setup.hs --- a/bin/zeolite-setup.hs +++ b/bin/zeolite-setup.hs @@ -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 diff --git a/bin/zeolite.hs b/bin/zeolite.hs --- a/bin/zeolite.hs +++ b/bin/zeolite.hs @@ -31,6 +31,7 @@ main :: IO () main = do args <- getArgs + tryFastModes args let options = parseCompileOptions args >>= validateCompileOptions compile options where compile co diff --git a/example/regex/regex-test.0rp b/example/regex/regex-test.0rp deleted file mode 100644 --- a/example/regex/regex-test.0rp +++ /dev/null @@ -1,3 +0,0 @@ -concrete RegexTest { - @type runTests () -> () -} diff --git a/lib/file/.zeolite-module b/lib/file/.zeolite-module --- a/lib/file/.zeolite-module +++ b/lib/file/.zeolite-module @@ -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 diff --git a/lib/util/.zeolite-module b/lib/util/.zeolite-module --- a/lib/util/.zeolite-module +++ b/lib/util/.zeolite-module @@ -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 diff --git a/src/Cli/CompileMetadata.hs b/src/Cli/CompileMetadata.hs --- a/src/Cli/CompileMetadata.hs +++ b/src/Cli/CompileMetadata.hs @@ -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) diff --git a/src/Cli/CompileOptions.hs b/src/Cli/CompileOptions.hs --- a/src/Cli/CompileOptions.hs +++ b/src/Cli/CompileOptions.hs @@ -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 diff --git a/src/Cli/Compiler.hs b/src/Cli/Compiler.hs --- a/src/Cli/Compiler.hs +++ b/src/Cli/Compiler.hs @@ -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 diff --git a/src/Cli/ParseCompileOptions.hs b/src/Cli/ParseCompileOptions.hs --- a/src/Cli/ParseCompileOptions.hs +++ b/src/Cli/ParseCompileOptions.hs @@ -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)." diff --git a/src/Cli/ParseMetadata.hs b/src/Cli/ParseMetadata.hs new file mode 100644 --- /dev/null +++ b/src/Cli/ParseMetadata.hs @@ -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" diff --git a/src/Cli/ProcessMetadata.hs b/src/Cli/ProcessMetadata.hs new file mode 100644 --- /dev/null +++ b/src/Cli/ProcessMetadata.hs @@ -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] diff --git a/src/Cli/TestRunner.hs b/src/Cli/TestRunner.hs --- a/src/Cli/TestRunner.hs +++ b/src/Cli/TestRunner.hs @@ -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' diff --git a/src/CompilerCxx/Category.hs b/src/CompilerCxx/Category.hs --- a/src/CompilerCxx/Category.hs +++ b/src/CompilerCxx/Category.hs @@ -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 $ [ diff --git a/src/Config/LoadConfig.hs b/src/Config/LoadConfig.hs --- a/src/Config/LoadConfig.hs +++ b/src/Config/LoadConfig.hs @@ -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 diff --git a/src/Config/Programs.hs b/src/Config/Programs.hs --- a/src/Config/Programs.hs +++ b/src/Config/Programs.hs @@ -29,6 +29,7 @@ class CompilerBackend b where runCxxCommand :: b -> CxxCommand -> IO String runTestCommand :: b -> TestCommand -> IO TestCommandResult + getCompilerHash :: b -> String data CxxCommand = CompileToObject { diff --git a/src/Test/ParseMetadata.hs b/src/Test/ParseMetadata.hs new file mode 100644 --- /dev/null +++ b/src/Test/ParseMetadata.hs @@ -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 diff --git a/tests/.zeolite-module b/tests/.zeolite-module --- a/tests/.zeolite-module +++ b/tests/.zeolite-module @@ -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 diff --git a/tests/check-defs/.zeolite-module b/tests/check-defs/.zeolite-module new file mode 100644 --- /dev/null +++ b/tests/check-defs/.zeolite-module @@ -0,0 +1,6 @@ +root: "../.." +path: "tests/check-defs" +external: [ + External +] +mode: incremental diff --git a/tests/check-defs/README.md b/tests/check-defs/README.md new file mode 100644 --- /dev/null +++ b/tests/check-defs/README.md @@ -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 +``` diff --git a/tests/check-defs/private1.0rx b/tests/check-defs/private1.0rx new file mode 100644 --- /dev/null +++ b/tests/check-defs/private1.0rx @@ -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 {} diff --git a/tests/check-defs/private2.0rx b/tests/check-defs/private2.0rx new file mode 100644 --- /dev/null +++ b/tests/check-defs/private2.0rx @@ -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 {} diff --git a/tests/check-defs/public.0rp b/tests/check-defs/public.0rp new file mode 100644 --- /dev/null +++ b/tests/check-defs/public.0rp @@ -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 {} diff --git a/tests/multiple-defs/.zeolite-module b/tests/multiple-defs/.zeolite-module deleted file mode 100644 --- a/tests/multiple-defs/.zeolite-module +++ /dev/null @@ -1,1 +0,0 @@ -RecompileMetadata {rmRoot = "../..", rmPath = "tests/multiple-defs", rmPublicDeps = [], rmPrivateDeps = [], rmExtraFiles = [], rmExtraPaths = [], rmExtraRequires = [], rmMode = CompileIncremental, rmOutputName = ""} diff --git a/tests/multiple-defs/README.md b/tests/multiple-defs/README.md deleted file mode 100644 --- a/tests/multiple-defs/README.md +++ /dev/null @@ -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) -``` diff --git a/tests/multiple-defs/private1.0rx b/tests/multiple-defs/private1.0rx deleted file mode 100644 --- a/tests/multiple-defs/private1.0rx +++ /dev/null @@ -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 {} diff --git a/tests/multiple-defs/private2.0rx b/tests/multiple-defs/private2.0rx deleted file mode 100644 --- a/tests/multiple-defs/private2.0rx +++ /dev/null @@ -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 {} diff --git a/tests/multiple-defs/public.0rp b/tests/multiple-defs/public.0rp deleted file mode 100644 --- a/tests/multiple-defs/public.0rp +++ /dev/null @@ -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 {} diff --git a/tests/visibility/.zeolite-module b/tests/visibility/.zeolite-module --- a/tests/visibility/.zeolite-module +++ b/tests/visibility/.zeolite-module @@ -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 diff --git a/tests/visibility/internal/.zeolite-module b/tests/visibility/internal/.zeolite-module --- a/tests/visibility/internal/.zeolite-module +++ b/tests/visibility/internal/.zeolite-module @@ -1,1 +1,3 @@ -RecompileMetadata {rmRoot = "../..", rmPath = "visibility/internal", rmPublicDeps = [], rmPrivateDeps = [], rmExtraFiles = [], rmExtraPaths = [], rmExtraRequires = [], rmMode = CompileIncremental, rmOutputName = ""} +root: "../.." +path: "visibility/internal" +mode: incremental diff --git a/tests/visibility2/.zeolite-module b/tests/visibility2/.zeolite-module --- a/tests/visibility2/.zeolite-module +++ b/tests/visibility2/.zeolite-module @@ -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 diff --git a/tests/visibility2/internal/.zeolite-module b/tests/visibility2/internal/.zeolite-module --- a/tests/visibility2/internal/.zeolite-module +++ b/tests/visibility2/internal/.zeolite-module @@ -1,1 +1,3 @@ -RecompileMetadata {rmRoot = "../..", rmPath = "visibility2/internal", rmPublicDeps = [], rmPrivateDeps = [], rmExtraFiles = [], rmExtraPaths = [], rmExtraRequires = [], rmMode = CompileIncremental, rmOutputName = ""} +root: "../.." +path: "visibility2/internal" +mode: incremental diff --git a/zeolite-lang.cabal b/zeolite-lang.cabal --- a/zeolite-lang.cabal +++ b/zeolite-lang.cabal @@ -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,