diff --git a/bench/action/bubble/module.ens b/bench/action/bubble/module.ens index 05f13b090..cc395cd04 100644 --- a/bench/action/bubble/module.ens +++ b/bench/action/bubble/module.ens @@ -1,13 +1,17 @@ { target { - bubble-nt "bubble-nt.nt", - bubble-slow "bubble-slow.nt", + bubble-nt { + main "bubble-nt.nt", + }, + bubble-slow { + main "bubble-slow.nt", + }, }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, diff --git a/bench/action/dictionary/module.ens b/bench/action/dictionary/module.ens index c77404863..a083a0a18 100644 --- a/bench/action/dictionary/module.ens +++ b/bench/action/dictionary/module.ens @@ -1,15 +1,17 @@ { target { - dictionary-nt "dictionary-nt.nt", + dictionary-nt { + main "dictionary-nt.nt", + }, }, prefix { Dict "core.dict", }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, diff --git a/bench/action/intmap/module.ens b/bench/action/intmap/module.ens index e21db51c0..010fddd68 100644 --- a/bench/action/intmap/module.ens +++ b/bench/action/intmap/module.ens @@ -1,15 +1,17 @@ { target { - intmap-nt "intmap-nt.nt", + intmap-nt { + main "intmap-nt.nt", + }, }, prefix { IntMap "core.intmap", }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, diff --git a/src/Act/Archive.hs b/src/Act/Archive.hs index 3595eb2b8..e24ce9b1c 100644 --- a/src/Act/Archive.hs +++ b/src/Act/Archive.hs @@ -13,7 +13,7 @@ import Scene.PackageVersion.Reflect qualified as PV archive :: Config -> App () archive cfg = do - Initialize.initializeCompiler (remarkCfg cfg) Nothing + Initialize.initializeCompiler (remarkCfg cfg) Path.ensureNotInLibDir packageVersion <- PV.reflect (getArchiveName cfg) archiveEns <- Module.getMainModule >>= makeArchiveEns packageVersion diff --git a/src/Act/Build.hs b/src/Act/Build.hs index 0f7625343..3dc9092ae 100644 --- a/src/Act/Build.hs +++ b/src/Act/Build.hs @@ -18,15 +18,15 @@ import Prelude hiding (log) build :: Config -> App () build cfg = do setup cfg - targetList <- Collect.collectTargetList $ mTarget cfg + target <- Collect.getConcreteTarget $ targetName cfg mainModule <- getMainModule - forM_ (map Concrete targetList) $ Build.buildTarget (fromConfig cfg) mainModule + Build.buildTarget (fromConfig cfg) mainModule (Concrete target) setup :: Config -> App () setup cfg = do LLVM.ensureSetupSanity cfg Path.ensureNotInLibDir - Initialize.initializeCompiler (remarkCfg cfg) (mClangOptString cfg) + Initialize.initializeCompiler (remarkCfg cfg) Env.setBuildMode $ buildMode cfg Module.getMainModule >>= Fetch.fetch diff --git a/src/Act/Check.hs b/src/Act/Check.hs index 1f82f2ce0..964065a41 100644 --- a/src/Act/Check.hs +++ b/src/Act/Check.hs @@ -9,7 +9,7 @@ import Scene.Initialize qualified as Initialize check :: Config -> App () check cfg = do - Initialize.initializeCompiler (remarkCfg cfg) Nothing + Initialize.initializeCompiler (remarkCfg cfg) logs <- Check.check if shouldInsertPadding cfg then Remark.printErrorList logs diff --git a/src/Act/Clean.hs b/src/Act/Clean.hs index da12c122d..5348b9c18 100644 --- a/src/Act/Clean.hs +++ b/src/Act/Clean.hs @@ -8,5 +8,5 @@ import Prelude hiding (log) clean :: Config -> App () clean cfg = do - Initialize.initializeCompiler (remarkCfg cfg) Nothing + Initialize.initializeCompiler (remarkCfg cfg) Clean.clean diff --git a/src/Act/Create.hs b/src/Act/Create.hs index 354ff7f65..f104baa56 100644 --- a/src/Act/Create.hs +++ b/src/Act/Create.hs @@ -10,6 +10,6 @@ create :: Config -> App () create cfg = do newModule <- New.constructDefaultModule (moduleName cfg) Initialize.initializeLogger (remarkCfg cfg) - Initialize.initializeCompilerWithModule newModule Nothing + Initialize.initializeCompilerWithModule newModule New.createNewProject (moduleName cfg) newModule Fetch.insertCoreDependency diff --git a/src/Act/Format.hs b/src/Act/Format.hs index 7247ed819..374ff2238 100644 --- a/src/Act/Format.hs +++ b/src/Act/Format.hs @@ -11,7 +11,7 @@ import Scene.Write qualified as Write format :: Config -> App () format cfg = do - Initialize.initializeCompiler (remarkCfg cfg) Nothing + Initialize.initializeCompiler (remarkCfg cfg) Initialize.initializeForTarget path <- resolveFile' $ filePathString cfg content <- readTextFile path diff --git a/src/Act/Get.hs b/src/Act/Get.hs index e3b61b58a..aaafe9fc4 100644 --- a/src/Act/Get.hs +++ b/src/Act/Get.hs @@ -9,6 +9,6 @@ import Prelude hiding (log) get :: Config -> App () get cfg = do - Initialize.initializeCompiler (remarkCfg cfg) Nothing + Initialize.initializeCompiler (remarkCfg cfg) Path.ensureNotInLibDir Fetch.insertDependency (moduleAliasText cfg) (moduleURL cfg) diff --git a/src/Act/Zen.hs b/src/Act/Zen.hs index b0ba3bec4..d48062431 100644 --- a/src/Act/Zen.hs +++ b/src/Act/Zen.hs @@ -9,7 +9,7 @@ import Control.Monad import Data.Maybe import Entity.Config.Zen import Entity.OutputKind -import Entity.Target +import Entity.Target hiding (compileOption, linkOption) import Path.IO (resolveFile') import Scene.Build (Axis (..), buildTarget) import Scene.Fetch qualified as Fetch @@ -21,7 +21,8 @@ zen cfg = do setup cfg path <- resolveFile' (filePathString cfg) mainModule <- getMainModule - buildTarget (fromConfig cfg) mainModule $ Concrete (Zen path) + buildTarget (fromConfig cfg) mainModule $ + Concrete (Zen path (compileOption cfg) (linkOption cfg)) fromConfig :: Config -> Axis fromConfig cfg = @@ -36,6 +37,6 @@ fromConfig cfg = setup :: Config -> App () setup cfg = do Path.ensureNotInLibDir - Initialize.initializeCompiler (remarkCfg cfg) (mClangOptString cfg) + Initialize.initializeCompiler (remarkCfg cfg) Env.setBuildMode $ buildMode cfg Module.getMainModule >>= Fetch.fetch diff --git a/src/Context/App.hs b/src/Context/App.hs index 4370b29c4..ef169f292 100644 --- a/src/Context/App.hs +++ b/src/Context/App.hs @@ -3,6 +3,7 @@ module Context.App runApp, runAppInEnv, readRef, + readRefMaybe, writeRef, readRef', writeRef', @@ -35,6 +36,15 @@ readRef name accessor = do Nothing -> error $ T.unpack $ "[compiler bug] `" <> name <> "` is uninitialized" +readRefMaybe :: (Env -> Ref a) -> App (Maybe a) +readRefMaybe accessor = do + mValue <- asks accessor >>= liftIO . readIORef + case mValue of + Just a -> + return (Just a) + Nothing -> + return Nothing + writeRef :: (Env -> Ref a) -> a -> App () writeRef accessor value = do ref <- asks accessor diff --git a/src/Context/App/Internal.hs b/src/Context/App/Internal.hs index 0faf095e1..49ab094af 100644 --- a/src/Context/App/Internal.hs +++ b/src/Context/App/Internal.hs @@ -50,7 +50,6 @@ import Path data Env = Env { counter :: IORefU Int, endOfEntry :: IORef T.Text, - clangOptString :: IORef String, shouldColorize :: IORef Bool, buildMode :: IORef BM.BuildMode, moduleCacheMap :: IORef (Map.HashMap (Path Abs File) M.Module), @@ -97,6 +96,7 @@ data Env = Env activeDefiniteDescriptionList :: IORef (Map.HashMap LL.LocalLocator DD.DefiniteDescription), currentGlobalLocator :: Ref SGL.StrictGlobalLocator, currentSource :: Ref Source.Source, + clangDigest :: Ref T.Text, mainModule :: Ref Module.Module } @@ -110,7 +110,6 @@ newEnv :: IO Env newEnv = do counter <- newIORefU 0 endOfEntry <- newIORef "" - clangOptString <- newIORef "" shouldColorize <- newIORef True buildMode <- newIORef BM.Develop moduleCacheMap <- newIORef Map.empty @@ -157,5 +156,6 @@ newEnv = do activeDefiniteDescriptionList <- newIORef Map.empty currentGlobalLocator <- newRef currentSource <- newRef + clangDigest <- newRef mainModule <- newRef return Env {..} diff --git a/src/Context/Cache.hs b/src/Context/Cache.hs index 630129bcf..536a040cf 100644 --- a/src/Context/Cache.hs +++ b/src/Context/Cache.hs @@ -24,21 +24,21 @@ import Entity.Target import Path import Path.IO -saveCache :: Source.Source -> Cache.Cache -> App () -saveCache source cache = do - cachePath <- Path.getSourceCachePath source +saveCache :: Target -> Source.Source -> Cache.Cache -> App () +saveCache target source cache = do + cachePath <- Path.getSourceCachePath target source ensureDir $ parent cachePath liftIO $ encodeFile (toFilePath cachePath) $ Cache.compress cache -saveCompletionCache :: Source.Source -> Cache.CompletionCache -> App () -saveCompletionCache source cache = do - cachePath <- Path.getSourceCompletionCachePath source +saveCompletionCache :: Target -> Source.Source -> Cache.CompletionCache -> App () +saveCompletionCache target source cache = do + cachePath <- Path.getSourceCompletionCachePath target source ensureDir $ parent cachePath liftIO $ encodeFile (toFilePath cachePath) cache -loadCache :: Source.Source -> App (Maybe Cache.Cache) -loadCache source = do - cachePath <- Path.getSourceCachePath source +loadCache :: Target -> Source.Source -> App (Maybe Cache.Cache) +loadCache target source = do + cachePath <- Path.getSourceCachePath target source hasCache <- doesFileExist cachePath if not hasCache then return Nothing @@ -105,7 +105,7 @@ isEntryPointCompilationSkippable baseModule target outputKindList = do invalidate :: Source.Source -> App () invalidate source = do - cachePath <- Path.getSourceCachePath source + cachePath <- Path.getSourceCachePath (Abstract Foundation) source hasCache <- doesFileExist cachePath if not hasCache then return () diff --git a/src/Context/External.hs b/src/Context/External.hs index 57dcc290e..194f50f9e 100644 --- a/src/Context/External.hs +++ b/src/Context/External.hs @@ -2,22 +2,30 @@ module Context.External ( run, runOrFail, runOrFail', - ensureExecutables, getClang, + getClangDigest, + ensureExecutables, + expandText, + raiseIfProcessFailed, + calculateClangDigest, ExternalError (..), ) where import Context.App +import Context.App.Internal import Context.Throw (liftEither) import Context.Throw qualified as Throw +import Control.Monad (unless) import Control.Monad.IO.Class import Control.Monad.IO.Unlift import Data.ByteString qualified as B import Data.Text qualified as T import Data.Text.Encoding import Entity.Const (envVarClang) +import Entity.Digest import Entity.Error +import GHC.IO.Handle import Path import System.Directory import System.Environment (lookupEnv) @@ -91,6 +99,33 @@ getClang = do Nothing -> do return "clang" +getClangDigest :: App T.Text +getClangDigest = do + digestOrNone <- readRefMaybe clangDigest + case digestOrNone of + Just digest -> do + return digest + Nothing -> do + digest <- calculateClangDigest + writeRef clangDigest digest + return digest + +calculateClangDigest :: App T.Text +calculateClangDigest = do + clang <- liftIO getClang + let printfCmd = proc clang ["-v"] + withRunInIO $ \runInIO -> + withCreateProcess printfCmd {std_err = CreatePipe} $ + \_ _ mStdErr printfProcessHandler -> do + case mStdErr of + Just stdErr -> do + value <- B.hGetContents stdErr + printfExitCode <- waitForProcess printfProcessHandler + runInIO $ raiseIfProcessFailed (T.pack clang) printfExitCode stdErr + return $ decodeUtf8 $ hashAndEncode value + Nothing -> + runInIO $ Throw.raiseError' "couldn't obtain stderr" + ensureExecutables :: App () ensureExecutables = do clang <- liftIO getClang @@ -130,3 +165,48 @@ shellWithCwd cwd str = child_user = Nothing, use_process_jobs = False } + +expandText :: T.Text -> App T.Text +expandText t = do + let printf = "printf" + let printfCmd = proc "sh" ["-c", unwords [T.unpack printf, "%s", "\"" ++ T.unpack t ++ "\""]] + withRunInIO $ \runInIO -> + withCreateProcess printfCmd {std_out = CreatePipe, std_err = CreatePipe} $ + \_ mStdOut mClangErrorHandler printfProcessHandler -> do + case (mStdOut, mClangErrorHandler) of + (Just stdOut, Just stdErr) -> do + value <- B.hGetContents stdOut + printfExitCode <- waitForProcess printfProcessHandler + runInIO $ raiseIfProcessFailed printf printfExitCode stdErr + errorMessage <- liftIO $ decodeUtf8 <$> B.hGetContents stdErr + unless (T.null errorMessage) $ do + runInIO $ + Throw.raiseError' $ + "expanding the text\n" + <> indent t + <> "\nfailed with the following message:\n" + <> indent errorMessage + return $ decodeUtf8 value + (Nothing, _) -> + runInIO $ Throw.raiseError' "couldn't obtain stdout" + (_, Nothing) -> + runInIO $ Throw.raiseError' "couldn't obtain stderr" + +raiseIfProcessFailed :: T.Text -> ExitCode -> Handle -> App () +raiseIfProcessFailed procName exitCode h = + case exitCode of + ExitSuccess -> + return () + ExitFailure i -> do + errStr <- liftIO $ decodeUtf8 <$> B.hGetContents h + Throw.raiseError' $ + "the child process `" + <> procName + <> "` failed with the following message (exitcode = " + <> T.pack (show i) + <> "):\n" + <> indent errStr + +indent :: T.Text -> T.Text +indent t = + T.intercalate "\n" $ map (" " <>) $ T.splitOn "\n" t diff --git a/src/Context/LLVM.hs b/src/Context/LLVM.hs index 48dd74f99..410533ffa 100644 --- a/src/Context/LLVM.hs +++ b/src/Context/LLVM.hs @@ -2,13 +2,10 @@ module Context.LLVM ( emit, link, ensureSetupSanity, - getClangOptString, - setClangOptString, ) where import Context.App -import Context.App.Internal import Context.External qualified as External import Context.Module (getMainModule) import Context.Path qualified as Path @@ -16,10 +13,8 @@ import Context.Throw qualified as Throw import Control.Monad import Control.Monad.IO.Class import Control.Monad.IO.Unlift -import Data.ByteString qualified as B import Data.ByteString.Lazy qualified as L import Data.Text qualified as T -import Data.Text.Encoding import Data.Time.Clock import Entity.Config.Build import Entity.OutputKind qualified as OK @@ -28,7 +23,6 @@ import Entity.Target import GHC.IO.Handle import Path import Path.IO -import System.Exit import System.Process type ClangOption = String @@ -42,45 +36,44 @@ ensureSetupSanity cfg = do when (not willBuildObjects && willLink) $ Throw.raiseError' "`--skip-link` must be set explicitly when `--emit` doesn't contain `object`" -emit :: UTCTime -> Either ConcreteTarget Source -> [OK.OutputKind] -> L.ByteString -> App () -emit timeStamp sourceOrNone outputKindList llvmCode = do +emit :: Target -> [ClangOption] -> UTCTime -> Either ConcreteTarget Source -> [OK.OutputKind] -> L.ByteString -> App () +emit target clangOptions timeStamp sourceOrNone outputKindList llvmCode = do case sourceOrNone of Right source -> do - kindPathList <- zipWithM Path.attachOutputPath outputKindList (repeat source) + kindPathList <- zipWithM (Path.attachOutputPath target) outputKindList (repeat source) forM_ kindPathList $ \(_, outputPath) -> Path.ensureDir $ parent outputPath - emitAll llvmCode kindPathList + emitAll clangOptions llvmCode kindPathList forM_ (map snd kindPathList) $ \path -> do Path.setModificationTime path timeStamp Left t -> do mainModule <- getMainModule kindPathList <- zipWithM (Path.getOutputPathForEntryPoint mainModule) outputKindList (repeat t) forM_ kindPathList $ \(_, path) -> Path.ensureDir $ parent path - emitAll llvmCode kindPathList + emitAll clangOptions llvmCode kindPathList forM_ (map snd kindPathList) $ \path -> do Path.setModificationTime path timeStamp -emitAll :: LLVMCode -> [(OK.OutputKind, Path Abs File)] -> App () -emitAll llvmCode kindPathList = do +emitAll :: [ClangOption] -> LLVMCode -> [(OK.OutputKind, Path Abs File)] -> App () +emitAll clangOptions llvmCode kindPathList = do case kindPathList of [] -> return () (kind, path) : rest -> do - emit' llvmCode kind path - emitAll llvmCode rest + emit' clangOptions llvmCode kind path + emitAll clangOptions llvmCode rest -emit' :: LLVMCode -> OK.OutputKind -> Path Abs File -> App () -emit' llvmCode kind path = do - clangOptString <- getClangOptString +emit' :: [ClangOption] -> LLVMCode -> OK.OutputKind -> Path Abs File -> App () +emit' clangOptString llvmCode kind path = do case kind of OK.LLVM -> do Path.writeByteString path llvmCode OK.Object -> - emitInner (words clangOptString) llvmCode path + emitInner clangOptString llvmCode path emitInner :: [ClangOption] -> L.ByteString -> Path Abs File -> App () emitInner additionalClangOptions llvm outputPath = do clang <- liftIO External.getClang - let clangCmd = proc clang $ clangBaseOpt outputPath ++ additionalClangOptions + let clangCmd = proc clang (clangBaseOpt outputPath ++ additionalClangOptions) withRunInIO $ \runInIO -> withCreateProcess clangCmd {std_in = CreatePipe, std_err = CreatePipe} $ \mStdin _ mClangErrorHandler clangProcessHandler -> do @@ -89,7 +82,7 @@ emitInner additionalClangOptions llvm outputPath = do L.hPut stdin llvm hClose stdin clangExitCode <- waitForProcess clangProcessHandler - runInIO $ raiseIfProcessFailed (T.pack clang) clangExitCode clangErrorHandler + runInIO $ External.raiseIfProcessFailed (T.pack clang) clangExitCode clangErrorHandler (Nothing, _) -> runInIO $ Throw.raiseError' "couldn't obtain stdin" (_, Nothing) -> @@ -107,12 +100,11 @@ clangBaseOpt outputPath = toFilePath outputPath ] -link :: [Path Abs File] -> Path Abs File -> App () -link objectPathList outputPath = do +link :: [String] -> [Path Abs File] -> Path Abs File -> App () +link clangOptions objectPathList outputPath = do clang <- liftIO External.getClang - clangOptString <- getClangOptString ensureDir $ parent outputPath - External.run clang $ clangLinkOpt objectPathList outputPath clangOptString + External.run clang $ clangLinkOpt objectPathList outputPath (unwords clangOptions) clangLinkOpt :: [Path Abs File] -> Path Abs File -> String -> [String] clangLinkOpt objectPathList outputPath additionalOptionStr = do @@ -126,26 +118,3 @@ clangLinkOpt objectPathList outputPath additionalOptionStr = do ] ++ pathList ++ words additionalOptionStr - -raiseIfProcessFailed :: T.Text -> ExitCode -> Handle -> App () -raiseIfProcessFailed procName exitCode h = - case exitCode of - ExitSuccess -> - return () - ExitFailure i -> do - errStr <- liftIO $ decodeUtf8 <$> B.hGetContents h - Throw.raiseError' $ - "the child process `" - <> procName - <> "` failed with the following message (exitcode = " - <> T.pack (show i) - <> "):\n" - <> errStr - -getClangOptString :: App String -getClangOptString = - readRef' clangOptString - -setClangOptString :: String -> App () -setClangOptString = - writeRef' clangOptString diff --git a/src/Context/Locator.hs b/src/Context/Locator.hs index 801025fb1..32588ea3d 100644 --- a/src/Context/Locator.hs +++ b/src/Context/Locator.hs @@ -170,13 +170,13 @@ getMainDefiniteDescriptionByTarget :: Target.ConcreteTarget -> App DD.DefiniteDe getMainDefiniteDescriptionByTarget targetOrZen = do mainModule <- getMainModule case targetOrZen of - Target.Named target -> do + Target.Named target _ -> do case Map.lookup target (Module.moduleTarget mainModule) of Nothing -> Throw.raiseError' $ "no such target is defined: " <> target - Just sourceLocator -> do - relPathToDD (SL.reify sourceLocator) BN.mainName - Target.Zen path -> do + Just targetSummary -> do + relPathToDD (SL.reify $ Target.entryPoint targetSummary) BN.mainName + Target.Zen path _ _ -> do relPath <- Module.getRelPathFromSourceDir mainModule path relPathToDD relPath BN.zenName @@ -192,7 +192,7 @@ checkIfEntryPointIsNecessary target source = do case target of Target.Named {} -> do isMainFile source - Target.Zen path -> do + Target.Zen path _ _ -> do return $ Source.sourceFilePath source == path getReadableDD :: DD.DefiniteDescription -> App T.Text diff --git a/src/Context/OptParse.hs b/src/Context/OptParse.hs index e25344a90..538a2a9fe 100644 --- a/src/Context/OptParse.hs +++ b/src/Context/OptParse.hs @@ -19,7 +19,6 @@ import Entity.Config.Zen qualified as Zen import Entity.FileType qualified as FT import Entity.ModuleURL import Entity.OutputKind qualified as OK -import Entity.Target import Options.Applicative parseCommand :: App Command @@ -50,8 +49,7 @@ cmd name parser desc = parseBuildOpt :: Parser Command parseBuildOpt = do - mTarget <- optional $ argument str $ mconcat [metavar "TARGET", help "The build target"] - mClangOpt <- optional $ strOption $ mconcat [long "clang-option", metavar "OPT", help "Options for clang"] + targetName <- argument str $ mconcat [metavar "TARGET", help "The build target"] installDir <- optional $ strOption $ mconcat [long "install", metavar "DIRECTORY", help "Install the resulting binary to this directory"] buildMode <- option buildModeReader $ mconcat [long "mode", metavar "MODE", help "develop, release", value BM.Develop] remarkCfg <- remarkConfigOpt @@ -62,8 +60,7 @@ parseBuildOpt = do pure $ Build $ Build.Config - { Build.mTarget = Named <$> mTarget, - Build.mClangOptString = mClangOpt, + { Build.targetName = targetName, Build.remarkCfg = remarkCfg, Build.outputKindList = outputKindList, Build.shouldSkipLink = shouldSkipLink, @@ -98,7 +95,22 @@ parseGetOpt = do parseZenOpt :: Parser Command parseZenOpt = do inputFilePath <- argument str (mconcat [metavar "INPUT", help "The path of input file"]) - mClangOptString <- optional $ strOption $ mconcat [long "clang-option", metavar "OPT", help "Options for clang"] + compileOption <- + strOption $ + mconcat + [ long "compile-option", + metavar "OPT", + help "Options used by clang when compiling source files", + value "" + ] + linkOption <- + strOption $ + mconcat + [ long "link-option", + metavar "OPT", + help "Options used by clang when linking object files", + value "" + ] remarkCfg <- remarkConfigOpt buildMode <- option buildModeReader $ mconcat [long "mode", metavar "MODE", help "develop, release", value BM.Develop] rest <- (many . strArgument) (metavar "args") @@ -106,7 +118,8 @@ parseZenOpt = do Entity.Command.Zen $ Zen.Config { Zen.filePathString = inputFilePath, - Zen.mClangOptString = mClangOptString, + Zen.compileOption = compileOption, + Zen.linkOption = linkOption, Zen.remarkCfg = remarkCfg, Zen.buildMode = buildMode, Zen.args = rest diff --git a/src/Context/Path.hs b/src/Context/Path.hs index c3b16f6b1..1ba079fd4 100644 --- a/src/Context/Path.hs +++ b/src/Context/Path.hs @@ -39,6 +39,7 @@ import Context.Antecedent qualified as Antecedent import Context.App import Context.App.Internal import Context.Env qualified as Env +import Context.External (getClangDigest) import Context.Throw qualified as Throw import Control.Comonad.Cofree import Control.Monad @@ -168,11 +169,11 @@ getPlatformPrefix = do getExecutableOutputPath :: Target.ConcreteTarget -> Module -> App (Path Abs File) getExecutableOutputPath targetOrZen mainModule = do case targetOrZen of - Target.Named target -> do - executableDir <- getExecutableDir mainModule + Target.Named target _ -> do + executableDir <- getExecutableDir (Target.Concrete targetOrZen) mainModule resolveFile executableDir $ T.unpack target - Target.Zen path -> do - zenExecutableDir <- getZenExecutableDir mainModule + Target.Zen path _ _ -> do + zenExecutableDir <- getZenExecutableDir (Target.Concrete targetOrZen) mainModule relPath <- getRelPathFromSourceDir mainModule path (relPathWithoutExtension, _) <- P.splitExtension relPath return $ zenExecutableDir relPathWithoutExtension @@ -184,22 +185,21 @@ getBaseBuildDir baseModule = do let moduleRootDir = getModuleRootDir baseModule return $ moduleRootDir moduleBuildDir baseModule platformPrefix versionDir -getBuildDir :: Module -> App (Path Abs Dir) -getBuildDir baseModule = do +getBuildDir :: Target.Target -> Module -> App (Path Abs Dir) +getBuildDir target baseModule = do baseBuildDir <- getBaseBuildDir baseModule - buildSignature <- getBuildSignature baseModule + buildSignature <- getBuildSignature target baseModule buildPrefix <- P.parseRelDir $ "build-" ++ buildSignature return $ baseBuildDir buildPrefix -getBuildSignature :: Module -> App String -getBuildSignature baseModule = do +getBuildSignature :: Target.Target -> Module -> App String +getBuildSignature target baseModule = do sigMap <- readRef' buildSignatureMap case Map.lookup (moduleID baseModule) sigMap of Just sig -> do return sig Nothing -> do buildMode <- Env.getBuildMode - optString <- readRef' clangOptString let depList = map (second dependencyDigest) $ Map.toList $ moduleDependency baseModule depList' <- fmap catMaybes $ forM depList $ \(alias, digest) -> do shiftedDigestOrNone <- Antecedent.lookup digest @@ -208,85 +208,88 @@ getBuildSignature baseModule = do return Nothing Just shiftedModule -> return $ Just (MA.reify alias, _m :< E.String (MID.reify $ moduleID shiftedModule)) + clangDigest <- getClangDigest let ens = E.dictFromList _m [ ("build-mode", _m :< E.String (BM.reify buildMode)), - ("extra-clang-option", _m :< E.String (T.pack optString)), - ("compatible-shift", E.dictFromList _m depList') + ("clang-digest", _m :< E.String clangDigest), + ("compatible-shift", E.dictFromList _m depList'), + ("compile-option", _m :< E.String (T.pack $ unwords $ Target.getCompileOption target)), + ("link-option", _m :< E.String (T.pack $ unwords $ Target.getLinkOption target)) ] let sig = B.toString $ hashAndEncode $ B.fromString $ T.unpack $ E.pp $ E.inject ens modifyRef' buildSignatureMap $ Map.insert (moduleID baseModule) sig return sig -getArtifactDir :: Module -> App (Path Abs Dir) -getArtifactDir baseModule = do - buildDir <- getBuildDir baseModule +getArtifactDir :: Target.Target -> Module -> App (Path Abs Dir) +getArtifactDir target baseModule = do + buildDir <- getBuildDir target baseModule return $ buildDir artifactRelDir -getForeignDir :: Module -> App (Path Abs Dir) -getForeignDir baseModule = do - buildDir <- getBuildDir baseModule +getForeignDir :: Target.Target -> Module -> App (Path Abs Dir) +getForeignDir target baseModule = do + buildDir <- getBuildDir target baseModule let foreignDir = buildDir foreignRelDir ensureDir foreignDir return foreignDir -getEntryDir :: Module -> App (Path Abs Dir) -getEntryDir baseModule = do - buildDir <- getBuildDir baseModule +getEntryDir :: Target.Target -> Module -> App (Path Abs Dir) +getEntryDir target baseModule = do + buildDir <- getBuildDir target baseModule return $ buildDir entryRelDir -getExecutableDir :: Module -> App (Path Abs Dir) -getExecutableDir baseModule = do - buildDir <- getBuildDir baseModule +getExecutableDir :: Target.Target -> Module -> App (Path Abs Dir) +getExecutableDir target baseModule = do + buildDir <- getBuildDir target baseModule return $ buildDir executableRelDir -getZenExecutableDir :: Module -> App (Path Abs Dir) -getZenExecutableDir baseModule = do - buildDir <- getBuildDir baseModule +getZenExecutableDir :: Target.Target -> Module -> App (Path Abs Dir) +getZenExecutableDir target baseModule = do + buildDir <- getBuildDir target baseModule return $ buildDir zenRelDir executableRelDir -getZenEntryDir :: Module -> App (Path Abs Dir) -getZenEntryDir baseModule = do - buildDir <- getBuildDir baseModule +getZenEntryDir :: Target.Target -> Module -> App (Path Abs Dir) +getZenEntryDir target baseModule = do + buildDir <- getBuildDir target baseModule return $ buildDir zenRelDir entryRelDir -sourceToOutputPath :: OK.OutputKind -> Src.Source -> App (Path Abs File) -sourceToOutputPath kind source = do - artifactDir <- getArtifactDir $ Src.sourceModule source +sourceToOutputPath :: Target.Target -> OK.OutputKind -> Src.Source -> App (Path Abs File) +sourceToOutputPath target kind source = do + artifactDir <- getArtifactDir target $ Src.sourceModule source relPath <- Src.getRelPathFromSourceDir source (relPathWithoutExtension, _) <- P.splitExtension relPath Src.attachExtension (artifactDir relPathWithoutExtension) kind -getSourceCachePath :: Src.Source -> App (Path Abs File) -getSourceCachePath source = do - artifactDir <- getArtifactDir $ Src.sourceModule source +getSourceCachePath :: Target.Target -> Src.Source -> App (Path Abs File) +getSourceCachePath target source = do + artifactDir <- getArtifactDir target $ Src.sourceModule source relPath <- Src.getRelPathFromSourceDir source (relPathWithoutExtension, _) <- P.splitExtension relPath P.addExtension ".i" (artifactDir relPathWithoutExtension) -getSourceCompletionCachePath :: Src.Source -> App (Path Abs File) -getSourceCompletionCachePath source = do - artifactDir <- getArtifactDir $ Src.sourceModule source +getSourceCompletionCachePath :: Target.Target -> Src.Source -> App (Path Abs File) +getSourceCompletionCachePath target source = do + artifactDir <- getArtifactDir target $ Src.sourceModule source relPath <- Src.getRelPathFromSourceDir source (relPathWithoutExtension, _) <- P.splitExtension relPath P.addExtension ".ic" (artifactDir relPathWithoutExtension) -attachOutputPath :: OK.OutputKind -> Src.Source -> App (OK.OutputKind, Path Abs File) -attachOutputPath outputKind source = do - outputPath <- sourceToOutputPath outputKind source +attachOutputPath :: Target.Target -> OK.OutputKind -> Src.Source -> App (OK.OutputKind, Path Abs File) +attachOutputPath target outputKind source = do + outputPath <- sourceToOutputPath target outputKind source return (outputKind, outputPath) getOutputPathForEntryPoint :: Module -> OK.OutputKind -> Target.ConcreteTarget -> App (OK.OutputKind, Path Abs File) getOutputPathForEntryPoint baseModule kind targetOrZen = do case targetOrZen of - Target.Named target -> do - entryDir <- getEntryDir baseModule + Target.Named target _ -> do + entryDir <- getEntryDir (Target.Concrete targetOrZen) baseModule relPath <- parseRelFile $ T.unpack target outputPath <- Src.attachExtension (entryDir relPath) kind return (kind, outputPath) - Target.Zen path -> do - zenEntryDir <- getZenEntryDir baseModule + Target.Zen path _ _ -> do + zenEntryDir <- getZenEntryDir (Target.Concrete targetOrZen) baseModule relPath <- getRelPathFromSourceDir baseModule path (relPathWithoutExtension, _) <- P.splitExtension relPath outputPath <- Src.attachExtension (zenEntryDir relPathWithoutExtension) kind diff --git a/src/Entity/Config/Build.hs b/src/Entity/Config/Build.hs index efbdf6bdc..cae34622d 100644 --- a/src/Entity/Config/Build.hs +++ b/src/Entity/Config/Build.hs @@ -1,13 +1,12 @@ module Entity.Config.Build (Config (..)) where +import Data.Text qualified as T import Entity.BuildMode import Entity.Config.Remark qualified as Remark import Entity.OutputKind qualified as OK -import Entity.Target data Config = Config - { mTarget :: Maybe ConcreteTarget, - mClangOptString :: Maybe String, + { targetName :: T.Text, remarkCfg :: Remark.Config, outputKindList :: [OK.OutputKind], shouldSkipLink :: Bool, diff --git a/src/Entity/Config/Zen.hs b/src/Entity/Config/Zen.hs index 7e2d1b403..308860afd 100644 --- a/src/Entity/Config/Zen.hs +++ b/src/Entity/Config/Zen.hs @@ -1,11 +1,13 @@ module Entity.Config.Zen (Config (..)) where +import Data.Text qualified as T import Entity.BuildMode import Entity.Config.Remark qualified as Remark data Config = Config { filePathString :: FilePath, - mClangOptString :: Maybe String, + compileOption :: T.Text, + linkOption :: T.Text, remarkCfg :: Remark.Config, buildMode :: BuildMode, args :: [String] diff --git a/src/Entity/Module.hs b/src/Entity/Module.hs index 24ba3a659..b83ee55eb 100644 --- a/src/Entity/Module.hs +++ b/src/Entity/Module.hs @@ -7,7 +7,7 @@ import Data.Containers.ListUtils (nubOrd) import Data.HashMap.Strict qualified as Map import Data.List (find, sort) import Data.List.NonEmpty qualified as NE -import Data.Maybe (catMaybes) +import Data.Maybe (catMaybes, maybeToList) import Data.Text qualified as T import Entity.BaseName qualified as BN import Entity.Const @@ -57,7 +57,7 @@ type TargetName = data Module = Module { moduleID :: MID.ModuleID, moduleSourceDir :: Path Rel Dir, - moduleTarget :: Map.HashMap TargetName SL.SourceLocator, + moduleTarget :: Map.HashMap TargetName Target.TargetSummary, moduleArchiveDir :: Path Rel Dir, moduleBuildDir :: Path Rel Dir, moduleDependency :: Map.HashMap MA.ModuleAlias Dependency, @@ -87,6 +87,22 @@ keyTarget :: T.Text keyTarget = "target" +keyMain :: T.Text +keyMain = + "main" + +keyBuildOption :: T.Text +keyBuildOption = + "build-option" + +keyCompileOption :: T.Text +keyCompileOption = + "compile-option" + +keyLinkOption :: T.Text +keyLinkOption = + "link-option" + keyDependency :: T.Text keyDependency = "dependency" @@ -147,13 +163,13 @@ getTargetPathList :: Module -> [Path Abs File] getTargetPathList baseModule = do let moduleSourceDir = getSourceDir baseModule let sourceLocatorList = Map.elems $ moduleTarget baseModule - map ((moduleSourceDir ) . SL.reify) sourceLocatorList + map ((moduleSourceDir ) . SL.reify . Target.entryPoint) sourceLocatorList getTargetPath :: Module -> T.Text -> Maybe (Path Abs File) getTargetPath baseModule target = do let moduleSourceDir = getSourceDir baseModule sourceLocator <- Map.lookup target (moduleTarget baseModule) - return $ moduleSourceDir SL.reify sourceLocator + return $ moduleSourceDir SL.reify (Target.entryPoint sourceLocator) getArchiveDir :: Module -> Path Abs Dir getArchiveDir baseModule = @@ -225,7 +241,22 @@ getBuildDirInfo someModule = do getTargetInfo :: Module -> (T.Text, E.Ens) getTargetInfo someModule = do - let targetDict = Map.map (\x -> _m :< E.String (SL.getRelPathText x)) $ moduleTarget someModule + let targetDict = flip Map.map (moduleTarget someModule) $ \summary -> do + let compileOption = map (\x -> _m :< E.String x) $ Target.compileOption summary + let compileOption' = + if null compileOption + then Nothing + else Just (keyCompileOption, _m :< E.List (seriesFromList compileOption)) + let linkOption = map (\x -> _m :< E.String x) $ Target.linkOption summary + let linkOption' = + if null linkOption + then Nothing + else Just (keyLinkOption, _m :< E.List (seriesFromList linkOption)) + E.dictFromListVertical + _m + $ [(keyMain, _m :< E.String (SL.getRelPathText (Target.entryPoint summary)))] + ++ maybeToList compileOption' + ++ maybeToList linkOption' (keyTarget, E.dictFromListVertical _m (Map.toList targetDict)) getDependencyInfo :: Module -> Maybe (T.Text, E.Ens) @@ -324,13 +355,10 @@ getDigestFromModulePath moduleFilePath = dirname $ parent moduleFilePath -getTargetList :: Module -> Maybe Target.ConcreteTarget -> [Target.ConcreteTarget] -getTargetList someModule mTarget = - case mTarget of - Just target -> - [target] - Nothing -> do - map Target.Named $ Map.keys $ moduleTarget someModule +getTarget :: Module -> T.Text -> Maybe Target.ConcreteTarget +getTarget someModule targetName = do + target <- Map.lookup targetName (moduleTarget someModule) + return $ Target.Named targetName target stylize :: E.Ens -> Either Error E.Ens stylize ens = do diff --git a/src/Entity/Target.hs b/src/Entity/Target.hs index 1c25711fa..47a9c589b 100644 --- a/src/Entity/Target.hs +++ b/src/Entity/Target.hs @@ -3,6 +3,7 @@ module Entity.Target where import Data.Hashable import Data.Text qualified as T import Entity.BaseName qualified as BN +import Entity.SourceLocator qualified as SL import GHC.Generics (Generic) import Path @@ -11,21 +12,35 @@ data Target | Concrete ConcreteTarget deriving (Show, Eq, Generic) +data TargetSummary = TargetSummary + { entryPoint :: SL.SourceLocator, + buildOption :: [T.Text], + compileOption :: [T.Text], + linkOption :: [T.Text] + } + deriving (Show, Eq, Generic) + data AbstractTarget = Foundation deriving (Show, Eq, Generic) data ConcreteTarget - = Named T.Text - | Zen (Path Abs File) + = Named T.Text TargetSummary + | Zen (Path Abs File) T.Text T.Text deriving (Show, Eq, Generic) instance Hashable Target instance Hashable AbstractTarget +instance Hashable TargetSummary + instance Hashable ConcreteTarget +emptyZen :: Path Abs File -> ConcreteTarget +emptyZen path = + Zen path "" "" + getEntryPointName :: ConcreteTarget -> BN.BaseName getEntryPointName target = case target of @@ -33,3 +48,27 @@ getEntryPointName target = BN.mainName Zen {} -> BN.zenName + +getCompileOption :: Target -> [String] +getCompileOption target = + case target of + Abstract {} -> + [] + Concrete c -> + case c of + Named _ targetSummary -> + map T.unpack $ buildOption targetSummary ++ compileOption targetSummary + Zen _ compileOption _ -> + [T.unpack compileOption] + +getLinkOption :: Target -> [String] +getLinkOption target = + case target of + Abstract {} -> + [] + Concrete c -> + case c of + Named _ targetSummary -> + map T.unpack $ buildOption targetSummary ++ linkOption targetSummary + Zen _ _ linkOption -> + [T.unpack linkOption] diff --git a/src/Scene/Build.hs b/src/Scene/Build.hs index 065993379..0addbadf5 100644 --- a/src/Scene/Build.hs +++ b/src/Scene/Build.hs @@ -54,15 +54,16 @@ data Axis = Axis buildTarget :: Axis -> M.Module -> Target -> App () buildTarget axis baseModule target = do + target' <- expandClangOptions target Initialize.initializeForTarget - (artifactTime, dependenceSeq) <- Unravel.unravel baseModule target + (artifactTime, dependenceSeq) <- Unravel.unravel baseModule target' let moduleList = nubOrdOn M.moduleID $ map sourceModule dependenceSeq - didPerformForeignCompilation <- compileForeign moduleList - contentSeq <- load dependenceSeq - virtualCodeList <- compile target (_outputKindList axis) contentSeq + didPerformForeignCompilation <- compileForeign target' moduleList + contentSeq <- load target' dependenceSeq + virtualCodeList <- compile target' (_outputKindList axis) contentSeq Remark.getGlobalRemarkList >>= Remark.printRemarkList - emitAndWrite (_outputKindList axis) virtualCodeList - case target of + emitAndWrite target' (_outputKindList axis) virtualCodeList + case target' of Abstract {} -> return () Concrete ct -> do @@ -80,17 +81,17 @@ abstractAxis = _executeArgs = [] } -load :: [Source] -> App [(Source, Either Cache T.Text)] -load dependenceSeq = +load :: Target -> [Source] -> App [(Source, Either Cache T.Text)] +load target dependenceSeq = forConcurrently dependenceSeq $ \source -> do - cacheOrContent <- Load.load source + cacheOrContent <- Load.load target source return (source, cacheOrContent) compile :: Target -> [OutputKind] -> [(Source, Either Cache T.Text)] -> App [(Either ConcreteTarget Source, LC.LowCode)] compile target outputKindList contentSeq = do virtualCodeList <- fmap catMaybes $ forM contentSeq $ \(source, cacheOrContent) -> do Initialize.initializeForSource source - stmtList <- Parse.parse source cacheOrContent >>= Elaborate.elaborate + stmtList <- Parse.parse source cacheOrContent >>= Elaborate.elaborate target EnsureMain.ensureMain target source (map snd $ getStmtName stmtList) Cache.whenCompilationNecessary outputKindList source $ do virtualCode <- Clarify.clarify stmtList >>= Lower.lower @@ -112,12 +113,13 @@ compileEntryPoint mainModule target outputKindList = do mainVirtualCode <- Clarify.clarifyEntryPoint >>= Lower.lowerEntryPoint t return [(Left t, mainVirtualCode)] -emitAndWrite :: [OutputKind] -> [(Either ConcreteTarget Source, LC.LowCode)] -> App () -emitAndWrite outputKindList virtualCodeList = do +emitAndWrite :: Target -> [OutputKind] -> [(Either ConcreteTarget Source, LC.LowCode)] -> App () +emitAndWrite target outputKindList virtualCodeList = do + let clangOptions = getCompileOption target currentTime <- liftIO getCurrentTime forConcurrently_ virtualCodeList $ \(sourceOrNone, llvmIR) -> do llvmIR' <- Emit.emit llvmIR - LLVM.emit currentTime sourceOrNone outputKindList llvmIR' + LLVM.emit target clangOptions currentTime sourceOrNone outputKindList llvmIR' execute :: Bool -> ConcreteTarget -> [String] -> App () execute shouldExecute target args = do @@ -128,18 +130,18 @@ install filePathOrNone target = do mDir <- mapM Path.getInstallDir filePathOrNone mapM_ (Install.install target) mDir -compileForeign :: [M.Module] -> App Bool -compileForeign moduleList = do +compileForeign :: Target -> [M.Module] -> App Bool +compileForeign t moduleList = do currentTime <- liftIO getCurrentTime - bs <- forConcurrently moduleList (compileForeign' currentTime) + bs <- forConcurrently moduleList (compileForeign' t currentTime) return $ or bs -compileForeign' :: UTCTime -> M.Module -> App Bool -compileForeign' currentTime m = do - sub <- getForeignSubst m +compileForeign' :: Target -> UTCTime -> M.Module -> App Bool +compileForeign' t currentTime m = do + sub <- getForeignSubst t m let cmdList = M.script $ M.moduleForeign m let moduleRootDir = M.getModuleRootDir m - foreignDir <- Path.getForeignDir m + foreignDir <- Path.getForeignDir t m inputPathList <- fmap concat $ mapM (getInputPathList moduleRootDir) $ M.input $ M.moduleForeign m let outputPathList = map (foreignDir ) $ M.output $ M.moduleForeign m inputTime <- Path.getLastModifiedSup inputPathList @@ -181,10 +183,10 @@ naiveReplace sub t = (from, to) : rest -> do T.replace from to (naiveReplace rest t) -getForeignSubst :: M.Module -> App [(T.Text, T.Text)] -getForeignSubst m = do +getForeignSubst :: Target -> M.Module -> App [(T.Text, T.Text)] +getForeignSubst t m = do clang <- liftIO External.getClang - foreignDir <- Path.getForeignDir m + foreignDir <- Path.getForeignDir t m return [ ("{{module-root}}", T.pack $ toFilePath $ M.getModuleRootDir m), ("{{clang}}", T.pack clang), @@ -202,3 +204,29 @@ attachPrefixPath baseDirPath path = Left $ baseDirPath dirPath Right filePath -> Right $ baseDirPath filePath + +expandClangOptions :: Target -> App Target +expandClangOptions target = + case target of + Abstract {} -> + return target + Concrete concreteTarget -> + case concreteTarget of + Named targetName summary -> do + buildOption' <- mapM External.expandText (buildOption summary) + compileOption' <- mapM External.expandText (compileOption summary) + linkOption' <- mapM External.expandText (linkOption summary) + return $ + Concrete $ + Named + targetName + ( summary + { buildOption = buildOption', + compileOption = compileOption', + linkOption = linkOption' + } + ) + Zen path compileOption linkOption -> do + compileOption' <- External.expandText compileOption + linkOption' <- External.expandText linkOption + return $ Concrete $ Zen path compileOption' linkOption' diff --git a/src/Scene/Check.hs b/src/Scene/Check.hs index 35e5ea742..4df4b4f37 100644 --- a/src/Scene/Check.hs +++ b/src/Scene/Check.hs @@ -24,7 +24,7 @@ check = do checkSource :: Source -> App [Remark] checkSource source = do - _check $ Concrete $ Zen (sourceFilePath source) + _check $ Concrete $ emptyZen (sourceFilePath source) _check :: Target -> App [Remark] _check target = do @@ -33,8 +33,8 @@ _check target = do mainModule <- getMainModule (_, dependenceSeq) <- Unravel.unravel mainModule target contentSeq <- forConcurrently dependenceSeq $ \source -> do - cacheOrContent <- Load.load source + cacheOrContent <- Load.load target source return (source, cacheOrContent) forM_ contentSeq $ \(source, cacheOrContent) -> do Initialize.initializeForSource source - void $ Parse.parse source cacheOrContent >>= Elaborate.elaborate + void $ Parse.parse source cacheOrContent >>= Elaborate.elaborate target diff --git a/src/Scene/Collect.hs b/src/Scene/Collect.hs index 9b0997d1e..7f4abe40b 100644 --- a/src/Scene/Collect.hs +++ b/src/Scene/Collect.hs @@ -1,20 +1,27 @@ module Scene.Collect - ( collectTargetList, + ( getConcreteTarget, collectModuleFiles, ) where import Context.App import Context.Module qualified as Module +import Context.Throw qualified as Throw import Data.Maybe +import Data.Text qualified as T import Entity.Module import Entity.Target import Path import Prelude hiding (log) -collectTargetList :: Maybe ConcreteTarget -> App [ConcreteTarget] -collectTargetList mTarget = do - flip getTargetList mTarget <$> Module.getMainModule +getConcreteTarget :: T.Text -> App ConcreteTarget +getConcreteTarget targetName = do + targetOrNone <- flip getTarget targetName <$> Module.getMainModule + case targetOrNone of + Just target -> + return target + Nothing -> + Throw.raiseError' $ "no such target exists: " <> targetName collectModuleFiles :: Module -> (Path Abs Dir, [SomePath Rel]) collectModuleFiles baseModule = do diff --git a/src/Scene/Elaborate.hs b/src/Scene/Elaborate.hs index 087028ddc..02e5d9a90 100644 --- a/src/Scene/Elaborate.hs +++ b/src/Scene/Elaborate.hs @@ -39,6 +39,7 @@ import Entity.PrimValue qualified as PV import Entity.Remark qualified as Remark import Entity.Stmt import Entity.StmtKind +import Entity.Target import Entity.Term qualified as TM import Entity.Term.Weaken import Entity.WeakPrim qualified as WP @@ -49,8 +50,8 @@ import Scene.Elaborate.Infer qualified as Infer import Scene.Elaborate.Unify qualified as Unify import Scene.Term.Inline qualified as TM -elaborate :: Either Cache.Cache [WeakStmt] -> App [Stmt] -elaborate cacheOrStmt = do +elaborate :: Target -> Either Cache.Cache [WeakStmt] -> App [Stmt] +elaborate target cacheOrStmt = do initialize case cacheOrStmt of Left cache -> do @@ -61,7 +62,7 @@ elaborate cacheOrStmt = do Gensym.setCount $ Cache.countSnapshot cache return stmtList Right stmtList -> do - analyzeStmtList stmtList >>= synthesizeStmtList + analyzeStmtList stmtList >>= synthesizeStmtList target analyzeStmtList :: [WeakStmt] -> App [WeakStmt] analyzeStmtList stmtList = do @@ -71,8 +72,8 @@ analyzeStmtList stmtList = do insertWeakStmt stmt' return stmt' -synthesizeStmtList :: [WeakStmt] -> App [Stmt] -synthesizeStmtList stmtList = do +synthesizeStmtList :: Target -> [WeakStmt] -> App [Stmt] +synthesizeStmtList target stmtList = do -- mapM_ viewStmt stmtList getConstraintEnv >>= Unify.unify >>= setHoleSubst stmtList' <- concat <$> mapM elaborateStmt stmtList @@ -84,14 +85,14 @@ synthesizeStmtList stmtList = do topCandidate <- TopCandidate.get rawImportSummary <- RawImportSummary.get countSnapshot <- Gensym.getCount - Cache.saveCache source $ + Cache.saveCache target source $ Cache.Cache { Cache.stmtList = stmtList', Cache.remarkList = remarkList, Cache.locationTree = tmap, Cache.countSnapshot = countSnapshot } - Cache.saveCompletionCache source $ + Cache.saveCompletionCache target source $ Cache.CompletionCache { Cache.localVarTree = localVarTree, Cache.topCandidate = topCandidate, diff --git a/src/Scene/Format.hs b/src/Scene/Format.hs index 19ad96cf4..716eaa8c9 100644 --- a/src/Scene/Format.hs +++ b/src/Scene/Format.hs @@ -34,9 +34,9 @@ _formatSource :: Path Abs File -> T.Text -> App T.Text _formatSource path content = do Initialize.initializeForTarget mainModule <- getMainModule - (_, dependenceSeq) <- Unravel.unravel mainModule $ Concrete $ Zen path + (_, dependenceSeq) <- Unravel.unravel mainModule $ Concrete (emptyZen path) contentSeq <- forConcurrently dependenceSeq $ \source -> do - cacheOrContent <- Load.load source + cacheOrContent <- Load.load (Abstract Foundation) source return (source, cacheOrContent) let contentSeq' = _replaceLast content contentSeq forM_ contentSeq' $ \(source, cacheOrContent) -> do diff --git a/src/Scene/Initialize.hs b/src/Scene/Initialize.hs index e8972c4f8..5d68c36dd 100644 --- a/src/Scene/Initialize.hs +++ b/src/Scene/Initialize.hs @@ -13,7 +13,6 @@ import Context.Decl qualified as Decl import Context.Definition qualified as Definition import Context.Env qualified as Env import Context.Global qualified as Global -import Context.LLVM qualified as LLVM import Context.Locator qualified as Locator import Context.Module qualified as Module import Context.RawImportSummary qualified as RawImportSummary @@ -26,7 +25,6 @@ import Context.UnusedGlobalLocator qualified as UnusedGlobalLocator import Context.UnusedLocalLocator qualified as UnusedLocalLocator import Context.UnusedVariable qualified as UnusedVariable import Context.WeakDefinition qualified as WeakDefinition -import Data.Maybe import Entity.Config.Remark qualified as Remark import Entity.Module import Entity.Source qualified as Source @@ -38,15 +36,14 @@ initializeLogger cfg = do Remark.setEndOfEntry $ Remark.endOfEntry cfg Remark.setShouldColorize $ Remark.shouldColorize cfg -initializeCompiler :: Remark.Config -> Maybe String -> App () -initializeCompiler cfg mClangOptString = do +initializeCompiler :: Remark.Config -> App () +initializeCompiler cfg = do initializeLogger cfg mainModule <- Module.fromCurrentPath - initializeCompilerWithModule mainModule mClangOptString + initializeCompilerWithModule mainModule -initializeCompilerWithModule :: Module -> Maybe String -> App () -initializeCompilerWithModule newModule mClangOptString = do - LLVM.setClangOptString (fromMaybe "" mClangOptString) +initializeCompilerWithModule :: Module -> App () +initializeCompilerWithModule newModule = do Module.setMainModule newModule initializeForTarget :: App () diff --git a/src/Scene/Install.hs b/src/Scene/Install.hs index c4fa6e6f3..9694d6adb 100644 --- a/src/Scene/Install.hs +++ b/src/Scene/Install.hs @@ -14,8 +14,8 @@ install :: Target.ConcreteTarget -> Path Abs Dir -> App () install targetOrZen dir = do execPath <- Module.getMainModule >>= Path.getExecutableOutputPath targetOrZen case targetOrZen of - Target.Named target -> do - execName <- parseRelFile $ T.unpack target + Target.Named targetName _ -> do + execName <- parseRelFile $ T.unpack targetName let destPath = dir execName copyFile execPath destPath Target.Zen {} -> diff --git a/src/Scene/LSP.hs b/src/Scene/LSP.hs index cd2aa7092..2668a507d 100644 --- a/src/Scene/LSP.hs +++ b/src/Scene/LSP.hs @@ -29,7 +29,7 @@ import System.IO (stdin, stdout) lsp :: Remark.Config -> App Int lsp cfg = do - Initialize.initializeCompiler cfg Nothing + Initialize.initializeCompiler cfg liftIO $ runQuietServer $ ServerDefinition @@ -139,5 +139,5 @@ handlers = runLSPApp :: Remark.Config -> App a -> IO a runLSPApp cfg app = do runApp $ do - Initialize.initializeCompiler cfg Nothing + Initialize.initializeCompiler cfg app diff --git a/src/Scene/LSP/Complete.hs b/src/Scene/LSP/Complete.hs index 932cfc7a4..46f9f38e4 100644 --- a/src/Scene/LSP/Complete.hs +++ b/src/Scene/LSP/Complete.hs @@ -25,6 +25,7 @@ import Entity.ModuleAlias qualified as MA import Entity.RawImportSummary import Entity.Source import Entity.SourceLocator qualified as SL +import Entity.Target import Entity.TopCandidate import Language.LSP.Protocol.Types import Scene.LSP.GetAllCachesInModule (getAllCompletionCachesInModule) @@ -45,7 +46,7 @@ itemGetterList = getLocalCompletionItems :: Source -> Loc -> App [CompletionItem] getLocalCompletionItems source loc = do - cachePath <- Path.getSourceCompletionCachePath source + cachePath <- Path.getSourceCompletionCachePath (Abstract Foundation) source cacheOrNone <- Cache.loadCompletionCacheOptimistically cachePath case cacheOrNone of Nothing -> @@ -59,7 +60,9 @@ getGlobalCompletionItems :: Source -> Loc -> App [CompletionItem] getGlobalCompletionItems currentSource loc = do let baseModule = sourceModule currentSource (globalVarList, aliasPresetMap) <- getAllTopCandidate baseModule - baseCacheOrNone <- Path.getSourceCompletionCachePath currentSource >>= Cache.loadCompletionCacheOptimistically + baseCacheOrNone <- + Path.getSourceCompletionCachePath (Abstract Foundation) currentSource + >>= Cache.loadCompletionCacheOptimistically let importSummaryOrNone = baseCacheOrNone >>= Cache.rawImportSummary let impLoc = getImportLoc importSummaryOrNone if loc < impLoc diff --git a/src/Scene/LSP/GetAllCachesInModule.hs b/src/Scene/LSP/GetAllCachesInModule.hs index 62156ec7e..9d9d279a5 100644 --- a/src/Scene/LSP/GetAllCachesInModule.hs +++ b/src/Scene/LSP/GetAllCachesInModule.hs @@ -11,6 +11,7 @@ import Data.Maybe (catMaybes) import Entity.Cache import Entity.Module import Entity.Source +import Entity.Target import Path import Path.IO import UnliftIO.Async @@ -23,7 +24,7 @@ getAllCachesInModule baseModule = do getCache :: Module -> Path Abs File -> App (Maybe (Source, Cache)) getCache baseModule filePath = do let source = Source {sourceFilePath = filePath, sourceModule = baseModule, sourceHint = Nothing} - cacheOrNone <- getSourceCachePath source >>= Cache.loadCacheOptimistically + cacheOrNone <- getSourceCachePath (Abstract Foundation) source >>= Cache.loadCacheOptimistically case cacheOrNone of Nothing -> return Nothing @@ -38,7 +39,9 @@ getAllCompletionCachesInModule baseModule = do getCompletionCache :: Module -> Path Abs File -> App (Maybe (Source, CompletionCache)) getCompletionCache baseModule filePath = do let source = Source {sourceFilePath = filePath, sourceModule = baseModule, sourceHint = Nothing} - cacheOrNone <- getSourceCompletionCachePath source >>= Cache.loadCompletionCacheOptimistically + cacheOrNone <- + getSourceCompletionCachePath (Abstract Foundation) source + >>= Cache.loadCompletionCacheOptimistically case cacheOrNone of Nothing -> return Nothing diff --git a/src/Scene/LSP/GetLocationTree.hs b/src/Scene/LSP/GetLocationTree.hs index 14fcc0702..b5963659f 100644 --- a/src/Scene/LSP/GetLocationTree.hs +++ b/src/Scene/LSP/GetLocationTree.hs @@ -9,6 +9,7 @@ import Control.Monad.Trans import Entity.Cache qualified as Cache import Entity.LocationTree qualified as LT import Entity.Source +import Entity.Target import Scene.Unravel getLocationTree :: @@ -16,11 +17,11 @@ getLocationTree :: AppM LT.LocationTree getLocationTree src = do lift Unravel.initialize - resultOrError <- lift $ Throw.execute $ unravel' src + resultOrError <- lift $ Throw.execute $ unravel' (Abstract Foundation) src case resultOrError of Left _ -> liftMaybe Nothing Right _ -> do - cachePath <- lift $ Path.getSourceCachePath src + cachePath <- lift $ Path.getSourceCachePath (Abstract Foundation) src cache <- lift (Cache.loadCacheOptimistically cachePath) >>= liftMaybe return $ Cache.locationTree cache diff --git a/src/Scene/Link.hs b/src/Scene/Link.hs index a15690176..deca1ae32 100644 --- a/src/Scene/Link.hs +++ b/src/Scene/Link.hs @@ -31,11 +31,12 @@ link' :: ConcreteTarget -> Module -> [Source.Source] -> App () link' target mainModule sourceList = do mainObject <- snd <$> Path.getOutputPathForEntryPoint mainModule OK.Object target outputPath <- Path.getExecutableOutputPath target mainModule - objectPathList <- mapM (Path.sourceToOutputPath OK.Object) sourceList + objectPathList <- mapM (Path.sourceToOutputPath (Concrete target) OK.Object) sourceList let moduleList = nubOrdOn moduleID $ map Source.sourceModule sourceList - foreignDirList <- mapM Path.getForeignDir moduleList + foreignDirList <- mapM (Path.getForeignDir (Concrete target)) moduleList foreignObjectList <- concat <$> mapM getForeignDirContent foreignDirList - LLVM.link (mainObject : objectPathList ++ foreignObjectList) outputPath + let clangOptions = getLinkOption (Concrete target) + LLVM.link clangOptions (mainObject : objectPathList ++ foreignObjectList) outputPath getForeignDirContent :: Path Abs Dir -> App [Path Abs File] getForeignDirContent foreignDir = do diff --git a/src/Scene/Load.hs b/src/Scene/Load.hs index 731ecb65f..39231a795 100644 --- a/src/Scene/Load.hs +++ b/src/Scene/Load.hs @@ -6,10 +6,11 @@ import Context.Parse (readTextFile) import Data.Text qualified as T import Entity.Cache qualified as Cache import Entity.Source qualified as Source +import Entity.Target -load :: Source.Source -> App (Either Cache.Cache T.Text) -load source = do - mCache <- Cache.loadCache source +load :: Target -> Source.Source -> App (Either Cache.Cache T.Text) +load target source = do + mCache <- Cache.loadCache target source case mCache of Just cache -> do return $ Left cache diff --git a/src/Scene/Module/Reflect.hs b/src/Scene/Module/Reflect.hs index 72438e0e8..22c11a227 100644 --- a/src/Scene/Module/Reflect.hs +++ b/src/Scene/Module/Reflect.hs @@ -31,6 +31,7 @@ import Entity.ModuleID qualified as MID import Entity.ModuleURL import Entity.SourceLocator qualified as SL import Entity.Syntax.Series qualified as SE +import Entity.Target import Path import Path.IO import Scene.Ens.Reflect qualified as Ens @@ -60,8 +61,8 @@ getModule m moduleID locatorText = do fromFilePath :: MID.ModuleID -> Path Abs File -> App Module fromFilePath moduleID moduleFilePath = do (_, (ens@(m :< _), _)) <- Ens.fromFilePath moduleFilePath - (_, targetEns) <- liftEither $ E.access' keyTarget E.emptyDict ens >>= E.toDictionary - target <- mapM interpretSourceLocator $ Map.fromList $ SE.extract targetEns + targetEns <- liftEither $ E.access' keyTarget E.emptyDict ens >>= E.toDictionary + target <- interpretTarget targetEns dependencyEns <- liftEither $ E.access' keyDependency E.emptyDict ens >>= E.toDictionary dependency <- interpretDependencyDict dependencyEns (_, extraContentsEns) <- liftEither $ E.access' keyExtraContent E.emptyList ens >>= E.toList @@ -141,6 +142,19 @@ interpretPresetMap _ ens = do return (k, v') return $ Map.fromList kvs +interpretTarget :: (H.Hint, SE.Series (T.Text, E.Ens)) -> App (Map.HashMap TargetName TargetSummary) +interpretTarget (_, targetDict) = do + kvs <- forM (SE.extract targetDict) $ \(k, v) -> do + entryPoint <- liftEither (E.access keyMain v) >>= interpretSourceLocator + (_, buildOptEnsSeries) <- liftEither $ E.access' keyBuildOption E.emptyList v >>= E.toList + buildOption <- liftEither $ mapM (E.toString >=> return . snd) $ SE.extract buildOptEnsSeries + (_, compileOptEnsSeries) <- liftEither $ E.access' keyCompileOption E.emptyList v >>= E.toList + compileOption <- liftEither $ mapM (E.toString >=> return . snd) $ SE.extract compileOptEnsSeries + (_, linkOptEnsSeries) <- liftEither $ E.access' keyLinkOption E.emptyList v >>= E.toList + linkOption <- liftEither $ mapM (E.toString >=> return . snd) $ SE.extract linkOptEnsSeries + return (k, TargetSummary {entryPoint, buildOption, compileOption, linkOption}) + return $ Map.fromList kvs + interpretSourceLocator :: E.Ens -> App SL.SourceLocator interpretSourceLocator ens = do (m, pathString) <- liftEither $ E.toString ens diff --git a/src/Scene/New.hs b/src/Scene/New.hs index 24566b071..bd7eee37c 100644 --- a/src/Scene/New.hs +++ b/src/Scene/New.hs @@ -16,6 +16,7 @@ import Entity.Const import Entity.Module import Entity.ModuleID qualified as MID import Entity.SourceLocator qualified as SL +import Entity.Target import Path (parent, ()) createNewProject :: T.Text -> Module -> App () @@ -43,7 +44,12 @@ constructDefaultModule name = do moduleTarget = Map.fromList [ ( name, - SL.SourceLocator mainFile + TargetSummary + { entryPoint = SL.SourceLocator mainFile, + buildOption = [], + compileOption = [], + linkOption = [] + } ) ], moduleDependency = Map.empty, diff --git a/src/Scene/Unravel.hs b/src/Scene/Unravel.hs index 87288b6a0..75cac8f86 100644 --- a/src/Scene/Unravel.hs +++ b/src/Scene/Unravel.hs @@ -55,29 +55,30 @@ unravel baseModule t = do case a of Foundation -> do registerShiftMap baseModule - unravelFoundational baseModule + unravelFoundational t baseModule Concrete t' -> do case t' of - Zen path -> - unravelFromFile baseModule path - Named target -> do - case getTargetPath baseModule target of + Zen path _ _ -> + unravelFromFile t baseModule path + Named targetName _ -> do + case getTargetPath baseModule targetName of Nothing -> - Throw.raiseError' $ "no such target is defined: `" <> target <> "`" + Throw.raiseError' $ "no such target is defined: `" <> targetName <> "`" Just path -> do - unravelFromFile baseModule path + unravelFromFile t baseModule path unravelFromFile :: + Target -> Module -> Path Abs File -> App (A.ArtifactTime, [Source.Source]) -unravelFromFile baseModule path = do - Module.sourceFromPath baseModule path >>= unravel' +unravelFromFile target baseModule path = do + Module.sourceFromPath baseModule path >>= unravel' target -unravel' :: Source.Source -> App (A.ArtifactTime, [Source.Source]) -unravel' source = do +unravel' :: Target -> Source.Source -> App (A.ArtifactTime, [Source.Source]) +unravel' target source = do registerShiftMap (Source.sourceModule source) - (artifactTime, sourceSeq) <- unravel'' source + (artifactTime, sourceSeq) <- unravel'' target source forM_ sourceSeq Parse.ensureExistence return (artifactTime, toList sourceSeq) @@ -123,8 +124,8 @@ unravelModule axis currentModule = do liftIO $ modifyIORef' (traceListRef axis) tail return $ getAntecedentArrow currentModule ++ arrows -unravel'' :: Source.Source -> App (A.ArtifactTime, Seq Source.Source) -unravel'' source = do +unravel'' :: Target -> Source.Source -> App (A.ArtifactTime, Seq Source.Source) +unravel'' target source = do visitEnv <- Unravel.getVisitEnv let path = Source.sourceFilePath source case Map.lookup path visitEnv of @@ -138,18 +139,18 @@ unravel'' source = do Unravel.insertToVisitEnv path VI.Active Unravel.pushToTraceSourceList source children <- getChildren source - (artifactTimeList, seqList) <- mapAndUnzipM unravel'' children + (artifactTimeList, seqList) <- mapAndUnzipM (unravel'' target) children _ <- Unravel.popFromTraceSourceList Unravel.insertToVisitEnv path VI.Finish - baseArtifactTime <- getBaseArtifactTime source + baseArtifactTime <- getBaseArtifactTime target source artifactTime <- getArtifactTime artifactTimeList baseArtifactTime Env.insertToArtifactMap (Source.sourceFilePath source) artifactTime return (artifactTime, foldl' (><) Seq.empty seqList |> source) -unravelFoundational :: Module -> App (A.ArtifactTime, [Source.Source]) -unravelFoundational baseModule = do +unravelFoundational :: Target -> Module -> App (A.ArtifactTime, [Source.Source]) +unravelFoundational target baseModule = do children <- Module.getAllSourceInModule baseModule - (artifactTimeList, seqList) <- mapAndUnzipM unravel'' children + (artifactTimeList, seqList) <- mapAndUnzipM (unravel'' target) children baseArtifactTime <- artifactTimeFromCurrentTime artifactTime <- getArtifactTime artifactTimeList baseArtifactTime return (artifactTime, toList $ foldl' (><) Seq.empty seqList) @@ -161,11 +162,11 @@ getArtifactTime artifactTimeList artifactTime = do objectTime <- getItemTime' (map A.objectTime artifactTimeList) $ A.objectTime artifactTime return A.ArtifactTime {cacheTime, llvmTime, objectTime} -getBaseArtifactTime :: Source.Source -> App A.ArtifactTime -getBaseArtifactTime source = do - cacheTime <- getFreshCacheTime source - llvmTime <- getFreshLLVMTime source - objectTime <- getFreshObjectTime source +getBaseArtifactTime :: Target -> Source.Source -> App A.ArtifactTime +getBaseArtifactTime target source = do + cacheTime <- getFreshCacheTime target source + llvmTime <- getFreshLLVMTime target source + objectTime <- getFreshObjectTime target source return A.ArtifactTime {cacheTime, llvmTime, objectTime} getItemTime' :: @@ -193,19 +194,19 @@ distributeMaybe xs = rest' <- distributeMaybe rest return $ y : rest' -getFreshCacheTime :: Source.Source -> App CacheTime -getFreshCacheTime source = do - cachePath <- Path.getSourceCachePath source +getFreshCacheTime :: Target -> Source.Source -> App CacheTime +getFreshCacheTime target source = do + cachePath <- Path.getSourceCachePath target source getFreshTime source cachePath -getFreshLLVMTime :: Source.Source -> App LLVMTime -getFreshLLVMTime source = do - llvmPath <- Path.sourceToOutputPath OK.LLVM source +getFreshLLVMTime :: Target -> Source.Source -> App LLVMTime +getFreshLLVMTime target source = do + llvmPath <- Path.sourceToOutputPath target OK.LLVM source getFreshTime source llvmPath -getFreshObjectTime :: Source.Source -> App ObjectTime -getFreshObjectTime source = do - objectPath <- Path.sourceToOutputPath OK.Object source +getFreshObjectTime :: Target -> Source.Source -> App ObjectTime +getFreshObjectTime target source = do + objectPath <- Path.sourceToOutputPath target OK.Object source getFreshTime source objectPath getFreshTime :: Source.Source -> Path Abs File -> App (Maybe UTCTime) diff --git a/test/meta/module.ens b/test/meta/module.ens index 6e0fa32c6..e0a642600 100644 --- a/test/meta/module.ens +++ b/test/meta/module.ens @@ -1,14 +1,16 @@ { + target { + meta { + main "meta.nt", + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - meta "meta.nt", - }, } diff --git a/test/misc/adder/module.ens b/test/misc/adder/module.ens index 18286ecba..1b7079cb8 100644 --- a/test/misc/adder/module.ens +++ b/test/misc/adder/module.ens @@ -1,14 +1,19 @@ { + target { + adder { + main "adder.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - adder "adder.nt", - }, } diff --git a/test/misc/args/module.ens b/test/misc/args/module.ens index e6e1e0b86..1ec0e8fa9 100644 --- a/test/misc/args/module.ens +++ b/test/misc/args/module.ens @@ -1,14 +1,19 @@ { + target { + args { + main "args.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - args "args.nt", - }, } diff --git a/test/misc/calc/module.ens b/test/misc/calc/module.ens index bf25f0a87..86fcb79a2 100644 --- a/test/misc/calc/module.ens +++ b/test/misc/calc/module.ens @@ -1,14 +1,19 @@ { + target { + calc { + main "calc.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - calc "calc.nt", - }, } diff --git a/test/misc/check/module.ens b/test/misc/check/module.ens index 7b36d90f2..444e697b8 100644 --- a/test/misc/check/module.ens +++ b/test/misc/check/module.ens @@ -1,14 +1,19 @@ { + target { + check { + main "check.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - check "check.nt", - }, } diff --git a/test/misc/codata-basic/module.ens b/test/misc/codata-basic/module.ens index 0387f583e..9aea19e98 100644 --- a/test/misc/codata-basic/module.ens +++ b/test/misc/codata-basic/module.ens @@ -1,14 +1,19 @@ { + target { + codata-basic { + main "codata-basic.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - codata-basic "codata-basic.nt", - }, } diff --git a/test/misc/complex-cancel/module.ens b/test/misc/complex-cancel/module.ens index 83ae12ffe..3856527d5 100644 --- a/test/misc/complex-cancel/module.ens +++ b/test/misc/complex-cancel/module.ens @@ -1,14 +1,19 @@ { + target { + complex-cancel { + main "complex-cancel.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - complex-cancel "complex-cancel.nt", - }, } diff --git a/test/misc/ex-falso/module.ens b/test/misc/ex-falso/module.ens index ce852e897..d750b9d0b 100644 --- a/test/misc/ex-falso/module.ens +++ b/test/misc/ex-falso/module.ens @@ -1,14 +1,19 @@ { + target { + ex-falso { + main "ex-falso.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - ex-falso "ex-falso.nt", - }, } diff --git a/test/misc/fact/module.ens b/test/misc/fact/module.ens index 53eb5790d..fc5ecb5e6 100644 --- a/test/misc/fact/module.ens +++ b/test/misc/fact/module.ens @@ -1,14 +1,19 @@ { + target { + fact { + main "fact.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - fact "fact.nt", - }, } diff --git a/test/misc/file/module.ens b/test/misc/file/module.ens index e1f680bb1..7a432cd6f 100644 --- a/test/misc/file/module.ens +++ b/test/misc/file/module.ens @@ -1,18 +1,23 @@ { - dependency { - core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", - mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + target { + file { + main "file.nt", + build-option [ + "-fsanitize=address", ], - enable-preset true, }, }, prefix { FF "core.file.flag", FM "core.file.mode", }, - target { - file "file.nt", + dependency { + core { + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", + mirror [ + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", + ], + enable-preset true, + }, }, } diff --git a/test/misc/fix-and-free-vars/module.ens b/test/misc/fix-and-free-vars/module.ens index 9695abf2c..acf7b2de1 100644 --- a/test/misc/fix-and-free-vars/module.ens +++ b/test/misc/fix-and-free-vars/module.ens @@ -1,18 +1,23 @@ { - dependency { - core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", - mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + target { + fix-and-free-vars { + main "fix-and-free-vars.nt", + build-option [ + "-fsanitize=address", ], - enable-preset true, }, }, prefix { L "core.list", V "core.vector", }, - target { - fix-and-free-vars "fix-and-free-vars.nt", + dependency { + core { + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", + mirror [ + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", + ], + enable-preset true, + }, }, } diff --git a/test/misc/fold-tails/module.ens b/test/misc/fold-tails/module.ens index 82f9d112d..ccde4c78c 100644 --- a/test/misc/fold-tails/module.ens +++ b/test/misc/fold-tails/module.ens @@ -1,14 +1,19 @@ { + target { + fold-tails { + main "fold-tails.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - fold-tails "fold-tails.nt", - }, } diff --git a/test/misc/foreign/module.ens b/test/misc/foreign/module.ens index d0a5b0066..6874cf517 100644 --- a/test/misc/foreign/module.ens +++ b/test/misc/foreign/module.ens @@ -1,11 +1,10 @@ { - dependency { - core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", - mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + target { + foreign { + main "foreign.nt", + build-option [ + "-fsanitize=address", ], - enable-preset true, }, }, foreign { @@ -19,7 +18,13 @@ "{{clang}} -c -flto=thin -O2 foreign/add_const.c -o {{foreign}}/add_const.o", ], }, - target { - foreign "foreign.nt", + dependency { + core { + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", + mirror [ + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", + ], + enable-preset true, + }, }, } diff --git a/test/misc/hello/module.ens b/test/misc/hello/module.ens index af50ab7da..9fef28dbb 100644 --- a/test/misc/hello/module.ens +++ b/test/misc/hello/module.ens @@ -1,14 +1,19 @@ { + target { + hello { + main "hello.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - hello "hello.nt", - }, } diff --git a/test/misc/lambda-list/module.ens b/test/misc/lambda-list/module.ens index 98c076b70..69a5c8e1c 100644 --- a/test/misc/lambda-list/module.ens +++ b/test/misc/lambda-list/module.ens @@ -1,14 +1,19 @@ { + target { + lambda-list { + main "lambda-list.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - lambda-list "lambda-list.nt", - }, } diff --git a/test/misc/loop-and-resource/module.ens b/test/misc/loop-and-resource/module.ens index 5b6d40531..d6ba2799a 100644 --- a/test/misc/loop-and-resource/module.ens +++ b/test/misc/loop-and-resource/module.ens @@ -1,12 +1,17 @@ { target { - loop-and-resource "loop-and-resource.nt", + loop-and-resource { + main "loop-and-resource.nt", + build-option [ + "-fsanitize=address", + ], + }, }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, diff --git a/test/misc/multi-targets/module.ens b/test/misc/multi-targets/module.ens index 01c60e792..2bdbd210b 100644 --- a/test/misc/multi-targets/module.ens +++ b/test/misc/multi-targets/module.ens @@ -1,13 +1,20 @@ { target { - multi-targets "multi-targets.nt", - main "main.nt", + multi-targets { + main "multi-targets.nt", + build-option [ + "-fsanitize=address", + ], + }, + other-target { + main "main.nt", + }, }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, diff --git a/test/misc/mutable/module.ens b/test/misc/mutable/module.ens index 151909981..2fd5f460d 100644 --- a/test/misc/mutable/module.ens +++ b/test/misc/mutable/module.ens @@ -1,14 +1,19 @@ { + target { + mutable { + main "mutable.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - mutable "mutable.nt", - }, } diff --git a/test/misc/nat-fact/module.ens b/test/misc/nat-fact/module.ens index ab8e06e62..13188e782 100644 --- a/test/misc/nat-fact/module.ens +++ b/test/misc/nat-fact/module.ens @@ -1,14 +1,19 @@ { + target { + nat-fact { + main "nat-fact.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - nat-fact "nat-fact.nt", - }, } diff --git a/test/misc/nat-list/module.ens b/test/misc/nat-list/module.ens index bd8d10d16..9a030763d 100644 --- a/test/misc/nat-list/module.ens +++ b/test/misc/nat-list/module.ens @@ -1,14 +1,19 @@ { + target { + nat-list { + main "nat-list.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - nat-list "nat-list.nt", - }, } diff --git a/test/misc/print-float/module.ens b/test/misc/print-float/module.ens index 176c9539f..5452d2826 100644 --- a/test/misc/print-float/module.ens +++ b/test/misc/print-float/module.ens @@ -1,14 +1,19 @@ { + target { + print-float { + main "print-float.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - print-float "print-float.nt", - }, } diff --git a/test/pfds/binary-search-tree/module.ens b/test/pfds/binary-search-tree/module.ens index 03eec3d55..bd4a60900 100644 --- a/test/pfds/binary-search-tree/module.ens +++ b/test/pfds/binary-search-tree/module.ens @@ -1,14 +1,19 @@ { + target { + binary-search-tree { + main "binary-search-tree.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - binary-search-tree "binary-search-tree.nt", - }, } diff --git a/test/pfds/binomial-heap/module.ens b/test/pfds/binomial-heap/module.ens index b4c6a8774..c317cfb25 100644 --- a/test/pfds/binomial-heap/module.ens +++ b/test/pfds/binomial-heap/module.ens @@ -1,14 +1,19 @@ { + target { + binomial-heap { + main "binomial-heap.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - binomial-heap "binomial-heap.nt", - }, } diff --git a/test/pfds/custom-stack/module.ens b/test/pfds/custom-stack/module.ens index 139151370..df7733677 100644 --- a/test/pfds/custom-stack/module.ens +++ b/test/pfds/custom-stack/module.ens @@ -1,14 +1,19 @@ { + target { + custom-stack { + main "custom-stack.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset false, }, }, - target { - custom-stack "custom-stack.nt", - }, } diff --git a/test/pfds/finite-map/module.ens b/test/pfds/finite-map/module.ens index e608e4305..430c18884 100644 --- a/test/pfds/finite-map/module.ens +++ b/test/pfds/finite-map/module.ens @@ -1,14 +1,19 @@ { + target { + finite-map { + main "finite-map.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - finite-map "finite-map.nt", - }, } diff --git a/test/pfds/leftist-heap/module.ens b/test/pfds/leftist-heap/module.ens index f287038e5..b64ce673b 100644 --- a/test/pfds/leftist-heap/module.ens +++ b/test/pfds/leftist-heap/module.ens @@ -1,14 +1,19 @@ { + target { + leftist-heap { + main "leftist-heap.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - leftist-heap "leftist-heap.nt", - }, } diff --git a/test/pfds/naive-queue/module.ens b/test/pfds/naive-queue/module.ens index 716e05c0c..1e17caf62 100644 --- a/test/pfds/naive-queue/module.ens +++ b/test/pfds/naive-queue/module.ens @@ -1,14 +1,19 @@ { + target { + naive-queue { + main "naive-queue.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - naive-queue "naive-queue.nt", - }, } diff --git a/test/pfds/pairing-heap/module.ens b/test/pfds/pairing-heap/module.ens index 7a2cadbf1..e3cf02b11 100644 --- a/test/pfds/pairing-heap/module.ens +++ b/test/pfds/pairing-heap/module.ens @@ -1,14 +1,19 @@ { + target { + pairing-heap { + main "pairing-heap.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - pairing-heap "pairing-heap.nt", - }, } diff --git a/test/pfds/random-access-list/module.ens b/test/pfds/random-access-list/module.ens index 61d43cafb..9a2295a9a 100644 --- a/test/pfds/random-access-list/module.ens +++ b/test/pfds/random-access-list/module.ens @@ -1,14 +1,19 @@ { + target { + random-access-list { + main "random-access-list.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - random-access-list "random-access-list.nt", - }, } diff --git a/test/pfds/red-black-tree/module.ens b/test/pfds/red-black-tree/module.ens index 61df39472..fbac2388d 100644 --- a/test/pfds/red-black-tree/module.ens +++ b/test/pfds/red-black-tree/module.ens @@ -1,14 +1,19 @@ { + target { + red-black-tree { + main "red-black-tree.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - red-black-tree "red-black-tree.nt", - }, } diff --git a/test/pfds/splay-heap/module.ens b/test/pfds/splay-heap/module.ens index 6c76b0c79..032c57253 100644 --- a/test/pfds/splay-heap/module.ens +++ b/test/pfds/splay-heap/module.ens @@ -1,14 +1,19 @@ { + target { + splay-heap { + main "splay-heap.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - splay-heap "splay-heap.nt", - }, } diff --git a/test/pfds/stack/module.ens b/test/pfds/stack/module.ens index 612561977..624b7d006 100644 --- a/test/pfds/stack/module.ens +++ b/test/pfds/stack/module.ens @@ -1,14 +1,19 @@ { + target { + stack { + main "stack.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset false, }, }, - target { - stack "stack.nt", - }, } diff --git a/test/pfds/stream/module.ens b/test/pfds/stream/module.ens index 5060848ca..40bf68f21 100644 --- a/test/pfds/stream/module.ens +++ b/test/pfds/stream/module.ens @@ -1,14 +1,19 @@ { + target { + stream { + main "stream.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset false, }, }, - target { - stream "stream.nt", - }, } diff --git a/test/statement/define/module.ens b/test/statement/define/module.ens index 8b941e152..ad6352be0 100644 --- a/test/statement/define/module.ens +++ b/test/statement/define/module.ens @@ -1,14 +1,19 @@ { + target { + define { + main "define.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - define "define.nt", - }, } diff --git a/test/statement/import-names/module.ens b/test/statement/import-names/module.ens index e9a40f671..1f5007ac6 100644 --- a/test/statement/import-names/module.ens +++ b/test/statement/import-names/module.ens @@ -1,14 +1,19 @@ { + target { + import-names { + main "import-names.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - import-names "import-names.nt", - }, } diff --git a/test/statement/resource-basic/module.ens b/test/statement/resource-basic/module.ens index 390e50276..17b2b502f 100644 --- a/test/statement/resource-basic/module.ens +++ b/test/statement/resource-basic/module.ens @@ -1,14 +1,19 @@ { + target { + resource-basic { + main "resource-basic.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - resource-basic "resource-basic.nt", - }, } diff --git a/test/statement/variant-struct/module.ens b/test/statement/variant-struct/module.ens index 1e7b78a33..f941ffdbc 100644 --- a/test/statement/variant-struct/module.ens +++ b/test/statement/variant-struct/module.ens @@ -1,14 +1,19 @@ { + target { + variant-struct { + main "variant-struct.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - variant-struct "variant-struct.nt", - }, } diff --git a/test/term/flow/module.ens b/test/term/flow/module.ens index a3ae89b66..708dcf3ae 100644 --- a/test/term/flow/module.ens +++ b/test/term/flow/module.ens @@ -1,17 +1,22 @@ { - dependency { - core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", - mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + target { + flow { + main "flow.nt", + build-option [ + "-fsanitize=address", ], - enable-preset true, }, }, prefix { Ext "core.external", }, - target { - flow "flow.nt", + dependency { + core { + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", + mirror [ + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", + ], + enable-preset true, + }, }, } diff --git a/test/term/noema/module.ens b/test/term/noema/module.ens index 82d18b619..61b476d7d 100644 --- a/test/term/noema/module.ens +++ b/test/term/noema/module.ens @@ -1,14 +1,19 @@ { + target { + noema { + main "noema.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - noema "noema.nt", - }, } diff --git a/test/term/pi/module.ens b/test/term/pi/module.ens index 6520860f7..c14c34e7c 100644 --- a/test/term/pi/module.ens +++ b/test/term/pi/module.ens @@ -1,18 +1,23 @@ { - dependency { - core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", - mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + target { + pi { + main "pi.nt", + build-option [ + "-fsanitize=address", ], - enable-preset true, }, }, prefix { Keyword "this.pi-keyword", Term "this.pi-term", }, - target { - pi "pi.nt", + dependency { + core { + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", + mirror [ + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", + ], + enable-preset true, + }, }, } diff --git a/test/term/prim/module.ens b/test/term/prim/module.ens index 75a96bdce..808cb2aac 100644 --- a/test/term/prim/module.ens +++ b/test/term/prim/module.ens @@ -1,14 +1,19 @@ { + target { + prim { + main "prim.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - prim "prim.nt", - }, } diff --git a/test/term/tau/module.ens b/test/term/tau/module.ens index b965f0262..d7074b872 100644 --- a/test/term/tau/module.ens +++ b/test/term/tau/module.ens @@ -1,14 +1,19 @@ { + target { + tau { + main "tau.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - tau "tau.nt", - }, } diff --git a/test/term/unary/module.ens b/test/term/unary/module.ens index 3316eefc0..2d859abc6 100644 --- a/test/term/unary/module.ens +++ b/test/term/unary/module.ens @@ -1,14 +1,19 @@ { + target { + unary { + main "unary.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - unary "unary.nt", - }, } diff --git a/test/term/var/module.ens b/test/term/var/module.ens index 9a4a8db94..586daa9c2 100644 --- a/test/term/var/module.ens +++ b/test/term/var/module.ens @@ -1,17 +1,22 @@ { - dependency { - core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", - mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + target { + var { + main "var.nt", + build-option [ + "-fsanitize=address", ], - enable-preset true, }, }, prefix { V "core.vector", }, - target { - var "var.nt", + dependency { + core { + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", + mirror [ + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", + ], + enable-preset true, + }, }, } diff --git a/test/term/variant/module.ens b/test/term/variant/module.ens index 1727801e8..e4d95687d 100644 --- a/test/term/variant/module.ens +++ b/test/term/variant/module.ens @@ -1,14 +1,19 @@ { + target { + variant { + main "variant.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - variant "variant.nt", - }, } diff --git a/test/term/with/module.ens b/test/term/with/module.ens index ace5b26ea..2cd5b156a 100644 --- a/test/term/with/module.ens +++ b/test/term/with/module.ens @@ -1,14 +1,19 @@ { + target { + with { + main "with.nt", + build-option [ + "-fsanitize=address", + ], + }, + }, dependency { core { - digest "URHaRyVrHOwvulrflTHLa8WNoRwPMl54Hnrk-CG4qFk", + digest "OFjMSEj_TlNUOGBp3-r8HinLhYPsu4xkChTgd91RQt0", mirror [ - "https://github.com/vekatze/neut-core/raw/main/archive/0-48-2.tar.zst", + "https://github.com/vekatze/neut-core/raw/main/archive/0-48-3.tar.zst", ], enable-preset true, }, }, - target { - with "with.nt", - }, } diff --git a/test/test-darwin.sh b/test/test-darwin.sh index 932db6e41..c5a3befe0 100755 --- a/test/test-darwin.sh +++ b/test/test-darwin.sh @@ -4,10 +4,9 @@ base_dir=$(pwd) SCRIPT_DIR=$(cd "$(dirname "$0")"; pwd) LSAN_FILE=$SCRIPT_DIR/lsan.supp -clang_option="-fsanitize=address" cd $SCRIPT_DIR/meta -NEUT_TARGET_ARCH=$TARGET_ARCH NEUT_CLANG=$CLANG_PATH $NEUT build --clang-option $clang_option +NEUT_TARGET_ARCH=$TARGET_ARCH NEUT_CLANG=$CLANG_PATH $NEUT build meta pids=() @@ -21,7 +20,7 @@ for target_dir in "$@"; do ( exit_code=0 NEUT_TARGET_ARCH=$TARGET_ARCH $NEUT clean - output=$(ASAN_OPTIONS=detect_leaks=1 LSAN_OPTIONS=suppressions=$LSAN_FILE NEUT_TARGET_ARCH=$TARGET_ARCH NEUT_CLANG=$CLANG_PATH $NEUT build --clang-option $clang_option --execute 2>&1 > actual) + output=$(ASAN_OPTIONS=detect_leaks=1 LSAN_OPTIONS=suppressions=$LSAN_FILE NEUT_TARGET_ARCH=$TARGET_ARCH NEUT_CLANG=$CLANG_PATH $NEUT build $(basename $i) --execute 2>&1 > actual) last_exit_code=$? if [ $last_exit_code -ne 0 ]; then echo "\033[1;31merror:\033[0m a test failed: $(basename $i)\n$output" diff --git a/test/test-linux-single.sh b/test/test-linux-single.sh index 96ceb2414..0c0005ed0 100755 --- a/test/test-linux-single.sh +++ b/test/test-linux-single.sh @@ -3,10 +3,9 @@ base_dir=$(pwd) SCRIPT_DIR=$(cd "$(dirname "$0")"; pwd) -clang_option="-fsanitize=address" cd $SCRIPT_DIR/meta -NEUT_TARGET_ARCH=$TARGET_ARCH $NEUT build --clang-option $clang_option +NEUT_TARGET_ARCH=$TARGET_ARCH $NEUT build meta pids=() @@ -16,7 +15,7 @@ cd $target_directory echo $(basename $target_directory) exit_code=0 NEUT_TARGET_ARCH=$TARGET_ARCH $NEUT clean -output=$(ASAN_OPTIONS=detect_leaks=1 NEUT_TARGET_ARCH=$TARGET_ARCH $NEUT build --clang-option $clang_option --execute 2>&1 > actual) +output=$(ASAN_OPTIONS=detect_leaks=1 NEUT_TARGET_ARCH=$TARGET_ARCH $NEUT build $(basename $target_directory) --execute 2>&1 > actual) last_exit_code=$? if [ $last_exit_code -ne 0 ]; then printf "\033[1;31merror:\033[0m a test failed: $(basename $target_directory)\n$output\n" diff --git a/test/test-linux.sh b/test/test-linux.sh index 8123cc201..b4a6e139e 100755 --- a/test/test-linux.sh +++ b/test/test-linux.sh @@ -3,10 +3,9 @@ base_dir=$(pwd) SCRIPT_DIR=$(cd "$(dirname "$0")"; pwd) -clang_option="-fsanitize=address" cd $SCRIPT_DIR/meta -NEUT_TARGET_ARCH=$TARGET_ARCH $NEUT build --clang-option $clang_option +NEUT_TARGET_ARCH=$TARGET_ARCH $NEUT build meta pids=() @@ -20,7 +19,7 @@ for target_dir in "$@"; do ( exit_code=0 NEUT_TARGET_ARCH=$TARGET_ARCH $NEUT clean - output=$(ASAN_OPTIONS=detect_leaks=1 NEUT_TARGET_ARCH=$TARGET_ARCH $NEUT build --clang-option $clang_option --execute 2>&1 > actual) + output=$(ASAN_OPTIONS=detect_leaks=1 NEUT_TARGET_ARCH=$TARGET_ARCH $NEUT build $(basename $i) --execute 2>&1 > actual) last_exit_code=$? if [ $last_exit_code -ne 0 ]; then printf "\033[1;31merror:\033[0m a test failed: $(basename $i)\n$output\n"