From 5b495681c67288276d769a9fa1c3037ec0cc121a Mon Sep 17 00:00:00 2001 From: Jonathan Cubides Date: Fri, 6 Jan 2023 17:54:13 +0100 Subject: [PATCH] Compiler output (#1705) Add a global flag `--output-dir to specify where to put the compiler output. --- Makefile | 2 +- app/App.hs | 94 ++++++++++++------- app/Commands/Compile.hs | 41 ++++---- app/Commands/Dev/Asm/Compile.hs | 9 +- app/Commands/Extra/Compile.hs | 55 ++++++----- app/Commands/Repl.hs | 11 ++- app/CommonOptions.hs | 2 +- app/GlobalOptions.hs | 11 +++ app/Main.hs | 10 +- app/Root.hs | 35 +++++-- juvix-stdlib | 2 +- .../FromParsed/Analysis/PathResolver.hs | 9 +- src/Juvix/Compiler/Pipeline/EntryPoint.hs | 9 +- src/Juvix/Compiler/Pipeline/Package.hs | 28 +++--- .../Compiler/Pipeline/Package/Dependency.hs | 5 - src/Juvix/Compiler/Pipeline/Setup.hs | 2 +- src/Juvix/Extra/Paths/Base.hs | 17 ++-- src/Juvix/Extra/Stdlib.hs | 16 ++-- test/Scope/Positive.hs | 2 +- tests/CLI/Commands/compile.test | 4 + 20 files changed, 224 insertions(+), 140 deletions(-) diff --git a/Makefile b/Makefile index 85d870aec..0c4d11a29 100644 --- a/Makefile +++ b/Makefile @@ -166,7 +166,7 @@ STACKTESTFLAGS?=--ta --hide-successes --ta --ansi-tricks=false SHELLTESTFLAGS?=--color --diff -a --hide-successes .PHONY: check -check: +check: clean @${MAKE} build @${MAKE} install @${MAKE} test diff --git a/app/App.hs b/app/App.hs index 7c64209b5..31bd8b492 100644 --- a/app/App.hs +++ b/app/App.hs @@ -15,6 +15,7 @@ data App m a where PrintJuvixError :: JuvixError -> App m () AskInvokeDir :: App m (Path Abs Dir) AskPkgDir :: App m (Path Abs Dir) + AskBuildDir :: App m (Path Abs Dir) AskPackage :: App m Package AskGlobalOptions :: App m GlobalOptions RenderStdOut :: (HasAnsiBackend a, HasTextBackend a) => a -> App m () @@ -24,36 +25,55 @@ data App m a where makeSem ''App -runAppIO :: forall r a. Member (Embed IO) r => GlobalOptions -> Path Abs Dir -> Path Abs Dir -> Package -> Sem (App ': r) a -> Sem r a -runAppIO g invokeDir pkgDir pkg = interpret $ \case - RenderStdOut t - | g ^. globalOnlyErrors -> return () - | otherwise -> embed $ do - sup <- Ansi.hSupportsANSIColor stdout - renderIO (not (g ^. globalNoColors) && sup) t - AskGlobalOptions -> return g - AskPackage -> return pkg - AskInvokeDir -> return invokeDir - AskPkgDir -> return pkgDir - RunPipelineEither input p -> do - entry <- embed (getEntryPoint' invokeDir g pkgDir pkg input) - embed (runIOEither iniState entry p) - Say t - | g ^. globalOnlyErrors -> return () - | otherwise -> embed (putStrLn t) - PrintJuvixError e -> do - printErr e - ExitJuvixError e -> do - printErr e - embed exitFailure - ExitMsg exitCode t -> embed (putStrLn t >> exitWith exitCode) - SayRaw b -> embed (ByteString.putStr b) - where - printErr e = - embed $ hPutStrLn stderr $ run $ runReader (project' @GenericOptions g) $ Error.render (not (g ^. globalNoColors)) (g ^. globalOnlyErrors) e +data RunAppIOArgs = RunAppIOArgs + { _runAppIOArgsGlobalOptions :: GlobalOptions, + _runAppIOArgsInvokeDir :: Path Abs Dir, + _runAppIOArgsBuildDir :: Path Abs Dir, + _runAppIOArgsPkgDir :: Path Abs Dir, + _runAppIOArgsPkg :: Package + } -getEntryPoint' :: Path Abs Dir -> GlobalOptions -> Path Abs Dir -> Package -> AppPath File -> IO EntryPoint -getEntryPoint' invokeDir opts root pkg inputFile = do +runAppIO :: + forall r a. + Member (Embed IO) r => + RunAppIOArgs -> + Sem (App ': r) a -> + Sem r a +runAppIO args@RunAppIOArgs {..} = + interpret $ \case + RenderStdOut t + | _runAppIOArgsGlobalOptions ^. globalOnlyErrors -> return () + | otherwise -> embed $ do + sup <- Ansi.hSupportsANSIColor stdout + renderIO (not (_runAppIOArgsGlobalOptions ^. globalNoColors) && sup) t + AskGlobalOptions -> return _runAppIOArgsGlobalOptions + AskPackage -> return _runAppIOArgsPkg + AskInvokeDir -> return _runAppIOArgsInvokeDir + AskPkgDir -> return _runAppIOArgsPkgDir + AskBuildDir -> return _runAppIOArgsBuildDir + RunPipelineEither input p -> do + entry <- embed (getEntryPoint' args input) + embed (runIOEither iniState entry p) + Say t + | g ^. globalOnlyErrors -> return () + | otherwise -> embed (putStrLn t) + PrintJuvixError e -> do + printErr e + ExitJuvixError e -> do + printErr e + embed exitFailure + ExitMsg exitCode t -> embed (putStrLn t >> exitWith exitCode) + SayRaw b -> embed (ByteString.putStr b) + where + g :: GlobalOptions + g = _runAppIOArgsGlobalOptions + printErr e = + embed $ hPutStrLn stderr $ run $ runReader (project' @GenericOptions g) $ Error.render (not (_runAppIOArgsGlobalOptions ^. globalNoColors)) (g ^. globalOnlyErrors) e + +getEntryPoint' :: RunAppIOArgs -> AppPath File -> IO EntryPoint +getEntryPoint' RunAppIOArgs {..} inputFile = do + let opts = _runAppIOArgsGlobalOptions + root = _runAppIOArgsPkgDir estdin <- if | opts ^. globalStdin -> Just <$> getContents @@ -62,11 +82,12 @@ getEntryPoint' invokeDir opts root pkg inputFile = do EntryPoint { _entryPointRoot = root, _entryPointResolverRoot = root, + _entryPointBuildDir = _runAppIOArgsBuildDir, _entryPointNoTermination = opts ^. globalNoTermination, _entryPointNoPositivity = opts ^. globalNoPositivity, _entryPointNoStdlib = opts ^. globalNoStdlib, - _entryPointPackage = pkg, - _entryPointModulePaths = pure (someBaseToAbs invokeDir (inputFile ^. pathPath)), + _entryPointPackage = _runAppIOArgsPkg, + _entryPointModulePaths = pure (someBaseToAbs _runAppIOArgsInvokeDir (inputFile ^. pathPath)), _entryPointGenericOptions = project opts, _entryPointStdin = estdin } @@ -81,11 +102,12 @@ askGenericOptions = project <$> askGlobalOptions getEntryPoint :: Members '[Embed IO, App] r => AppPath File -> Sem r EntryPoint getEntryPoint inputFile = do - opts <- askGlobalOptions - root <- askPkgDir - pkg <- askPackage - invokeDir <- askInvokeDir - embed (getEntryPoint' invokeDir opts root pkg inputFile) + _runAppIOArgsGlobalOptions <- askGlobalOptions + _runAppIOArgsPkgDir <- askPkgDir + _runAppIOArgsPkg <- askPackage + _runAppIOArgsBuildDir <- askBuildDir + _runAppIOArgsInvokeDir <- askInvokeDir + embed (getEntryPoint' (RunAppIOArgs {..}) inputFile) runPipeline :: Member App r => AppPath File -> Sem PipelineEff a -> Sem r a runPipeline input p = do diff --git a/app/Commands/Compile.hs b/app/Commands/Compile.hs index 16e69db6c..72e61a30b 100644 --- a/app/Commands/Compile.hs +++ b/app/Commands/Compile.hs @@ -6,7 +6,6 @@ import Data.ByteString qualified as BS import Data.FileEmbed qualified as FE import Data.Text.IO qualified as TIO import Juvix.Compiler.Backend.C.Translation.FromInternal qualified as MiniC -import Juvix.Extra.Paths import System.Environment import System.Process qualified as P @@ -21,16 +20,16 @@ runCommand opts@CompileOptions {..} = do inputCFile :: Members '[App] r => Path Abs File -> Sem r (Path Abs File) inputCFile inputFileCompile = do - root <- askPkgDir - return (root juvixBuildDir outputMiniCFile) + buildDir <- askBuildDir + return (buildDir outputMiniCFile) where outputMiniCFile :: Path Rel File outputMiniCFile = replaceExtension' ".c" (filename inputFileCompile) runCompile :: Members '[Embed IO, App] r => Path Abs File -> CompileOptions -> Text -> Sem r (Either Text ()) runCompile inputFileCompile o minic = do - root <- askPkgDir - ensureDir (root juvixBuildDir) + buildDir <- askBuildDir + ensureDir buildDir f <- inputCFile inputFileCompile embed (TIO.writeFile (toFilePath f) minic) prepareRuntime o @@ -52,8 +51,8 @@ prepareRuntime o = mapM_ writeRuntime runtimeProjectDir writeRuntime :: (Path Rel File, BS.ByteString) -> Sem r () writeRuntime (filePath, contents) = do - root <- askPkgDir - embed (BS.writeFile (toFilePath (root juvixBuildDir filePath)) contents) + buildDir <- askBuildDir + embed (BS.writeFile (toFilePath (buildDir filePath)) contents) wasiStandaloneRuntimeDir :: [(Path Rel File, BS.ByteString)] wasiStandaloneRuntimeDir = map (first relFile) $(FE.makeRelativeToProject "c-runtime/wasi-standalone" >>= FE.embedDir) @@ -82,7 +81,8 @@ clangNativeCompile :: clangNativeCompile inputFileCompile o = do inputFile <- getInputFile outputFile <- getOutputFile - runClang (nativeArgs outputFile inputFile) + buildDir <- askBuildDir + runClang (nativeArgs buildDir outputFile inputFile) where getOutputFile :: Sem r (Path Abs File) getOutputFile = case o ^. compileOutputFile of @@ -127,36 +127,36 @@ sysrootEnvVar = msg :: Text msg = "Missing environment variable WASI_SYSROOT_PATH" -commonArgs :: Path Abs File -> [String] -commonArgs wasmOutputFile = +commonArgs :: Path Abs Dir -> Path Abs File -> [String] +commonArgs buildDir wasmOutputFile = [ "-std=c99", "-Oz", "-I", - toFilePath juvixBuildDir, + toFilePath buildDir, "-o", toFilePath wasmOutputFile ] standaloneLibArgs :: Members '[App, Embed IO] r => Path Abs File -> Path Abs File -> Sem r [String] standaloneLibArgs wasmOutputFile inputFile = do - root <- askPkgDir + buildDir <- askBuildDir return $ - commonArgs wasmOutputFile + commonArgs buildDir wasmOutputFile <> [ "--target=wasm32", "-nodefaultlibs", "-nostartfiles", "-Wl,--no-entry", - toFilePath (root juvixBuildDir $(mkRelFile "walloc.c")), + toFilePath (buildDir $(mkRelFile "walloc.c")), toFilePath inputFile ] wasiStandaloneArgs :: Members '[App, Error Text, Embed IO] r => Path Abs File -> Path Abs File -> Sem r [String] wasiStandaloneArgs wasmOutputFile inputFile = do - root <- askPkgDir + buildDir <- askBuildDir com <- wasiCommonArgs wasmOutputFile return $ com - <> [ toFilePath (root juvixBuildDir $(mkRelFile "walloc.c")), + <> [ toFilePath (buildDir $(mkRelFile "walloc.c")), toFilePath inputFile ] @@ -165,15 +165,16 @@ wasiLibcArgs wasmOutputFile inputFile = do com <- wasiCommonArgs wasmOutputFile return $ com <> ["-lc", toFilePath inputFile] -nativeArgs :: Path Abs File -> Path Abs File -> [String] -nativeArgs outputFile inputFile = - commonArgs outputFile <> [toFilePath inputFile] +nativeArgs :: Path Abs Dir -> Path Abs File -> Path Abs File -> [String] +nativeArgs buildDir outputFile inputFile = + commonArgs buildDir outputFile <> [toFilePath inputFile] wasiCommonArgs :: Members '[App, Error Text, Embed IO] r => Path Abs File -> Sem r [String] wasiCommonArgs wasmOutputFile = do sysrootPath <- sysrootEnvVar + buildDir <- askBuildDir return $ - commonArgs wasmOutputFile + commonArgs buildDir wasmOutputFile <> [ "-nodefaultlibs", "--target=wasm32-wasi", "--sysroot", diff --git a/app/Commands/Dev/Asm/Compile.hs b/app/Commands/Dev/Asm/Compile.hs index c6851c3a2..cb560f86f 100644 --- a/app/Commands/Dev/Asm/Compile.hs +++ b/app/Commands/Dev/Asm/Compile.hs @@ -8,7 +8,6 @@ import Juvix.Compiler.Asm.Options qualified as Asm import Juvix.Compiler.Asm.Translation.FromSource qualified as Asm import Juvix.Compiler.Backend qualified as Backend import Juvix.Compiler.Backend.C qualified as C -import Juvix.Extra.Paths runCommand :: forall r. Members '[Embed IO, App] r => AsmCompileOptions -> Sem r () runCommand opts = do @@ -19,8 +18,8 @@ runCommand opts = do Right tab -> case run $ runError $ asmToMiniC asmOpts tab of Left err -> exitJuvixError err Right C.MiniCResult {..} -> do - root <- askPkgDir - ensureDir (root juvixBuildDir) + buildDir <- askBuildDir + ensureDir buildDir cFile <- inputCFile file embed $ TIO.writeFile (toFilePath cFile) _resultCCode Compile.runCommand opts {_compileInputFile = AppPath (Abs cFile) False} @@ -39,8 +38,8 @@ runCommand opts = do inputCFile :: Members '[App] r => Path Abs File -> Sem r (Path Abs File) inputCFile inputFileCompile = do - root <- askPkgDir - return (root juvixBuildDir outputMiniCFile) + buildDir <- askBuildDir + return (buildDir outputMiniCFile) where outputMiniCFile :: Path Rel File outputMiniCFile = replaceExtension' ".c" (filename inputFileCompile) diff --git a/app/Commands/Extra/Compile.hs b/app/Commands/Extra/Compile.hs index de29a01d9..c9c48309d 100644 --- a/app/Commands/Extra/Compile.hs +++ b/app/Commands/Extra/Compile.hs @@ -10,25 +10,29 @@ import System.Process qualified as P runCommand :: forall r. Members '[Embed IO, App] r => CompileOptions -> Sem r () runCommand opts = do - root <- askPkgDir inputFile <- someBaseToAbs' (opts ^. compileInputFile . pathPath) - result <- runCompile root inputFile opts + result <- runCompile inputFile opts case result of Left err -> printFailureExit err _ -> return () -runCompile :: Members '[App, Embed IO] r => Path Abs Dir -> Path Abs File -> CompileOptions -> Sem r (Either Text ()) -runCompile projRoot inputFile o = do - ensureDir (projRoot juvixBuildDir) - ensureDir (projRoot juvixIncludeDir) - prepareRuntime projRoot o +runCompile :: + Members '[App, Embed IO] r => + Path Abs File -> + CompileOptions -> + Sem r (Either Text ()) +runCompile inputFile o = do + buildDir <- askBuildDir + ensureDir buildDir + ensureDir (juvixIncludeDir buildDir) + prepareRuntime buildDir o case o ^. compileTarget of TargetWasm32Wasi -> runError (clangWasmWasiCompile inputFile o) TargetNative64 -> runError (clangNativeCompile inputFile o) TargetC -> return $ Right () prepareRuntime :: forall r. Members '[App, Embed IO] r => Path Abs Dir -> CompileOptions -> Sem r () -prepareRuntime projRoot o = do +prepareRuntime buildDir o = do mapM_ writeHeader headersDir case o ^. compileTarget of TargetWasm32Wasi | o ^. compileDebug -> writeRuntime wasiDebugRuntime @@ -52,15 +56,18 @@ prepareRuntime projRoot o = do writeRuntime :: BS.ByteString -> Sem r () writeRuntime = embed - . BS.writeFile (toFilePath (projRoot juvixBuildDir $(mkRelFile "libjuvix.a"))) + . BS.writeFile (toFilePath (buildDir $(mkRelFile "libjuvix.a"))) headersDir :: [(Path Rel File, BS.ByteString)] headersDir = map (first relFile) $(FE.makeRelativeToProject "runtime/include" >>= FE.embedDir) + includeDir :: Path Abs Dir + includeDir = juvixIncludeDir buildDir + writeHeader :: (Path Rel File, BS.ByteString) -> Sem r () writeHeader (filePath, contents) = embed $ do - ensureDir (projRoot juvixIncludeDir parent filePath) - BS.writeFile (toFilePath (projRoot juvixIncludeDir filePath)) contents + ensureDir (includeDir parent filePath) + BS.writeFile (toFilePath (includeDir filePath)) contents clangNativeCompile :: forall r. @@ -70,7 +77,8 @@ clangNativeCompile :: Sem r () clangNativeCompile inputFile o = do outputFile' <- outputFile - runClang (native64Args o outputFile' inputFile) + buildDir <- askBuildDir + runClang (native64Args buildDir o outputFile' inputFile) where outputFile :: Sem r (Path Abs File) outputFile = maybe (return defaultOutputFile) someBaseToAbs' (o ^? compileOutputFile . _Just . pathPath) @@ -92,7 +100,8 @@ clangWasmWasiCompile inputFile o = clangArgs >>= runClang clangArgs :: Sem r [String] clangArgs = do outputFile' <- outputFile - wasiArgs o outputFile' inputFile <$> sysrootEnvVar + buildDir <- askBuildDir + wasiArgs buildDir o outputFile' inputFile <$> sysrootEnvVar outputFile :: Sem r (Path Abs File) outputFile = case o ^? compileOutputFile . _Just . pathPath of @@ -116,8 +125,8 @@ clangWasmWasiCompile inputFile o = clangArgs >>= runClang msg :: Text msg = "Missing environment variable WASI_SYSROOT_PATH" -commonArgs :: CompileOptions -> Path Abs File -> [String] -commonArgs o outputFile = +commonArgs :: Path Abs Dir -> CompileOptions -> Path Abs File -> [String] +commonArgs buildDir o outputFile = ["-E" | o ^. compilePreprocess] <> ["-S" | o ^. compileAssembly] <> (if o ^. compileDebug then ["-DDEBUG"] else ["-DNDEBUG"]) @@ -128,21 +137,21 @@ commonArgs o outputFile = "-Werror", "-std=c11", "-I", - toFilePath juvixIncludeDir, + toFilePath (juvixIncludeDir buildDir), "-o", toFilePath outputFile ] <> ( if | not (o ^. compilePreprocess || o ^. compileAssembly) -> [ "-L", - toFilePath juvixBuildDir + toFilePath buildDir ] | otherwise -> [] ) -native64Args :: CompileOptions -> Path Abs File -> Path Abs File -> [String] -native64Args o outputFile inputFile = - commonArgs o outputFile +native64Args :: Path Abs Dir -> CompileOptions -> Path Abs File -> Path Abs File -> [String] +native64Args buildDir o outputFile inputFile = + commonArgs buildDir o outputFile <> [ "-DARCH_NATIVE64", "-DAPI_LIBC", "-m64", @@ -155,9 +164,9 @@ native64Args o outputFile inputFile = | otherwise -> [] ) -wasiArgs :: CompileOptions -> Path Abs File -> Path Abs File -> Path Abs Dir -> [String] -wasiArgs o outputFile inputFile sysrootPath = - commonArgs o outputFile +wasiArgs :: Path Abs Dir -> CompileOptions -> Path Abs File -> Path Abs File -> Path Abs Dir -> [String] +wasiArgs buildDir o outputFile inputFile sysrootPath = + commonArgs buildDir o outputFile <> [ "-DARCH_WASM32", "-DAPI_WASI", "-Os", diff --git a/app/Commands/Repl.hs b/app/Commands/Repl.hs index 275126249..82ba7248d 100644 --- a/app/Commands/Repl.hs +++ b/app/Commands/Repl.hs @@ -76,6 +76,7 @@ welcomeMsg = liftIO (putStrLn [i|Juvix REPL version #{versionTag}: https://juvix runCommand :: Members '[Embed IO, App] r => ReplOptions -> Sem r () runCommand opts = do root <- askPkgDir + buildDir <- askBuildDir package <- askPackage let getReplEntryPoint :: SomeBase File -> Repl EntryPoint getReplEntryPoint inputFile = do @@ -84,6 +85,7 @@ runCommand opts = do return $ EntryPoint { _entryPointRoot = root, + _entryPointBuildDir = buildDir, _entryPointResolverRoot = root, _entryPointNoTermination = gopts ^. globalNoTermination, _entryPointNoPositivity = gopts ^. globalNoPositivity, @@ -292,15 +294,18 @@ defaultPreludeEntryPoint :: Repl EntryPoint defaultPreludeEntryPoint = do opts <- State.gets (^. replStateGlobalOptions) root <- State.gets (^. replStatePkgDir) + let buildDir = rootBuildDir root + defStdlibDir = defaultStdlibPath buildDir return $ EntryPoint { _entryPointRoot = root, - _entryPointResolverRoot = defaultStdlibPath root, + _entryPointResolverRoot = defStdlibDir, + _entryPointBuildDir = buildDir, _entryPointNoTermination = opts ^. globalNoTermination, _entryPointNoPositivity = opts ^. globalNoPositivity, _entryPointNoStdlib = opts ^. globalNoStdlib, - _entryPointPackage = defaultPackage root, - _entryPointModulePaths = pure (defaultStdlibPath root preludePath), + _entryPointPackage = defaultPackage root buildDir, + _entryPointModulePaths = pure (defStdlibDir preludePath), _entryPointGenericOptions = project opts, _entryPointStdin = Nothing } diff --git a/app/CommonOptions.hs b/app/CommonOptions.hs index e51949b79..43055339b 100644 --- a/app/CommonOptions.hs +++ b/app/CommonOptions.hs @@ -18,7 +18,7 @@ data AppPath f = AppPath { _pathPath :: SomeBase f, _pathIsInput :: Bool } - deriving stock (Data) + deriving stock (Data, Eq) makeLenses ''AppPath diff --git a/app/GlobalOptions.hs b/app/GlobalOptions.hs index 1b8f9cb2d..892b8d824 100644 --- a/app/GlobalOptions.hs +++ b/app/GlobalOptions.hs @@ -7,10 +7,12 @@ import CommonOptions import Juvix.Compiler.Abstract.Pretty.Options qualified as Abstract import Juvix.Compiler.Internal.Pretty.Options qualified as Internal import Juvix.Data.Error.GenericError qualified as E +import Juvix.Extra.Paths data GlobalOptions = GlobalOptions { _globalNoColors :: Bool, _globalShowNameIds :: Bool, + _globalBuildDir :: Maybe (AppPath Dir), _globalOnlyErrors :: Bool, _globalNoApe :: Bool, _globalStdin :: Bool, @@ -49,6 +51,7 @@ defaultGlobalOptions = _globalOnlyErrors = False, _globalNoApe = False, _globalNoTermination = False, + _globalBuildDir = Nothing, _globalStdin = False, _globalNoPositivity = False, _globalNoStdlib = False @@ -68,6 +71,14 @@ parseGlobalFlags = do ( long "show-name-ids" <> help "Show the unique number of each identifier when pretty printing" ) + _globalBuildDir <- + optional + ( parseGenericOutputDir + ( value (Rel relBuildDir) + <> showDefault + <> help "directory for compiler output" + ) + ) _globalNoApe <- switch ( long "no-format" diff --git a/app/Main.hs b/app/Main.hs index b0014fff8..035279afd 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,8 +8,8 @@ import TopCommand.Options main :: IO () main = do - let p = prefs showHelpOnEmpty - cwd <- getCurrentDir - (global, cli) <- customExecParser p descr - (root, pkg) <- findRootAndChangeDir (topCommandInputFile cli) - runM (runAppIO global cwd root pkg (runTopCommand cli)) + let parserPreferences = prefs showHelpOnEmpty + _runAppIOArgsInvokeDir <- getCurrentDir + (_runAppIOArgsGlobalOptions, cli) <- customExecParser parserPreferences descr + (_runAppIOArgsPkgDir, _runAppIOArgsPkg, _runAppIOArgsBuildDir) <- findRootAndChangeDir (topCommandInputFile cli) _runAppIOArgsGlobalOptions _runAppIOArgsInvokeDir + runM (runAppIO (RunAppIOArgs {..}) (runTopCommand cli)) diff --git a/app/Root.hs b/app/Root.hs index bbfa82959..3d0f8e289 100644 --- a/app/Root.hs +++ b/app/Root.hs @@ -1,13 +1,22 @@ module Root where +import CommonOptions import Control.Exception qualified as IO import Data.ByteString qualified as ByteString +import GlobalOptions import Juvix.Compiler.Pipeline import Juvix.Extra.Paths qualified as Paths -import Juvix.Prelude -findRootAndChangeDir :: Maybe (SomeBase File) -> IO (Path Abs Dir, Package) -findRootAndChangeDir minputFile = do +type RootDir = Path Abs Dir + +type BuildDir = Path Abs Dir + +findRootAndChangeDir :: + Maybe (SomeBase File) -> + GlobalOptions -> + Path Abs Dir -> + IO (RootDir, Package, BuildDir) +findRootAndChangeDir minputFile gopts invokeDir = do whenJust minputFile $ \case Abs d -> setCurrentDir (parent d) Rel d -> setCurrentDir (parent d) @@ -22,18 +31,28 @@ findRootAndChangeDir minputFile = do possiblePaths :: Path Abs Dir -> [Path Abs Dir] possiblePaths p = p : toList (parents p) - go :: IO (Path Abs Dir, Package) + go :: IO (RootDir, Package, BuildDir) go = do cwd <- getCurrentDir l <- findFile (possiblePaths cwd) Paths.juvixYamlFile case l of - Nothing -> return (cwd, defaultPackage cwd) + Nothing -> do + let buildDir = getBuildDir gopts invokeDir cwd + return (cwd, defaultPackage cwd buildDir, buildDir) Just yamlPath -> do bs <- ByteString.readFile (toFilePath yamlPath) let isEmpty = ByteString.null bs root = parent yamlPath + buildDir = getBuildDir gopts invokeDir root pkg <- if - | isEmpty -> return (defaultPackage root) - | otherwise -> readPackageIO root - return (root, pkg) + | isEmpty -> return (defaultPackage root buildDir) + | otherwise -> readPackageIO root buildDir + return (root, pkg, buildDir) + +getBuildDir :: GlobalOptions -> Path Abs Dir -> Path Abs Dir -> Path Abs Dir +getBuildDir g invokeDir pkgDir = case g ^. globalBuildDir of + Nothing -> Paths.rootBuildDir pkgDir + Just (AppPath p _) -> case p of + Rel r -> invokeDir r + Abs a -> a diff --git a/juvix-stdlib b/juvix-stdlib index 90ed5b726..ec28dc811 160000 --- a/juvix-stdlib +++ b/juvix-stdlib @@ -1 +1 @@ -Subproject commit 90ed5b7266cea6c30a99cb003beff8b10f21a70e +Subproject commit ec28dc811eae65a86d820991a88b66c0ce9d4ceb diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/PathResolver.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/PathResolver.hs index a37b967a8..a42c00cfd 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/PathResolver.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/PathResolver.hs @@ -22,6 +22,7 @@ import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.PathResolver.Base import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.PathResolver.Error import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.PathResolver.PackageInfo import Juvix.Compiler.Pipeline.EntryPoint +import Juvix.Extra.Paths import Juvix.Extra.Stdlib (ensureStdlib) import Juvix.Prelude @@ -65,9 +66,10 @@ mkPackageInfo :: Path Abs Dir -> Sem r PackageInfo mkPackageInfo mpackageEntry _packageRoot = do - _packagePackage <- maybe (readPackage _packageRoot) (return . (^. entryPointPackage)) mpackageEntry + let buildDir = maybe (rootBuildDir _packageRoot) (^. entryPointBuildDir) mpackageEntry + _packagePackage <- maybe (readPackage _packageRoot buildDir) (return . (^. entryPointPackage)) mpackageEntry let deps :: [Dependency] = _packagePackage ^. packageDependencies - ensureStdlib _packageRoot deps + ensureStdlib buildDir deps files :: [Path Rel File] <- map (fromJust . stripProperPrefix _packageRoot) <$> walkDirRelAccum juvixAccum _packageRoot [] let _packageRelativeFiles = HashSet.fromList files _packageAvailableRoots = @@ -171,7 +173,8 @@ evalPathResolver' :: Members '[Files, Error Text] r => ResolverState -> Path Abs evalPathResolver' st root = fmap snd . runPathResolver' st root runPathResolver' :: Members '[Files, Error Text] r => ResolverState -> Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a) -runPathResolver' st root = runState st . runReader (ResolverEnv root) . re +runPathResolver' st root x = do + runState st (runReader (ResolverEnv root) (re x)) runPathResolver :: Members '[Files, Error Text] r => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a) runPathResolver = runPathResolver' iniResolverState diff --git a/src/Juvix/Compiler/Pipeline/EntryPoint.hs b/src/Juvix/Compiler/Pipeline/EntryPoint.hs index 5f5ae4f40..565b5fd72 100644 --- a/src/Juvix/Compiler/Pipeline/EntryPoint.hs +++ b/src/Juvix/Compiler/Pipeline/EntryPoint.hs @@ -5,14 +5,16 @@ module Juvix.Compiler.Pipeline.EntryPoint where import Juvix.Compiler.Pipeline.Package +import Juvix.Extra.Paths import Juvix.Prelude -- | The head of _entryModulePaths is assumed to be the Main module data EntryPoint = EntryPoint { _entryPointRoot :: Path Abs Dir, -- | initial root for the path resolver. Usually it should be equal to - -- _entryPointRoot. Used only for the command `juvix repl`. + -- _entryPointRoot. It only differs for `juvix repl`. _entryPointResolverRoot :: Path Abs Dir, + _entryPointBuildDir :: Path Abs Dir, _entryPointNoTermination :: Bool, _entryPointNoPositivity :: Bool, _entryPointNoStdlib :: Bool, @@ -30,14 +32,17 @@ defaultEntryPoint root mainFile = EntryPoint { _entryPointRoot = root, _entryPointResolverRoot = root, + _entryPointBuildDir = buildDir, _entryPointNoTermination = False, _entryPointNoPositivity = False, _entryPointNoStdlib = False, _entryPointStdin = Nothing, - _entryPointPackage = defaultPackage root, + _entryPointPackage = defaultPackage root buildDir, _entryPointGenericOptions = defaultGenericOptions, _entryPointModulePaths = pure mainFile } + where + buildDir = rootBuildDir root mainModulePath :: Lens' EntryPoint (Path Abs File) mainModulePath = entryPointModulePaths . _head1 diff --git a/src/Juvix/Compiler/Pipeline/Package.hs b/src/Juvix/Compiler/Pipeline/Package.hs index d4e072b76..0c425d83b 100644 --- a/src/Juvix/Compiler/Pipeline/Package.hs +++ b/src/Juvix/Compiler/Pipeline/Package.hs @@ -92,8 +92,8 @@ rawDefaultPackage = } -- | Has the implicit stdlib dependency -defaultPackage :: Path Abs Dir -> Package -defaultPackage r = fromRight impossible . run . runError @Text . processPackage r $ rawDefaultPackage +defaultPackage :: Path Abs Dir -> Path Abs Dir -> Package +defaultPackage r buildDir = fromRight impossible . run . runError @Text . processPackage r buildDir $ rawDefaultPackage -- | Has no dependencies emptyPackage :: Package @@ -112,11 +112,12 @@ rawPackage pkg = _packageDependencies = Just (map rawDependency (pkg ^. packageDependencies)) } -processPackage :: forall r. Members '[Error Text] r => Path Abs Dir -> Package' 'Raw -> Sem r Package -processPackage dir pkg = do +processPackage :: forall r. Members '[Error Text] r => Path Abs Dir -> Path Abs Dir -> Package' 'Raw -> Sem r Package +processPackage dir buildDir pkg = do let _packageName = fromMaybe defaultPackageName (pkg ^. packageName) + stdlib = Dependency (Abs (juvixStdlibDir buildDir)) _packageDependencies = - let rawDeps :: [RawDependency] = fromMaybe [stdlibDefaultDep] (pkg ^. packageDependencies) + let rawDeps :: [RawDependency] = fromMaybe [stdlib] (pkg ^. packageDependencies) in map (processDependency dir) rawDeps _packageVersion <- getVersion return Package {..} @@ -135,17 +136,22 @@ defaultVersion :: SemVer defaultVersion = SemVer 0 0 0 [] Nothing -- | given some directory d it tries to read the file d/juvix.yaml and parse its contents -readPackage :: forall r. Members '[Files, Error Text] r => Path Abs Dir -> Sem r Package -readPackage adir = do +readPackage :: + forall r. + Members '[Files, Error Text] r => + Path Abs Dir -> + Path Abs Dir -> + Sem r Package +readPackage adir buildDir = do bs <- readFileBS' yamlPath - either (throw . pack . prettyPrintParseException) (processPackage adir) (decodeEither' bs) + either (throw . pack . prettyPrintParseException) (processPackage adir buildDir) (decodeEither' bs) where yamlPath = adir juvixYamlFile -readPackageIO :: Path Abs Dir -> IO Package -readPackageIO dir = do +readPackageIO :: Path Abs Dir -> Path Abs Dir -> IO Package +readPackageIO dir buildDir = do let x :: Sem '[Error Text, Files, Embed IO] Package - x = readPackage dir + x = readPackage dir buildDir m <- runM $ runError $ runFilesIO (runError x) case m of Left err -> runM (runReader defaultGenericOptions (printErrorAnsiSafe err)) >> exitFailure diff --git a/src/Juvix/Compiler/Pipeline/Package/Dependency.hs b/src/Juvix/Compiler/Pipeline/Package/Dependency.hs index 9496c7005..3164c79aa 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Dependency.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Dependency.hs @@ -3,7 +3,6 @@ module Juvix.Compiler.Pipeline.Package.Dependency Dependency, Dependency' (..), processDependency, - stdlibDefaultDep, dependencyPath, rawDependency, ) @@ -13,7 +12,6 @@ where import Data.Aeson.BetterErrors import Data.Kind qualified as GHC import Data.Yaml -import Juvix.Extra.Paths import Juvix.Prelude type PathType :: IsProcessed -> GHC.Type @@ -59,7 +57,4 @@ processDependency r (Dependency p) = case p of Rel a -> Dependency (r a) Abs a -> Dependency a -stdlibDefaultDep :: RawDependency -stdlibDefaultDep = Dependency (Rel juvixStdlibDir) - makeLenses ''Dependency' diff --git a/src/Juvix/Compiler/Pipeline/Setup.hs b/src/Juvix/Compiler/Pipeline/Setup.hs index 031f3e5e6..864be310f 100644 --- a/src/Juvix/Compiler/Pipeline/Setup.hs +++ b/src/Juvix/Compiler/Pipeline/Setup.hs @@ -29,6 +29,6 @@ stdlibDep = Dependency <$> getRoot getRoot = do e <- ask let d :: Path Abs Dir - d = defaultStdlibPath (e ^. entryPointRoot) + d = defaultStdlibPath (e ^. entryPointBuildDir) runReader d updateStdlib return d diff --git a/src/Juvix/Extra/Paths/Base.hs b/src/Juvix/Extra/Paths/Base.hs index 6f79bf25b..31b25b078 100644 --- a/src/Juvix/Extra/Paths/Base.hs +++ b/src/Juvix/Extra/Paths/Base.hs @@ -19,17 +19,20 @@ stdlibDir = FE.makeRelativeToProject "juvix-stdlib" >>= FE.embedDir juvixYamlFile :: Path Rel File juvixYamlFile = $(mkRelFile "juvix.yaml") -juvixBuildDir :: Path Rel Dir -juvixBuildDir = $(mkRelDir ".juvix-build") +relBuildDir :: Path Rel Dir +relBuildDir = $(mkRelDir ".juvix-build") -juvixIncludeDir :: Path Rel Dir -juvixIncludeDir = juvixBuildDir $(mkRelDir "include") +rootBuildDir :: Path Abs Dir -> Path Abs Dir +rootBuildDir root = root relBuildDir -juvixStdlibDir :: Path Rel Dir -juvixStdlibDir = juvixBuildDir $(mkRelDir "stdlib") +juvixIncludeDir :: Path Abs Dir -> Path Abs Dir +juvixIncludeDir buildDir = buildDir $(mkRelDir "include") + +juvixStdlibDir :: Path Abs Dir -> Path Abs Dir +juvixStdlibDir buildDir = buildDir $(mkRelDir "stdlib") preludePath :: Path Rel File preludePath = $(mkRelFile "Stdlib/Prelude.juvix") defaultStdlibPath :: Path Abs Dir -> Path Abs Dir -defaultStdlibPath root = root juvixStdlibDir +defaultStdlibPath buildDir = buildDir $(mkRelDir "stdlib") diff --git a/src/Juvix/Extra/Stdlib.hs b/src/Juvix/Extra/Stdlib.hs index a6812882d..f95467b20 100644 --- a/src/Juvix/Extra/Stdlib.hs +++ b/src/Juvix/Extra/Stdlib.hs @@ -24,15 +24,17 @@ stdlibFiles = mapMaybe helper $(stdlibDir) isYamlFile = (== juvixYamlFile) ensureStdlib :: Members '[Files] r => Path Abs Dir -> [Dependency] -> Sem r () -ensureStdlib pkgRoot deps = whenJust (firstJust isStdLib deps) $ \stdlibRoot -> - runReader stdlibRoot updateStdlib +ensureStdlib buildDir deps = + whenJust (firstJust isStdLib deps) $ \stdlibRoot -> + runReader stdlibRoot updateStdlib where + stdLibBuildDir :: Path Abs Dir + stdLibBuildDir = juvixStdlibDir buildDir + isStdLib :: Dependency -> Maybe (Path Abs Dir) - isStdLib dep = do - case stripProperPrefix pkgRoot (dep ^. dependencyPath) of - Just p - | p == juvixStdlibDir -> Just (dep ^. dependencyPath) - _ -> Nothing + isStdLib dep + | dep == Dependency stdLibBuildDir = Just stdLibBuildDir + | otherwise = Nothing writeStdlib :: forall r. Members '[Reader StdlibRoot, Files] r => Sem r () writeStdlib = do diff --git a/test/Scope/Positive.hs b/test/Scope/Positive.hs index 11315aa1b..aaa1ac863 100644 --- a/test/Scope/Positive.hs +++ b/test/Scope/Positive.hs @@ -47,7 +47,7 @@ testDescr PosTest {..} = { _testName = _name, _testRoot = tRoot, _testAssertion = Steps $ \step -> do - pkg <- readPackageIO tRoot + pkg <- readPackageIO tRoot (rootBuildDir tRoot) let entryPoint = entryPointFromPackage tRoot file' pkg runHelper :: HashMap (Path Abs File) Text -> Sem Pipe a -> IO (ResolverState, a) runHelper files = diff --git a/tests/CLI/Commands/compile.test b/tests/CLI/Commands/compile.test index 0b13ec870..878c07547 100644 --- a/tests/CLI/Commands/compile.test +++ b/tests/CLI/Commands/compile.test @@ -10,3 +10,7 @@ $ cd tests/positive/MiniC/HelloWorld && juvix compile Input.juvix -o hello.wasm $ cd examples/milestone/HelloWorld && juvix compile -t native HelloWorld.juvix && ./HelloWorld hello world! >= 0 + +$ temp=$(mktemp -d) && cd examples/milestone/HelloWorld && juvix compile HelloWorld.juvix --output-dir "$temp" && find "$temp"| wc -l && rm -rf "$temp" +> /\s*([2-9]|[1-9][0-9]+)/ +>= 0