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 +10/−0
- base/.zeolite-module +48/−1
- bin/unit-tests.hs +2/−2
- bin/zeolite-setup.hs +4/−0
- bin/zeolite.hs +1/−0
- example/regex/regex-test.0rp +0/−3
- lib/file/.zeolite-module +14/−1
- lib/util/.zeolite-module +13/−1
- src/Cli/CompileMetadata.hs +12/−324
- src/Cli/CompileOptions.hs +3/−7
- src/Cli/Compiler.hs +27/−28
- src/Cli/ParseCompileOptions.hs +55/−47
- src/Cli/ParseMetadata.hs +320/−0
- src/Cli/ProcessMetadata.hs +364/−0
- src/Cli/TestRunner.hs +3/−1
- src/CompilerCxx/Category.hs +37/−18
- src/Config/LoadConfig.hs +15/−3
- src/Config/Programs.hs +1/−0
- src/Test/ParseMetadata.hs +282/−0
- tests/.zeolite-module +7/−1
- tests/check-defs/.zeolite-module +6/−0
- tests/check-defs/README.md +22/−0
- tests/check-defs/private1.0rx +19/−0
- tests/check-defs/private2.0rx +19/−0
- tests/check-defs/public.0rp +23/−0
- tests/multiple-defs/.zeolite-module +0/−1
- tests/multiple-defs/README.md +0/−20
- tests/multiple-defs/private1.0rx +0/−19
- tests/multiple-defs/private2.0rx +0/−19
- tests/multiple-defs/public.0rp +0/−19
- tests/visibility/.zeolite-module +6/−1
- tests/visibility/internal/.zeolite-module +3/−1
- tests/visibility2/.zeolite-module +6/−1
- tests/visibility2/internal/.zeolite-module +3/−1
- zeolite-lang.cabal +8/−8
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,