diff --git a/src/Act/Create.hs b/src/Act/Create.hs index 7c6f530be..d53debbfa 100644 --- a/src/Act/Create.hs +++ b/src/Act/Create.hs @@ -1,7 +1,10 @@ module Act.Create (create) where import Context.App +import Control.Monad import Entity.Config.Create +import Entity.Module (moduleLocation) +import Scene.Check qualified as Check import Scene.Fetch qualified as Fetch import Scene.Initialize qualified as Initialize import Scene.New qualified as New @@ -13,3 +16,5 @@ create cfg = do Initialize.initializeCompilerWithModule newModule New.createNewProject (moduleName cfg) newModule Fetch.insertCoreDependency + Initialize.initializeCompilerWithPath (moduleLocation newModule) (remarkCfg cfg) + void Check.checkAll diff --git a/src/Act/Get.hs b/src/Act/Get.hs index 63b8b83c7..aa0cd4015 100644 --- a/src/Act/Get.hs +++ b/src/Act/Get.hs @@ -1,8 +1,13 @@ module Act.Get (get) where import Context.App +import Context.Env qualified as Env import Context.Path qualified as Path +import Control.Monad import Entity.Config.Get +import Entity.Module +import Scene.Check qualified as Check +import Scene.Clean qualified as Clean import Scene.Fetch qualified as Fetch import Scene.Initialize qualified as Initialize import Prelude hiding (log) @@ -11,4 +16,8 @@ get :: Config -> App () get cfg = do Initialize.initializeCompiler (remarkCfg cfg) Path.ensureNotInDependencyDir + Clean.clean Fetch.insertDependency (moduleAliasText cfg) (moduleURL cfg) + mainModule <- Env.getMainModule + Initialize.initializeCompilerWithPath (moduleLocation mainModule) (remarkCfg cfg) + void Check.checkAll diff --git a/src/Scene/Clean.hs b/src/Scene/Clean.hs index 5d12c2399..65ac19461 100644 --- a/src/Scene/Clean.hs +++ b/src/Scene/Clean.hs @@ -4,13 +4,16 @@ import Context.App import Context.Env qualified as Env import Context.Path qualified as Path import Control.Monad +import Scene.Unravel (unravelModule) import Prelude hiding (log) clean :: App () clean = do mainModule <- Env.getMainModule - buildDir <- Path.getBaseBuildDir mainModule - b <- Path.doesDirExist buildDir - when b $ do - Path.removeDirRecur buildDir - Path.ensureDir buildDir + moduleList <- unravelModule mainModule + forM_ moduleList $ \someModule -> do + baseBuildDir <- Path.getBaseBuildDir someModule + b <- Path.doesDirExist baseBuildDir + when b $ do + Path.removeDirRecur baseBuildDir + Path.ensureDir baseBuildDir diff --git a/src/Scene/Initialize.hs b/src/Scene/Initialize.hs index d28e7f881..b8480227d 100644 --- a/src/Scene/Initialize.hs +++ b/src/Scene/Initialize.hs @@ -1,6 +1,7 @@ module Scene.Initialize ( initializeCompiler, initializeCompilerWithModule, + initializeCompilerWithPath, initializeLogger, initializeForTarget, initializeForSource, @@ -29,6 +30,7 @@ import Context.WeakDefinition qualified as WeakDefinition import Entity.Config.Remark qualified as Remark import Entity.Module import Entity.Source qualified as Source +import Path import Scene.Clarify qualified as Clarify import Scene.Module.Reflect qualified as Module @@ -43,6 +45,12 @@ initializeCompiler cfg = do mainModule <- Module.fromCurrentPath initializeCompilerWithModule mainModule +initializeCompilerWithPath :: Path Abs File -> Remark.Config -> App () +initializeCompilerWithPath path cfg = do + initializeLogger cfg + mainModule <- Module.fromFilePath path + initializeCompilerWithModule mainModule + initializeCompilerWithModule :: Module -> App () initializeCompilerWithModule newModule = do Env.setMainModule newModule diff --git a/src/Scene/Unravel.hs b/src/Scene/Unravel.hs index 4d9dd2d57..bf0fa84f7 100644 --- a/src/Scene/Unravel.hs +++ b/src/Scene/Unravel.hs @@ -3,6 +3,7 @@ module Scene.Unravel unravelFromFile, registerShiftMap, unravel', + unravelModule, ) where @@ -87,7 +88,7 @@ unravel' t source = do registerShiftMap :: App () registerShiftMap = do axis <- newAxis - arrowList <- Env.getMainModule >>= unravelModule axis + arrowList <- Env.getMainModule >>= unravelAntecedentArrow axis cAxis <- newCAxis compressMap cAxis (Map.fromList arrowList) arrowList >>= Antecedent.setMap @@ -105,8 +106,8 @@ data Axis = Axis traceListRef :: IORef [Path Abs File] } -unravelModule :: Axis -> Module -> App [(MID.ModuleID, Module)] -unravelModule axis currentModule = do +unravelAntecedentArrow :: Axis -> Module -> App [(MID.ModuleID, Module)] +unravelAntecedentArrow axis currentModule = do visitMap <- liftIO $ readIORef $ visitMapRef axis path <- Module.getModuleFilePath Nothing (moduleID currentModule) case Map.lookup path visitMap of @@ -121,11 +122,37 @@ unravelModule axis currentModule = do let children = map (MID.Library . dependencyDigest . snd) $ Map.toList $ moduleDependency currentModule arrows <- fmap concat $ forM children $ \moduleID -> do path' <- Module.getModuleFilePath Nothing moduleID - Module.fromFilePath path' >>= unravelModule axis + Module.fromFilePath path' >>= unravelAntecedentArrow axis liftIO $ modifyIORef' (visitMapRef axis) $ Map.insert path VI.Finish liftIO $ modifyIORef' (traceListRef axis) tail return $ getAntecedentArrow currentModule ++ arrows +unravelModule :: Module -> App [Module] +unravelModule currentModule = do + axis <- newAxis + unravelModule' axis currentModule + +unravelModule' :: Axis -> Module -> App [Module] +unravelModule' axis currentModule = do + visitMap <- liftIO $ readIORef $ visitMapRef axis + path <- Module.getModuleFilePath Nothing (moduleID currentModule) + case Map.lookup path visitMap of + Just VI.Active -> do + pathList <- liftIO $ readIORef $ traceListRef axis + raiseCyclicPath path pathList + Just VI.Finish -> + return [] + Nothing -> do + liftIO $ modifyIORef' (visitMapRef axis) $ Map.insert path VI.Active + liftIO $ modifyIORef' (traceListRef axis) $ (:) path + let children = map (MID.Library . dependencyDigest . snd) $ Map.toList $ moduleDependency currentModule + arrows <- fmap concat $ forM children $ \moduleID -> do + path' <- Module.getModuleFilePath Nothing moduleID + Module.fromFilePath path' >>= unravelModule' axis + liftIO $ modifyIORef' (visitMapRef axis) $ Map.insert path VI.Finish + liftIO $ modifyIORef' (traceListRef axis) tail + return $ currentModule : arrows + unravel'' :: Target -> Source.Source -> App (A.ArtifactTime, Seq Source.Source) unravel'' t source = do visitEnv <- Unravel.getVisitEnv diff --git a/test/term/with/source/with.nt b/test/term/with/source/with.nt index 73af6653b..d84dc5e0d 100644 --- a/test/term/with/source/with.nt +++ b/test/term/with/source/with.nt @@ -54,6 +54,7 @@ define test2(): either(int, int) { let _ = k in tmp in + let _ = k in bind _: bool = Right(True) in nop(); let _ = type in