per-target clang configurations

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,
     },

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,
     },

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,
     },

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

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
 

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

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

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

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

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)

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

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

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 {..}

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 ()

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