Skip to content

Commit

Permalink
Support basic dependencies (#1622)
Browse files Browse the repository at this point in the history
  • Loading branch information
@janmasrovira
janmasrovira authored Dec 20, 2022
1 parent 445376e commit af63c36
Show file tree
Hide file tree
Showing 137 changed files with 2,913 additions and 1,902 deletions.
40 changes: 24 additions & 16 deletions app/App.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,28 +13,30 @@ data App m a where
ExitMsg :: ExitCode -> Text -> App m a
ExitJuvixError :: JuvixError -> App m a
PrintJuvixError :: JuvixError -> App m ()
AskRoot :: App m FilePath
AskInvokeDir :: App m (Path Abs Dir)
AskPkgDir :: App m (Path Abs Dir)
AskPackage :: App m Package
AskGlobalOptions :: App m GlobalOptions
RenderStdOut :: (HasAnsiBackend a, HasTextBackend a) => a -> App m ()
RunPipelineEither :: Path -> Sem PipelineEff a -> App m (Either JuvixError (BuiltinsState, a))
RunPipelineEither :: AppPath File -> Sem PipelineEff a -> App m (Either JuvixError (Artifacts, a))
Say :: Text -> App m ()
Raw :: ByteString -> App m ()
SayRaw :: ByteString -> App m ()

makeSem ''App

runAppIO :: forall r a. Member (Embed IO) r => GlobalOptions -> FilePath -> Package -> Sem (App ': r) a -> Sem r a
runAppIO g root pkg = interpret $ \case
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
AskRoot -> return root
AskInvokeDir -> return invokeDir
AskPkgDir -> return pkgDir
RunPipelineEither input p -> do
entry <- embed (getEntryPoint' g root pkg input)
entry <- embed (getEntryPoint' invokeDir g pkgDir pkg input)
embed (runIOEither iniState entry p)
Say t
| g ^. globalOnlyErrors -> return ()
Expand All @@ -45,41 +47,47 @@ runAppIO g root pkg = interpret $ \case
printErr e
embed exitFailure
ExitMsg exitCode t -> embed (putStrLn t >> exitWith exitCode)
Raw b -> embed (ByteString.putStr b)
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

getEntryPoint' :: GlobalOptions -> FilePath -> Package -> Path -> IO EntryPoint
getEntryPoint' opts root pkg inputFile = do
getEntryPoint' :: Path Abs Dir -> GlobalOptions -> Path Abs Dir -> Package -> AppPath File -> IO EntryPoint
getEntryPoint' invokeDir opts root pkg inputFile = do
estdin <-
if
| opts ^. globalStdin -> Just <$> getContents
| otherwise -> return Nothing
return
EntryPoint
{ _entryPointRoot = root,
_entryPointResolverRoot = root,
_entryPointNoTermination = opts ^. globalNoTermination,
_entryPointNoPositivity = opts ^. globalNoPositivity,
_entryPointNoStdlib = opts ^. globalNoStdlib,
_entryPointStdlibPath = opts ^. globalStdlibPath,
_entryPointPackage = pkg,
_entryPointModulePaths = pure (inputFile ^. pathPath),
_entryPointModulePaths = pure (someBaseToAbs invokeDir (inputFile ^. pathPath)),
_entryPointGenericOptions = project opts,
_entryPointStdin = estdin
}

someBaseToAbs' :: Members '[App] r => SomeBase a -> Sem r (Path Abs a)
someBaseToAbs' f = do
r <- askInvokeDir
return (someBaseToAbs r f)

askGenericOptions :: Members '[App] r => Sem r GenericOptions
askGenericOptions = project <$> askGlobalOptions

getEntryPoint :: Members '[Embed IO, App] r => Path -> Sem r EntryPoint
getEntryPoint :: Members '[Embed IO, App] r => AppPath File -> Sem r EntryPoint
getEntryPoint inputFile = do
opts <- askGlobalOptions
root <- askRoot
root <- askPkgDir
pkg <- askPackage
embed (getEntryPoint' opts root pkg inputFile)
invokeDir <- askInvokeDir
embed (getEntryPoint' invokeDir opts root pkg inputFile)

runPipeline :: Member App r => Path -> Sem PipelineEff a -> Sem r a
runPipeline :: Member App r => AppPath File -> Sem PipelineEff a -> Sem r a
runPipeline input p = do
r <- runPipelineEither input p
case r of
Expand Down
239 changes: 129 additions & 110 deletions app/Commands/Compile.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,154 +12,173 @@ import System.Process qualified as P

runCommand :: Members '[Embed IO, App] r => CompileOptions -> Sem r ()
runCommand opts@CompileOptions {..} = do
root <- askRoot
miniC <- (^. MiniC.resultCCode) <$> runPipeline _compileInputFile upToMiniC
let inputFile = _compileInputFile ^. pathPath
result <- embed (runCompile root inputFile opts miniC)
inputFile <- someBaseToAbs' (_compileInputFile ^. pathPath)
result <- runCompile inputFile opts miniC
case result of
Left err -> printFailureExit err
_ -> return ()

inputCFile :: FilePath -> FilePath -> FilePath
inputCFile projRoot inputFileCompile =
projRoot </> juvixBuildDir </> outputMiniCFile
inputCFile :: Members '[App] r => Path Abs File -> Sem r (Path Abs File)
inputCFile inputFileCompile = do
root <- askPkgDir
return (root <//> juvixBuildDir <//> outputMiniCFile)
where
outputMiniCFile :: FilePath
outputMiniCFile = takeBaseName inputFileCompile <> ".c"

runCompile :: FilePath -> FilePath -> CompileOptions -> Text -> IO (Either Text ())
runCompile projRoot inputFileCompile o minic = do
createDirectoryIfMissing True (projRoot </> juvixBuildDir)
TIO.writeFile (inputCFile projRoot inputFileCompile) minic
prepareRuntime projRoot o
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)
f <- inputCFile inputFileCompile
embed (TIO.writeFile (toFilePath f) minic)
prepareRuntime o
case o ^. compileTarget of
TargetWasm -> runM (runError (clangCompile projRoot inputFileCompile o))
TargetWasm -> runError (clangCompile inputFileCompile o)
TargetC -> return (Right ())
TargetNative -> runM (runError (clangNativeCompile projRoot inputFileCompile o))
TargetNative -> runError (clangNativeCompile inputFileCompile o)

prepareRuntime :: FilePath -> CompileOptions -> IO ()
prepareRuntime projRoot o = do
mapM_ writeRuntime runtimeProjectDir
prepareRuntime :: forall r. Members '[Embed IO, App] r => CompileOptions -> Sem r ()
prepareRuntime o = mapM_ writeRuntime runtimeProjectDir
where
wasiStandaloneRuntimeDir :: [(FilePath, BS.ByteString)]
wasiStandaloneRuntimeDir = $(FE.makeRelativeToProject "c-runtime/wasi-standalone" >>= FE.embedDir)

standaloneRuntimeDir :: [(FilePath, BS.ByteString)]
standaloneRuntimeDir = $(FE.makeRelativeToProject "c-runtime/standalone" >>= FE.embedDir)

wasiLibCRuntimeDir :: [(FilePath, BS.ByteString)]
wasiLibCRuntimeDir = $(FE.makeRelativeToProject "c-runtime/wasi-libc" >>= FE.embedDir)

builtinCRuntimeDir :: [(FilePath, BS.ByteString)]
builtinCRuntimeDir = $(FE.makeRelativeToProject "c-runtime/builtins" >>= FE.embedDir)

wallocDir :: [(FilePath, BS.ByteString)]
wallocDir = $(FE.makeRelativeToProject "c-runtime/walloc" >>= FE.embedDir)

libcRuntime :: [(FilePath, BS.ByteString)]
libcRuntime = wasiLibCRuntimeDir <> builtinCRuntimeDir

runtimeProjectDir :: [(FilePath, BS.ByteString)]
runtimeProjectDir :: [(Path Rel File, BS.ByteString)]
runtimeProjectDir = case o ^. compileTarget of
TargetNative -> libcRuntime
_ -> case o ^. compileRuntime of
RuntimeWasiStandalone -> wasiStandaloneRuntimeDir <> builtinCRuntimeDir <> wallocDir
RuntimeWasiLibC -> libcRuntime
RuntimeStandalone -> standaloneRuntimeDir <> builtinCRuntimeDir <> wallocDir

writeRuntime :: (FilePath, BS.ByteString) -> IO ()
writeRuntime (filePath, contents) =
BS.writeFile (projRoot </> juvixBuildDir </> takeFileName filePath) contents
writeRuntime :: (Path Rel File, BS.ByteString) -> Sem r ()
writeRuntime (filePath, contents) = do
root <- askPkgDir
embed (BS.writeFile (toFilePath (root <//> juvixBuildDir <//> filePath)) contents)

wasiStandaloneRuntimeDir :: [(Path Rel File, BS.ByteString)]
wasiStandaloneRuntimeDir = map (first relFile) $(FE.makeRelativeToProject "c-runtime/wasi-standalone" >>= FE.embedDir)

standaloneRuntimeDir :: [(Path Rel File, BS.ByteString)]
standaloneRuntimeDir = map (first relFile) $(FE.makeRelativeToProject "c-runtime/standalone" >>= FE.embedDir)

wasiLibCRuntimeDir :: [(Path Rel File, BS.ByteString)]
wasiLibCRuntimeDir = map (first relFile) $(FE.makeRelativeToProject "c-runtime/wasi-libc" >>= FE.embedDir)

builtinCRuntimeDir :: [(Path Rel File, BS.ByteString)]
builtinCRuntimeDir = map (first relFile) $(FE.makeRelativeToProject "c-runtime/builtins" >>= FE.embedDir)

wallocDir :: [(Path Rel File, BS.ByteString)]
wallocDir = map (first relFile) $(FE.makeRelativeToProject "c-runtime/walloc" >>= FE.embedDir)

libcRuntime :: [(Path Rel File, BS.ByteString)]
libcRuntime = wasiLibCRuntimeDir <> builtinCRuntimeDir

clangNativeCompile ::
forall r.
Members '[Embed IO, Error Text] r =>
FilePath ->
FilePath ->
Members '[Embed IO, App, Error Text] r =>
Path Abs File ->
CompileOptions ->
Sem r ()
clangNativeCompile projRoot inputFileCompile o = runClang (nativeArgs outputFile inputFile)
clangNativeCompile inputFileCompile o = do
inputFile <- getInputFile
outputFile <- getOutputFile
runClang (nativeArgs outputFile inputFile)
where
outputFile :: FilePath
outputFile = maybe (takeBaseName inputFileCompile) (^. pathPath) (o ^. compileOutputFile)
getOutputFile :: Sem r (Path Abs File)
getOutputFile = case o ^. compileOutputFile of
Nothing -> return (removeExtension' inputFileCompile)
Just f -> someBaseToAbs' (f ^. pathPath)

inputFile :: FilePath
inputFile = inputCFile projRoot inputFileCompile
getInputFile :: Sem r (Path Abs File)
getInputFile = inputCFile inputFileCompile

clangCompile ::
forall r.
Members '[Embed IO, Error Text] r =>
FilePath ->
FilePath ->
Members '[Embed IO, App, Error Text] r =>
Path Abs File ->
CompileOptions ->
Sem r ()
clangCompile projRoot inputFileCompile o = clangArgs >>= runClang
clangCompile inputFileCompile o = do
outputFile <- getOutputFile
inputFile <- getInputFile
let clangArgs :: Sem r [String]
clangArgs = case o ^. compileRuntime of
RuntimeStandalone -> do
standaloneLibArgs outputFile inputFile
RuntimeWasiStandalone -> wasiStandaloneArgs outputFile inputFile
RuntimeWasiLibC -> wasiLibcArgs outputFile inputFile

clangArgs >>= runClang
where
clangArgs :: Sem r [String]
clangArgs = case o ^. compileRuntime of
RuntimeStandalone ->
return (standaloneLibArgs projRoot outputFile inputFile)
RuntimeWasiStandalone -> wasiStandaloneArgs projRoot outputFile inputFile <$> sysrootEnvVar
RuntimeWasiLibC -> wasiLibcArgs outputFile inputFile <$> sysrootEnvVar

outputFile :: FilePath
outputFile = maybe (takeBaseName inputFileCompile <> ".wasm") (^. pathPath) (o ^. compileOutputFile)

inputFile :: FilePath
inputFile = inputCFile projRoot inputFileCompile

sysrootEnvVar :: Sem r String
sysrootEnvVar =
fromMaybeM (throw msg) (embed (lookupEnv "WASI_SYSROOT_PATH"))
where
msg :: Text
msg = "Missing environment variable WASI_SYSROOT_PATH"

commonArgs :: FilePath -> [String]
getOutputFile :: Sem r (Path Abs File)
getOutputFile = maybe (return defaultOutputFile) someBaseToAbs' (o ^? compileOutputFile . _Just . pathPath)

defaultOutputFile :: Path Abs File
defaultOutputFile = replaceExtension' ".wasm" inputFileCompile

getInputFile :: Sem r (Path Abs File)
getInputFile = inputCFile inputFileCompile

sysrootEnvVar :: Members '[Error Text, Embed IO] r => Sem r (Path Abs Dir)
sysrootEnvVar =
absDir
<$> fromMaybeM (throw msg) (embed (lookupEnv "WASI_SYSROOT_PATH"))
where
msg :: Text
msg = "Missing environment variable WASI_SYSROOT_PATH"

commonArgs :: Path Abs File -> [String]
commonArgs wasmOutputFile =
[ "-std=c99",
"-Oz",
"-I",
juvixBuildDir,
toFilePath juvixBuildDir,
"-o",
wasmOutputFile
toFilePath wasmOutputFile
]

standaloneLibArgs :: FilePath -> FilePath -> FilePath -> [String]
standaloneLibArgs projRoot wasmOutputFile inputFile =
commonArgs wasmOutputFile
<> [ "--target=wasm32",
"-nodefaultlibs",
"-nostartfiles",
"-Wl,--no-entry",
projRoot </> juvixBuildDir </> "walloc.c",
inputFile
]

wasiStandaloneArgs :: FilePath -> FilePath -> FilePath -> FilePath -> [String]
wasiStandaloneArgs projRoot wasmOutputFile inputFile sysrootPath =
wasiCommonArgs sysrootPath wasmOutputFile
<> [ projRoot </> juvixBuildDir </> "walloc.c",
inputFile
]

wasiLibcArgs :: FilePath -> FilePath -> FilePath -> [String]
wasiLibcArgs wasmOutputFile inputFile sysrootPath =
wasiCommonArgs sysrootPath wasmOutputFile
<> ["-lc", inputFile]

nativeArgs :: FilePath -> FilePath -> [String]
standaloneLibArgs :: Members '[App, Embed IO] r => Path Abs File -> Path Abs File -> Sem r [String]
standaloneLibArgs wasmOutputFile inputFile = do
root <- askPkgDir
return $
commonArgs wasmOutputFile
<> [ "--target=wasm32",
"-nodefaultlibs",
"-nostartfiles",
"-Wl,--no-entry",
toFilePath (root <//> juvixBuildDir <//> $(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
com <- wasiCommonArgs wasmOutputFile
return $
com
<> [ toFilePath (root <//> juvixBuildDir <//> $(mkRelFile "walloc.c")),
toFilePath inputFile
]

wasiLibcArgs :: Members '[App, Error Text, Embed IO] r => Path Abs File -> Path Abs File -> Sem r [String]
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 <> [inputFile]

wasiCommonArgs :: FilePath -> FilePath -> [String]
wasiCommonArgs sysrootPath wasmOutputFile =
commonArgs wasmOutputFile
<> [ "-nodefaultlibs",
"--target=wasm32-wasi",
"--sysroot",
sysrootPath
]
commonArgs outputFile <> [toFilePath inputFile]

wasiCommonArgs :: Members '[App, Error Text, Embed IO] r => Path Abs File -> Sem r [String]
wasiCommonArgs wasmOutputFile = do
sysrootPath <- sysrootEnvVar
return $
commonArgs wasmOutputFile
<> [ "-nodefaultlibs",
"--target=wasm32-wasi",
"--sysroot",
toFilePath sysrootPath
]

runClang ::
Members '[Embed IO, Error Text] r =>
Expand Down
Loading

0 comments on commit af63c36

Please sign in to comment.