mirror of
https://github.com/anoma/juvix.git
synced 2024-09-11 08:15:41 +03:00
refactor --target
into subcommands for dev tree compile
and other improvements (#2713)
- refactor `--target` into subcommands for `dev tree compile`. - prepend `App` to all `CompileTarget` constructors to avoid name clashes with `Target`. - parameterize compile options type with the input kind. The input kind indicates the expected file extension of the input file. If the input file is a .juvix file, then it is optional, otherwise it is mandatory. - Add `AppError MegaparsecError` instance and simplify some related code.
This commit is contained in:
parent
622bedf222
commit
65176a333d
16
app/App.hs
16
app/App.hs
@ -10,6 +10,7 @@ import Juvix.Compiler.Pipeline.Root
|
||||
import Juvix.Compiler.Pipeline.Run
|
||||
import Juvix.Data.Error qualified as Error
|
||||
import Juvix.Extra.Paths.Base hiding (rootBuildDir)
|
||||
import Juvix.Parser.Error
|
||||
import Juvix.Prelude.Pretty hiding
|
||||
( Doc,
|
||||
)
|
||||
@ -208,12 +209,20 @@ runPipelineTermination input_ p = do
|
||||
r <- runPipelineEither input_ (evalTermination iniTerminationState p) >>= fromRightJuvixError
|
||||
return (snd r)
|
||||
|
||||
runPipeline :: (Members '[App, EmbedIO, TaggedLock] r) => Maybe (AppPath File) -> Sem (PipelineEff r) a -> Sem r a
|
||||
runPipeline ::
|
||||
(Members '[App, EmbedIO, TaggedLock] r) =>
|
||||
Maybe (AppPath File) ->
|
||||
Sem (PipelineEff r) a ->
|
||||
Sem r a
|
||||
runPipeline input_ p = do
|
||||
r <- runPipelineEither input_ p >>= fromRightJuvixError
|
||||
return (snd r ^. pipelineResult)
|
||||
|
||||
runPipelineHtml :: (Members '[App, EmbedIO, TaggedLock] r) => Bool -> Maybe (AppPath File) -> Sem r (InternalTypedResult, [InternalTypedResult])
|
||||
runPipelineHtml ::
|
||||
(Members '[App, EmbedIO, TaggedLock] r) =>
|
||||
Bool ->
|
||||
Maybe (AppPath File) ->
|
||||
Sem r (InternalTypedResult, [InternalTypedResult])
|
||||
runPipelineHtml bNonRecursive input_
|
||||
| bNonRecursive = do
|
||||
r <- runPipeline input_ upToInternalTyped
|
||||
@ -242,6 +251,9 @@ printSuccessExit = exitMsg ExitSuccess
|
||||
getRight :: forall e a r. (Members '[App] r, AppError e) => Either e a -> Sem r a
|
||||
getRight = either appError return
|
||||
|
||||
instance AppError MegaparsecError where
|
||||
appError = appError . JuvixError
|
||||
|
||||
instance AppError Text where
|
||||
appError = exitFailMsg
|
||||
|
||||
|
@ -3,19 +3,17 @@ module Commands.Compile.Anoma where
|
||||
import Commands.Base
|
||||
import Commands.Compile.Anoma.Options
|
||||
import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Backend
|
||||
import Juvix.Compiler.Nockma.Pretty qualified as Nockma
|
||||
import Juvix.Compiler.Nockma.Translation.FromTree qualified as Nockma
|
||||
|
||||
runCommand :: (Members '[App, EmbedIO, TaggedLock] r) => AnomaOptions -> Sem r ()
|
||||
runCommand :: (Members '[App, EmbedIO, TaggedLock] r) => AnomaOptions 'InputMain -> Sem r ()
|
||||
runCommand opts = do
|
||||
let opts' = opts ^. anomaCompileCommonOptions
|
||||
inputFile = opts' ^. compileInputFile
|
||||
moutputFile = opts' ^. compileOutputFile
|
||||
coreRes <- fromCompileCommonOptionsMain opts' >>= compileToCore
|
||||
entryPoint <-
|
||||
set entryPointTarget (Just TargetAnoma)
|
||||
. applyCompileCommonOptions opts'
|
||||
applyOptions opts
|
||||
<$> getEntryPoint (opts' ^. compileInputFile)
|
||||
nockmaFile :: Path Abs File <- getOutputFile FileExtNockma inputFile moutputFile
|
||||
r <-
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Compile.Anoma.Options
|
||||
( module Commands.Compile.Anoma.Options,
|
||||
module Commands.Compile.CommonOptions,
|
||||
@ -7,14 +9,20 @@ where
|
||||
import Commands.Compile.CommonOptions
|
||||
import CommonOptions
|
||||
|
||||
data AnomaOptions = AnomaOptions
|
||||
{ _anomaCompileCommonOptions :: CompileCommonOptionsMain
|
||||
data AnomaOptions (k :: InputKind) = AnomaOptions
|
||||
{ _anomaCompileCommonOptions :: CompileCommonOptions k
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (AnomaOptions k)
|
||||
|
||||
makeLenses ''AnomaOptions
|
||||
|
||||
parseAnoma :: Parser AnomaOptions
|
||||
parseAnoma :: (SingI k) => Parser (AnomaOptions k)
|
||||
parseAnoma = do
|
||||
_anomaCompileCommonOptions <- parseCompileCommonOptionsMain
|
||||
_anomaCompileCommonOptions <- parseCompileCommonOptions
|
||||
pure AnomaOptions {..}
|
||||
|
||||
instance EntryPointOptions (AnomaOptions k) where
|
||||
applyOptions opts =
|
||||
set entryPointTarget (Just TargetAnoma)
|
||||
. applyOptions (opts ^. anomaCompileCommonOptions)
|
||||
|
@ -4,17 +4,15 @@ import Commands.Base
|
||||
import Commands.Compile.Cairo.Options
|
||||
import Commands.Extra.NewCompile
|
||||
import Data.Aeson qualified as JSON
|
||||
import Juvix.Compiler.Backend
|
||||
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => CairoOptions -> Sem r ()
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => CairoOptions 'InputMain -> Sem r ()
|
||||
runCommand opts = do
|
||||
let opts' = opts ^. cairoCompileCommonOptions
|
||||
inputFile = opts' ^. compileInputFile
|
||||
moutputFile = opts' ^. compileOutputFile
|
||||
coreRes <- fromCompileCommonOptionsMain opts' >>= compileToCore
|
||||
entryPoint <-
|
||||
set entryPointTarget (Just TargetCairo)
|
||||
. applyCompileCommonOptions opts'
|
||||
applyOptions opts
|
||||
<$> getEntryPoint (opts' ^. compileInputFile)
|
||||
cairoFile :: Path Abs File <- getOutputFile FileExtJson inputFile moutputFile
|
||||
r <-
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Compile.Cairo.Options
|
||||
( module Commands.Compile.Cairo.Options,
|
||||
module Commands.Compile.CommonOptions,
|
||||
@ -7,14 +9,20 @@ where
|
||||
import Commands.Compile.CommonOptions
|
||||
import CommonOptions
|
||||
|
||||
data CairoOptions = CairoOptions
|
||||
{ _cairoCompileCommonOptions :: CompileCommonOptionsMain
|
||||
data CairoOptions (k :: InputKind) = CairoOptions
|
||||
{ _cairoCompileCommonOptions :: CompileCommonOptions k
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (CairoOptions k)
|
||||
|
||||
makeLenses ''CairoOptions
|
||||
|
||||
parseCairo :: Parser CairoOptions
|
||||
parseCairo :: (SingI k) => Parser (CairoOptions k)
|
||||
parseCairo = do
|
||||
_cairoCompileCommonOptions <- parseCompileCommonOptionsMain
|
||||
_cairoCompileCommonOptions <- parseCompileCommonOptions
|
||||
pure CairoOptions {..}
|
||||
|
||||
instance EntryPointOptions (CairoOptions k) where
|
||||
applyOptions opts =
|
||||
set entryPointTarget (Just TargetCairo)
|
||||
. applyOptions (opts ^. cairoCompileCommonOptions)
|
||||
|
@ -1,58 +1,72 @@
|
||||
module Commands.Compile.CommonOptions where
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Compile.CommonOptions
|
||||
( module Commands.Compile.CommonOptions,
|
||||
module Commands.Compile.CommonOptions.InputKind,
|
||||
module Juvix.Compiler.Pipeline.EntryPoint,
|
||||
module Juvix.Compiler.Backend,
|
||||
)
|
||||
where
|
||||
|
||||
import App
|
||||
import Commands.Compile.CommonOptions.InputKind
|
||||
import CommonOptions
|
||||
import Juvix.Compiler.Backend
|
||||
import Juvix.Compiler.Pipeline.EntryPoint
|
||||
|
||||
-- | If the input file can be defaulted to the `main` in the `package.yaml` file, we
|
||||
-- can omit the input file.
|
||||
type CompileCommonOptionsMain = CompileCommonOptions' (Maybe (AppPath File))
|
||||
|
||||
type CompileCommonOptions = CompileCommonOptions' (AppPath File)
|
||||
|
||||
data CompileCommonOptions' inputFile = CompileCommonOptions
|
||||
{ _compileInputFile :: inputFile,
|
||||
data CompileCommonOptions (k :: InputKind) = CompileCommonOptions
|
||||
{ _compileInputFile :: InputFileType k,
|
||||
_compileOutputFile :: Maybe (AppPath File),
|
||||
_compileDebug :: Bool,
|
||||
_compileInliningDepth :: Int,
|
||||
_compileOptimizationLevel :: Maybe Int
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
makeLenses ''CompileCommonOptions'
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (CompileCommonOptions k)
|
||||
|
||||
applyCompileCommonOptions :: CompileCommonOptions' b -> EntryPoint -> EntryPoint
|
||||
applyCompileCommonOptions opts e =
|
||||
e
|
||||
{ _entryPointDebug = opts ^. compileDebug,
|
||||
_entryPointOptimizationLevel = fromMaybe defaultOptimization (opts ^. compileOptimizationLevel),
|
||||
_entryPointInliningDepth = opts ^. compileInliningDepth
|
||||
}
|
||||
where
|
||||
defaultOptimization :: Int
|
||||
defaultOptimization
|
||||
| opts ^. compileDebug = 0
|
||||
| otherwise = defaultOptimizationLevel
|
||||
makeLenses ''CompileCommonOptions
|
||||
|
||||
fromCompileCommonOptionsMain :: (Members '[App] r) => CompileCommonOptionsMain -> Sem r CompileCommonOptions
|
||||
instance EntryPointOptions (CompileCommonOptions b) where
|
||||
applyOptions opts e =
|
||||
e
|
||||
{ _entryPointDebug = opts ^. compileDebug,
|
||||
_entryPointOptimizationLevel = fromMaybe defaultOptimization (opts ^. compileOptimizationLevel),
|
||||
_entryPointInliningDepth = opts ^. compileInliningDepth
|
||||
}
|
||||
where
|
||||
defaultOptimization :: Int
|
||||
defaultOptimization
|
||||
| opts ^. compileDebug = 0
|
||||
| otherwise = defaultOptimizationLevel
|
||||
|
||||
fromCompileCommonOptionsMain ::
|
||||
(Members '[App] r) =>
|
||||
CompileCommonOptions 'InputMain ->
|
||||
Sem r (CompileCommonOptions ('InputExtension 'FileExtJuvix))
|
||||
fromCompileCommonOptionsMain = traverseOf compileInputFile getMainAppFile
|
||||
|
||||
parseCompileCommonOptionsMain ::
|
||||
Parser CompileCommonOptionsMain
|
||||
parseCompileCommonOptionsMain =
|
||||
parseCompileCommonOptionsGeneric
|
||||
(optional (parseInputFile FileExtJuvix))
|
||||
getMainFileFromInputFileType ::
|
||||
forall (k :: InputKind) r.
|
||||
(SingI k, Members '[App] r) =>
|
||||
InputFileType k ->
|
||||
Sem r (Path Abs File)
|
||||
getMainFileFromInputFileType = getMainAppFileFromInputFileType @k >=> fromAppFile
|
||||
|
||||
getMainAppFileFromInputFileType ::
|
||||
forall (k :: InputKind) r.
|
||||
(SingI k, Members '[App] r) =>
|
||||
InputFileType k ->
|
||||
Sem r (AppPath File)
|
||||
getMainAppFileFromInputFileType i = case sing :: SInputKind k of
|
||||
SInputMain -> getMainAppFile i
|
||||
SInputExtension {} -> return i
|
||||
|
||||
parseCompileCommonOptions ::
|
||||
Parser CompileCommonOptions
|
||||
parseCompileCommonOptions =
|
||||
parseCompileCommonOptionsGeneric
|
||||
(parseInputFile FileExtJuvix)
|
||||
|
||||
parseCompileCommonOptionsGeneric ::
|
||||
Parser inputFile ->
|
||||
Parser (CompileCommonOptions' inputFile)
|
||||
parseCompileCommonOptionsGeneric parserFile = do
|
||||
forall k.
|
||||
(SingI k) =>
|
||||
Parser (CompileCommonOptions k)
|
||||
parseCompileCommonOptions = do
|
||||
_compileDebug <-
|
||||
switch
|
||||
( short 'g'
|
||||
@ -76,5 +90,5 @@ parseCompileCommonOptionsGeneric parserFile = do
|
||||
<> help ("Automatic inlining depth limit, logarithmic in the function size (default: " <> show defaultInliningDepth <> ")")
|
||||
)
|
||||
_compileOutputFile <- optional parseGenericOutputFile
|
||||
_compileInputFile <- parserFile
|
||||
_compileInputFile <- parseInputFileType @k
|
||||
pure CompileCommonOptions {..}
|
||||
|
23
app/Commands/Compile/CommonOptions/InputKind.hs
Normal file
23
app/Commands/Compile/CommonOptions/InputKind.hs
Normal file
@ -0,0 +1,23 @@
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
|
||||
module Commands.Compile.CommonOptions.InputKind where
|
||||
|
||||
import CommonOptions
|
||||
|
||||
data InputKind
|
||||
= -- | The input is a .juvix or .juvix.md file. If omitted, the main in juvix.yaml is used
|
||||
InputMain
|
||||
| -- | The input is a non-optional file with some extension
|
||||
InputExtension FileExt
|
||||
|
||||
$(genSingletons [''InputKind])
|
||||
|
||||
type InputFileType :: InputKind -> GHCType
|
||||
type family InputFileType s = res where
|
||||
InputFileType 'InputMain = Maybe (AppPath File)
|
||||
InputFileType ('InputExtension _) = AppPath File
|
||||
|
||||
parseInputFileType :: forall k. (SingI k) => Parser (InputFileType k)
|
||||
parseInputFileType = case sing :: SInputKind k of
|
||||
SInputMain -> optional (parseInputFiles (FileExtJuvix :| [FileExtMarkdown]))
|
||||
SInputExtension inputExtension -> parseInputFile (fromSing inputExtension)
|
@ -3,19 +3,17 @@ module Commands.Compile.Geb where
|
||||
import Commands.Base
|
||||
import Commands.Compile.Geb.Options
|
||||
import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Backend
|
||||
import Juvix.Compiler.Backend.Geb qualified as Geb
|
||||
import System.FilePath (takeBaseName)
|
||||
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => GebOptions -> Sem r ()
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => GebOptions 'InputMain -> Sem r ()
|
||||
runCommand opts = do
|
||||
let opts' = opts ^. gebCompileCommonOptions
|
||||
inputFile = opts' ^. compileInputFile
|
||||
moutputFile = opts' ^. compileOutputFile
|
||||
coreRes <- fromCompileCommonOptionsMain opts' >>= compileToCore
|
||||
entryPoint <-
|
||||
set entryPointTarget (Just TargetGeb)
|
||||
. applyCompileCommonOptions opts'
|
||||
applyOptions opts
|
||||
<$> getEntryPoint (opts' ^. compileInputFile)
|
||||
let ext :: FileExt
|
||||
ext
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Compile.Geb.Options
|
||||
( module Commands.Compile.Geb.Options,
|
||||
module Commands.Compile.CommonOptions,
|
||||
@ -7,17 +9,18 @@ where
|
||||
import Commands.Compile.CommonOptions
|
||||
import CommonOptions
|
||||
|
||||
data GebOptions = GebOptions
|
||||
{ _gebCompileCommonOptions :: CompileCommonOptionsMain,
|
||||
data GebOptions (k :: InputKind) = GebOptions
|
||||
{ _gebCompileCommonOptions :: CompileCommonOptions k,
|
||||
_gebOnlyTerm :: Bool
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (GebOptions k)
|
||||
|
||||
makeLenses ''GebOptions
|
||||
|
||||
parseGeb :: Parser GebOptions
|
||||
parseGeb :: (SingI k) => Parser (GebOptions k)
|
||||
parseGeb = do
|
||||
_gebCompileCommonOptions <- parseCompileCommonOptionsMain
|
||||
_gebCompileCommonOptions <- parseCompileCommonOptions
|
||||
_gebOnlyTerm <-
|
||||
switch
|
||||
( short 'G' -- TODO I would like to deprecate the short flag
|
||||
@ -25,3 +28,8 @@ parseGeb = do
|
||||
<> help "Produce term output only"
|
||||
)
|
||||
pure GebOptions {..}
|
||||
|
||||
instance EntryPointOptions (GebOptions k) where
|
||||
applyOptions opts =
|
||||
set entryPointTarget (Just TargetGeb)
|
||||
. applyOptions (opts ^. gebCompileCommonOptions)
|
||||
|
@ -3,40 +3,10 @@ module Commands.Compile.Native where
|
||||
import Commands.Base
|
||||
import Commands.Compile.Native.Options
|
||||
import Commands.Compile.NativeWasiHelper as Helper
|
||||
import Data.ByteString qualified as BS
|
||||
import Data.FileEmbed qualified as FE
|
||||
import Juvix.Compiler.Backend
|
||||
|
||||
runCommand :: forall r. (Members '[App, TaggedLock, EmbedIO] r) => NativeOptions -> Sem r ()
|
||||
runCommand opts =
|
||||
Helper.runCommand
|
||||
HelperOptions
|
||||
{ _helperCStage = opts ^. nativeCStage,
|
||||
_helperTarget = TargetCNative64,
|
||||
_helperCompileCommonOptions = opts ^. nativeCompileCommonOptions,
|
||||
_helperClangBackend = ClangNative,
|
||||
_helperDefaultOutputFile = \inputFile baseOutputFile ->
|
||||
case opts ^. nativeCStage of
|
||||
CSource -> replaceExtension' cFileExt inputFile
|
||||
CPreprocess -> addExtension' cFileExt (addExtension' ".out" (removeExtension' inputFile))
|
||||
CAssembly -> replaceExtension' ".s" inputFile
|
||||
CExecutable -> removeExtension' baseOutputFile,
|
||||
_helperPrepareRuntime = prepareRuntime
|
||||
}
|
||||
where
|
||||
prepareRuntime ::
|
||||
forall s.
|
||||
(Members '[App, EmbedIO] s) =>
|
||||
Sem s ()
|
||||
prepareRuntime = writeRuntime runtime
|
||||
where
|
||||
runtime :: BS.ByteString
|
||||
runtime
|
||||
| opts ^. nativeCompileCommonOptions . compileDebug = nativeDebugRuntime
|
||||
| otherwise = nativeReleaseRuntime
|
||||
where
|
||||
nativeReleaseRuntime :: BS.ByteString
|
||||
nativeReleaseRuntime = $(FE.makeRelativeToProject "runtime/_build.native64/libjuvix.a" >>= FE.embedFile)
|
||||
|
||||
nativeDebugRuntime :: BS.ByteString
|
||||
nativeDebugRuntime = $(FE.makeRelativeToProject "runtime/_build.native64-debug/libjuvix.a" >>= FE.embedFile)
|
||||
runCommand ::
|
||||
forall r.
|
||||
(Members '[App, TaggedLock, EmbedIO] r) =>
|
||||
NativeOptions 'InputMain ->
|
||||
Sem r ()
|
||||
runCommand = Helper.runCommand . nativeHelperOptions
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Compile.Native.Options
|
||||
( module Commands.Compile.Native.Options,
|
||||
module Commands.Compile.CommonOptions,
|
||||
@ -8,31 +10,60 @@ where
|
||||
import Commands.Base
|
||||
import Commands.Compile.CStage
|
||||
import Commands.Compile.CommonOptions
|
||||
import Commands.Compile.NativeWasiHelper as Helper
|
||||
import Data.ByteString qualified as BS
|
||||
import Data.FileEmbed qualified as FE
|
||||
|
||||
data NativeOptions = NativeOptions
|
||||
{ _nativeCompileCommonOptions :: CompileCommonOptionsMain,
|
||||
data NativeOptions (k :: InputKind) = NativeOptions
|
||||
{ _nativeCompileCommonOptions :: CompileCommonOptions k,
|
||||
_nativeCStage :: CStage
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (NativeOptions k)
|
||||
|
||||
makeLenses ''NativeOptions
|
||||
|
||||
parseNative :: Parser NativeOptions
|
||||
parseNative :: forall (k :: InputKind). (SingI k) => Parser (NativeOptions k)
|
||||
parseNative = do
|
||||
_nativeCompileCommonOptions <- parseCompileCommonOptionsMain
|
||||
_nativeCompileCommonOptions <- parseCompileCommonOptions
|
||||
_nativeCStage <- parseCStage
|
||||
pure NativeOptions {..}
|
||||
|
||||
nativeOutputFile :: (Member App r) => NativeOptions -> Sem r (Path Abs File)
|
||||
nativeOutputFile opts =
|
||||
case opts ^. nativeCompileCommonOptions . compileOutputFile of
|
||||
Just f -> fromAppFile f
|
||||
Nothing -> do
|
||||
inputFile <- getMainFile (opts ^. nativeCompileCommonOptions . compileInputFile)
|
||||
invokeDir <- askInvokeDir
|
||||
let baseOutputFile = invokeDir <//> filename inputFile
|
||||
return $ case opts ^. nativeCStage of
|
||||
nativeHelperOptions :: NativeOptions k -> Helper.HelperOptions k
|
||||
nativeHelperOptions opts =
|
||||
Helper.HelperOptions
|
||||
{ _helperCStage = opts ^. nativeCStage,
|
||||
_helperTarget = TargetCNative64,
|
||||
_helperCompileCommonOptions = opts ^. nativeCompileCommonOptions,
|
||||
_helperClangBackend = ClangNative,
|
||||
_helperDefaultOutputFile = nativeDefaultOutputFile,
|
||||
_helperPrepareRuntime = prepareRuntime
|
||||
}
|
||||
where
|
||||
prepareRuntime ::
|
||||
forall s.
|
||||
(Members '[App, EmbedIO] s) =>
|
||||
Sem s ()
|
||||
prepareRuntime = writeRuntime runtime
|
||||
where
|
||||
runtime :: BS.ByteString
|
||||
runtime
|
||||
| opts ^. nativeCompileCommonOptions . compileDebug = nativeDebugRuntime
|
||||
| otherwise = nativeReleaseRuntime
|
||||
where
|
||||
nativeReleaseRuntime :: BS.ByteString
|
||||
nativeReleaseRuntime = $(FE.makeRelativeToProject "runtime/_build.native64/libjuvix.a" >>= FE.embedFile)
|
||||
|
||||
nativeDebugRuntime :: BS.ByteString
|
||||
nativeDebugRuntime = $(FE.makeRelativeToProject "runtime/_build.native64-debug/libjuvix.a" >>= FE.embedFile)
|
||||
|
||||
nativeDefaultOutputFile :: Path Abs File -> Path Abs File -> Path Abs File
|
||||
nativeDefaultOutputFile inputFile baseOutputFile =
|
||||
case opts ^. nativeCStage of
|
||||
CSource -> replaceExtension' cFileExt inputFile
|
||||
CPreprocess -> addExtension' cFileExt (addExtension' ".out" (removeExtension' inputFile))
|
||||
CAssembly -> replaceExtension' ".s" inputFile
|
||||
CExecutable -> removeExtension' baseOutputFile
|
||||
|
||||
instance EntryPointOptions (NativeOptions k) where
|
||||
applyOptions opts = applyOptions (opts ^. nativeCompileCommonOptions)
|
||||
|
@ -12,12 +12,11 @@ import Commands.Compile.NativeWasiHelper.RuntimeWriter
|
||||
import Commands.Extra.Clang
|
||||
import Commands.Extra.Clang.Backend
|
||||
import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Backend
|
||||
import Juvix.Compiler.Backend.C qualified as C
|
||||
import Juvix.Extra.Paths
|
||||
|
||||
data HelperOptions = HelperOptions
|
||||
{ _helperCompileCommonOptions :: CompileCommonOptionsMain,
|
||||
data HelperOptions (k :: InputKind) = HelperOptions
|
||||
{ _helperCompileCommonOptions :: CompileCommonOptions k,
|
||||
_helperCStage :: CStage,
|
||||
_helperTarget :: Target,
|
||||
_helperClangBackend :: ClangBackend,
|
||||
@ -27,33 +26,42 @@ data HelperOptions = HelperOptions
|
||||
|
||||
makeLenses ''HelperOptions
|
||||
|
||||
helperOutputFile :: (Member App r) => HelperOptions -> Sem r (Path Abs File)
|
||||
helperOutputFile :: forall k r. (SingI k, Member App r) => HelperOptions k -> Sem r (Path Abs File)
|
||||
helperOutputFile opts =
|
||||
case opts ^. helperCompileCommonOptions . compileOutputFile of
|
||||
Just f -> fromAppFile f
|
||||
Nothing -> do
|
||||
inputFile <- getMainFile (opts ^. helperCompileCommonOptions . compileInputFile)
|
||||
inputFile <- getMainFileFromInputFileType @k (opts ^. helperCompileCommonOptions . compileInputFile)
|
||||
invokeDir <- askInvokeDir
|
||||
let baseOutputFile = invokeDir <//> filename inputFile
|
||||
return ((opts ^. helperDefaultOutputFile) inputFile baseOutputFile)
|
||||
|
||||
runCommand :: forall r. (Members '[App, TaggedLock, EmbedIO] r) => HelperOptions -> Sem r ()
|
||||
runCommand opts = do
|
||||
runCommand :: forall r. (Members '[App, TaggedLock, EmbedIO] r) => HelperOptions 'InputMain -> Sem r ()
|
||||
runCommand opts = concreteToC opts >>= fromC opts
|
||||
|
||||
concreteToC ::
|
||||
forall r.
|
||||
(Members '[App, TaggedLock, EmbedIO] r) =>
|
||||
HelperOptions 'InputMain ->
|
||||
Sem r C.MiniCResult
|
||||
concreteToC opts = do
|
||||
let opts' = opts ^. helperCompileCommonOptions
|
||||
coreRes <- fromCompileCommonOptionsMain opts' >>= compileToCore
|
||||
entryPoint <-
|
||||
set entryPointTarget (Just (opts ^. helperTarget))
|
||||
. applyCompileCommonOptions opts'
|
||||
applyOptions opts
|
||||
<$> getEntryPoint (opts' ^. compileInputFile)
|
||||
C.MiniCResult {..} <-
|
||||
getRight
|
||||
. run
|
||||
. runReader entryPoint
|
||||
. runError @JuvixError
|
||||
$ coreToMiniC (coreRes ^. coreResultModule)
|
||||
inputfile <- getMainFile (opts' ^. compileInputFile)
|
||||
getRight
|
||||
. run
|
||||
. runReader entryPoint
|
||||
. runError @JuvixError
|
||||
$ coreToMiniC (coreRes ^. coreResultModule)
|
||||
|
||||
fromC :: forall k r. (SingI k, Members '[App, EmbedIO] r) => HelperOptions k -> C.MiniCResult -> Sem r ()
|
||||
fromC opts cResult = do
|
||||
let opts' = opts ^. helperCompileCommonOptions
|
||||
inputfile <- getMainFileFromInputFileType @k (opts' ^. compileInputFile)
|
||||
cFile <- inputCFile inputfile
|
||||
writeFileEnsureLn cFile _resultCCode
|
||||
writeFileEnsureLn cFile (cResult ^. C.resultCCode)
|
||||
outfile <- helperOutputFile opts
|
||||
let carg =
|
||||
ClangArgs
|
||||
@ -69,9 +77,14 @@ runCommand opts = do
|
||||
ensureDir (juvixIncludeDir buildDir)
|
||||
opts ^. helperPrepareRuntime
|
||||
clangCompile carg
|
||||
where
|
||||
inputCFile :: Path Abs File -> Sem r (Path Abs File)
|
||||
inputCFile inputFileCompile = do
|
||||
buildDir <- askBuildDir
|
||||
ensureDir buildDir
|
||||
return (buildDir <//> replaceExtension' ".c" (filename inputFileCompile))
|
||||
|
||||
inputCFile :: (Members '[App, EmbedIO] r) => Path Abs File -> Sem r (Path Abs File)
|
||||
inputCFile inputFileCompile = do
|
||||
buildDir <- askBuildDir
|
||||
ensureDir buildDir
|
||||
return (buildDir <//> replaceExtension' ".c" (filename inputFileCompile))
|
||||
|
||||
instance EntryPointOptions (HelperOptions k) where
|
||||
applyOptions opts =
|
||||
set entryPointTarget (Just (opts ^. helperTarget))
|
||||
. applyOptions (opts ^. helperCompileCommonOptions)
|
||||
|
@ -9,68 +9,27 @@ import Commands.Compile.Geb.Options
|
||||
import Commands.Compile.Native.Options
|
||||
import Commands.Compile.Vampir.Options
|
||||
import Commands.Compile.Wasi.Options
|
||||
import Commands.Extra.NewCompile
|
||||
import CommonOptions
|
||||
|
||||
data CompileCommand
|
||||
= Native NativeOptions
|
||||
| Wasi WasiOptions
|
||||
| Geb GebOptions
|
||||
| Vampir VampirOptions
|
||||
| Anoma AnomaOptions
|
||||
| Cairo CairoOptions
|
||||
= Native (NativeOptions 'InputMain)
|
||||
| Wasi (WasiOptions 'InputMain)
|
||||
| Geb (GebOptions 'InputMain)
|
||||
| Vampir (VampirOptions 'InputMain)
|
||||
| Anoma (AnomaOptions 'InputMain)
|
||||
| Cairo (CairoOptions 'InputMain)
|
||||
deriving stock (Data)
|
||||
|
||||
parseCompileCommand :: Parser CompileCommand
|
||||
parseCompileCommand =
|
||||
hsubparser
|
||||
( mconcat
|
||||
[ commandNative,
|
||||
commandWasi,
|
||||
commandGeb,
|
||||
commandVampir,
|
||||
commandAnoma,
|
||||
commandCairo
|
||||
]
|
||||
)
|
||||
parseCompileCommand = commandTargetsHelper supportedTargets
|
||||
|
||||
commandNative :: Mod CommandFields CompileCommand
|
||||
commandNative =
|
||||
command "native" $
|
||||
info
|
||||
(Native <$> parseNative)
|
||||
(progDesc "Compile to native code")
|
||||
|
||||
commandWasi :: Mod CommandFields CompileCommand
|
||||
commandWasi =
|
||||
command "wasi" $
|
||||
info
|
||||
(Wasi <$> parseWasi)
|
||||
(progDesc "Compile to WASI (WebAssembly System Interface)")
|
||||
|
||||
commandGeb :: Mod CommandFields CompileCommand
|
||||
commandGeb =
|
||||
command "geb" $
|
||||
info
|
||||
(Geb <$> parseGeb)
|
||||
(progDesc "Compile to Geb")
|
||||
|
||||
commandVampir :: Mod CommandFields CompileCommand
|
||||
commandVampir =
|
||||
command "vampir" $
|
||||
info
|
||||
(Vampir <$> parseVampir)
|
||||
(progDesc "Compile to VampIR")
|
||||
|
||||
commandAnoma :: Mod CommandFields CompileCommand
|
||||
commandAnoma =
|
||||
command "anoma" $
|
||||
info
|
||||
(Anoma <$> parseAnoma)
|
||||
(progDesc "Compile to Anoma")
|
||||
|
||||
commandCairo :: Mod CommandFields CompileCommand
|
||||
commandCairo =
|
||||
command "cairo" $
|
||||
info
|
||||
(Cairo <$> parseCairo)
|
||||
(progDesc "Compile to Cairo")
|
||||
supportedTargets :: [(CompileTarget, Parser CompileCommand)]
|
||||
supportedTargets =
|
||||
[ (AppTargetVampIR, Vampir <$> parseVampir),
|
||||
(AppTargetAnoma, Anoma <$> parseAnoma),
|
||||
(AppTargetCairo, Cairo <$> parseCairo),
|
||||
(AppTargetGeb, Geb <$> parseGeb),
|
||||
(AppTargetWasm32Wasi, Wasi <$> parseWasi),
|
||||
(AppTargetNative64, Native <$> parseNative)
|
||||
]
|
||||
|
@ -3,19 +3,16 @@ module Commands.Compile.Vampir where
|
||||
import Commands.Base
|
||||
import Commands.Compile.Vampir.Options
|
||||
import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Backend
|
||||
import Juvix.Compiler.Backend.VampIR.Translation qualified as VampIR
|
||||
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => VampirOptions -> Sem r ()
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => VampirOptions 'InputMain -> Sem r ()
|
||||
runCommand opts = do
|
||||
let opts' = opts ^. vampirCompileCommonOptions
|
||||
inputFile = opts' ^. compileInputFile
|
||||
moutputFile = opts' ^. compileOutputFile
|
||||
coreRes <- fromCompileCommonOptionsMain opts' >>= compileToCore
|
||||
entryPoint <-
|
||||
set entryPointTarget (Just TargetVampIR)
|
||||
. set entryPointUnsafe (opts ^. vampirUnsafe)
|
||||
. applyCompileCommonOptions opts'
|
||||
applyOptions opts
|
||||
<$> getEntryPoint (opts' ^. compileInputFile)
|
||||
vampirFile :: Path Abs File <- getOutputFile FileExtVampIR inputFile moutputFile
|
||||
r <-
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Compile.Vampir.Options
|
||||
( module Commands.Compile.Vampir.Options,
|
||||
module Commands.Compile.CommonOptions,
|
||||
@ -7,20 +9,27 @@ where
|
||||
import Commands.Compile.CommonOptions
|
||||
import CommonOptions
|
||||
|
||||
data VampirOptions = VampirOptions
|
||||
{ _vampirCompileCommonOptions :: CompileCommonOptionsMain,
|
||||
data VampirOptions (k :: InputKind) = VampirOptions
|
||||
{ _vampirCompileCommonOptions :: CompileCommonOptions k,
|
||||
_vampirUnsafe :: Bool
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (VampirOptions k)
|
||||
|
||||
makeLenses ''VampirOptions
|
||||
|
||||
parseVampir :: Parser VampirOptions
|
||||
parseVampir :: (SingI k) => Parser (VampirOptions k)
|
||||
parseVampir = do
|
||||
_vampirCompileCommonOptions <- parseCompileCommonOptionsMain
|
||||
_vampirCompileCommonOptions <- parseCompileCommonOptions
|
||||
_vampirUnsafe <-
|
||||
switch
|
||||
( long "unsafe"
|
||||
<> help "Disable range and error checking (for targets: vampir)"
|
||||
)
|
||||
pure VampirOptions {..}
|
||||
|
||||
instance EntryPointOptions (VampirOptions k) where
|
||||
applyOptions opts =
|
||||
set entryPointTarget (Just TargetVampIR)
|
||||
. set entryPointUnsafe (opts ^. vampirUnsafe)
|
||||
. applyOptions (opts ^. vampirCompileCommonOptions)
|
||||
|
@ -3,40 +3,10 @@ module Commands.Compile.Wasi where
|
||||
import Commands.Base
|
||||
import Commands.Compile.NativeWasiHelper as Helper
|
||||
import Commands.Compile.Wasi.Options
|
||||
import Data.ByteString qualified as BS
|
||||
import Data.FileEmbed qualified as FE
|
||||
import Juvix.Compiler.Backend
|
||||
|
||||
runCommand :: forall r. (Members '[App, TaggedLock, EmbedIO] r) => WasiOptions -> Sem r ()
|
||||
runCommand opts =
|
||||
Helper.runCommand
|
||||
HelperOptions
|
||||
{ _helperCStage = opts ^. wasiCStage,
|
||||
_helperTarget = TargetCWasm32Wasi,
|
||||
_helperCompileCommonOptions = opts ^. wasiCompileCommonOptions,
|
||||
_helperClangBackend = ClangWasi,
|
||||
_helperPrepareRuntime = prepareRuntime,
|
||||
_helperDefaultOutputFile = \inputFile baseOutputFile ->
|
||||
case opts ^. wasiCStage of
|
||||
CSource -> replaceExtension' cFileExt inputFile
|
||||
CPreprocess -> addExtension' cFileExt (addExtension' ".out" (removeExtension' inputFile))
|
||||
CAssembly -> replaceExtension' ".wat" inputFile
|
||||
CExecutable -> replaceExtension' ".wasm" baseOutputFile
|
||||
}
|
||||
where
|
||||
prepareRuntime ::
|
||||
forall s.
|
||||
(Members '[App, EmbedIO] s) =>
|
||||
Sem s ()
|
||||
prepareRuntime = writeRuntime runtime
|
||||
where
|
||||
runtime :: BS.ByteString
|
||||
runtime
|
||||
| opts ^. wasiCompileCommonOptions . compileDebug = wasiDebugRuntime
|
||||
| otherwise = wasiReleaseRuntime
|
||||
where
|
||||
wasiReleaseRuntime :: BS.ByteString
|
||||
wasiReleaseRuntime = $(FE.makeRelativeToProject "runtime/_build.wasm32-wasi/libjuvix.a" >>= FE.embedFile)
|
||||
|
||||
wasiDebugRuntime :: BS.ByteString
|
||||
wasiDebugRuntime = $(FE.makeRelativeToProject "runtime/_build.wasm32-wasi-debug/libjuvix.a" >>= FE.embedFile)
|
||||
runCommand ::
|
||||
forall r.
|
||||
(Members '[App, TaggedLock, EmbedIO] r) =>
|
||||
WasiOptions 'InputMain ->
|
||||
Sem r ()
|
||||
runCommand = Helper.runCommand . wasiHelperOptions
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Compile.Wasi.Options
|
||||
( module Commands.Compile.Wasi.Options,
|
||||
module Commands.Compile.CommonOptions,
|
||||
@ -8,31 +10,60 @@ where
|
||||
import Commands.Base
|
||||
import Commands.Compile.CStage
|
||||
import Commands.Compile.CommonOptions
|
||||
import Commands.Compile.NativeWasiHelper as Helper
|
||||
import Data.ByteString qualified as BS
|
||||
import Data.FileEmbed qualified as FE
|
||||
|
||||
data WasiOptions = WasiOptions
|
||||
{ _wasiCompileCommonOptions :: CompileCommonOptionsMain,
|
||||
data WasiOptions (k :: InputKind) = WasiOptions
|
||||
{ _wasiCompileCommonOptions :: CompileCommonOptions k,
|
||||
_wasiCStage :: CStage
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (WasiOptions k)
|
||||
|
||||
makeLenses ''WasiOptions
|
||||
|
||||
parseWasi :: Parser WasiOptions
|
||||
parseWasi :: (SingI k) => Parser (WasiOptions k)
|
||||
parseWasi = do
|
||||
_wasiCompileCommonOptions <- parseCompileCommonOptionsMain
|
||||
_wasiCompileCommonOptions <- parseCompileCommonOptions
|
||||
_wasiCStage <- parseCStage
|
||||
pure WasiOptions {..}
|
||||
|
||||
wasiOutputFile :: (Member App r) => WasiOptions -> Sem r (Path Abs File)
|
||||
wasiOutputFile opts =
|
||||
case opts ^. wasiCompileCommonOptions . compileOutputFile of
|
||||
Just f -> fromAppFile f
|
||||
Nothing -> do
|
||||
inputFile <- getMainFile (opts ^. wasiCompileCommonOptions . compileInputFile)
|
||||
invokeDir <- askInvokeDir
|
||||
let baseOutputFile = invokeDir <//> filename inputFile
|
||||
return $ case opts ^. wasiCStage of
|
||||
wasiHelperOptions :: WasiOptions k -> Helper.HelperOptions k
|
||||
wasiHelperOptions opts =
|
||||
Helper.HelperOptions
|
||||
{ _helperCStage = opts ^. wasiCStage,
|
||||
_helperTarget = TargetCWasm32Wasi,
|
||||
_helperCompileCommonOptions = opts ^. wasiCompileCommonOptions,
|
||||
_helperClangBackend = ClangWasi,
|
||||
_helperPrepareRuntime = prepareRuntime,
|
||||
_helperDefaultOutputFile = wasiDefaultOutputFile
|
||||
}
|
||||
where
|
||||
prepareRuntime ::
|
||||
forall s.
|
||||
(Members '[App, EmbedIO] s) =>
|
||||
Sem s ()
|
||||
prepareRuntime = writeRuntime runtime
|
||||
where
|
||||
runtime :: BS.ByteString
|
||||
runtime
|
||||
| opts ^. wasiCompileCommonOptions . compileDebug = wasiDebugRuntime
|
||||
| otherwise = wasiReleaseRuntime
|
||||
where
|
||||
wasiReleaseRuntime :: BS.ByteString
|
||||
wasiReleaseRuntime = $(FE.makeRelativeToProject "runtime/_build.wasm32-wasi/libjuvix.a" >>= FE.embedFile)
|
||||
|
||||
wasiDebugRuntime :: BS.ByteString
|
||||
wasiDebugRuntime = $(FE.makeRelativeToProject "runtime/_build.wasm32-wasi-debug/libjuvix.a" >>= FE.embedFile)
|
||||
|
||||
wasiDefaultOutputFile :: Path Abs File -> Path Abs File -> Path Abs File
|
||||
wasiDefaultOutputFile inputFile baseOutputFile =
|
||||
case opts ^. wasiCStage of
|
||||
CSource -> replaceExtension' cFileExt inputFile
|
||||
CPreprocess -> addExtension' cFileExt (addExtension' ".out" (removeExtension' inputFile))
|
||||
CAssembly -> replaceExtension' ".wat" inputFile
|
||||
CExecutable -> removeExtension' baseOutputFile
|
||||
CExecutable -> replaceExtension' ".wasm" baseOutputFile
|
||||
|
||||
instance EntryPointOptions (WasiOptions k) where
|
||||
applyOptions opts = applyOptions (opts ^. wasiCompileCommonOptions)
|
||||
|
@ -26,7 +26,7 @@ runCommand opts = do
|
||||
_entryPointDebug = opts ^. compileDebug
|
||||
}
|
||||
case opts ^. compileTarget of
|
||||
TargetReg -> do
|
||||
AppTargetReg -> do
|
||||
regFile <- Compile.outputFile opts
|
||||
r <-
|
||||
runReader entryPoint
|
||||
@ -36,7 +36,7 @@ runCommand opts = do
|
||||
tab' <- getRight r
|
||||
let code = Reg.ppPrint tab' tab'
|
||||
writeFileEnsureLn regFile code
|
||||
TargetCasm -> do
|
||||
AppTargetCasm -> do
|
||||
casmFile <- Compile.outputFile opts
|
||||
r <-
|
||||
runReader entryPoint
|
||||
@ -45,7 +45,7 @@ runCommand opts = do
|
||||
$ tab
|
||||
Casm.Result {..} <- getRight r
|
||||
writeFileEnsureLn casmFile (toPlainText $ Casm.ppProgram _resultCode)
|
||||
TargetCairo -> do
|
||||
AppTargetCairo -> do
|
||||
cairoFile <- Compile.outputFile opts
|
||||
r <-
|
||||
runReader entryPoint
|
||||
@ -74,17 +74,17 @@ runCommand opts = do
|
||||
where
|
||||
getTarget :: CompileTarget -> Sem r Backend.Target
|
||||
getTarget = \case
|
||||
TargetWasm32Wasi -> return Backend.TargetCWasm32Wasi
|
||||
TargetNative64 -> return Backend.TargetCNative64
|
||||
TargetReg -> return Backend.TargetReg
|
||||
TargetCasm -> return Backend.TargetCairo
|
||||
TargetCairo -> return Backend.TargetCairo
|
||||
TargetAnoma -> err "Anoma"
|
||||
TargetTree -> err "JuvixTree"
|
||||
TargetGeb -> err "GEB"
|
||||
TargetVampIR -> err "VampIR"
|
||||
TargetCore -> err "JuvixCore"
|
||||
TargetAsm -> err "JuvixAsm"
|
||||
AppTargetWasm32Wasi -> return Backend.TargetCWasm32Wasi
|
||||
AppTargetNative64 -> return Backend.TargetCNative64
|
||||
AppTargetReg -> return Backend.TargetReg
|
||||
AppTargetCasm -> return Backend.TargetCairo
|
||||
AppTargetCairo -> return Backend.TargetCairo
|
||||
AppTargetAnoma -> err "Anoma"
|
||||
AppTargetTree -> err "JuvixTree"
|
||||
AppTargetGeb -> err "GEB"
|
||||
AppTargetVampIR -> err "VampIR"
|
||||
AppTargetCore -> err "JuvixCore"
|
||||
AppTargetAsm -> err "JuvixAsm"
|
||||
where
|
||||
err :: Text -> Sem r a
|
||||
err tgt = exitMsg (ExitFailure 1) ("error: " <> tgt <> " target not supported for JuvixAsm")
|
||||
|
@ -6,19 +6,17 @@ where
|
||||
|
||||
import Commands.Extra.Compile.Options
|
||||
import CommonOptions
|
||||
import Data.List.NonEmpty qualified as NonEmpty
|
||||
|
||||
type AsmCompileOptions = CompileOptions
|
||||
|
||||
asmSupportedTargets :: NonEmpty CompileTarget
|
||||
asmSupportedTargets =
|
||||
NonEmpty.fromList
|
||||
[ TargetWasm32Wasi,
|
||||
TargetNative64,
|
||||
TargetReg,
|
||||
TargetCasm,
|
||||
TargetCairo
|
||||
]
|
||||
AppTargetWasm32Wasi
|
||||
:| [ AppTargetNative64,
|
||||
AppTargetReg,
|
||||
AppTargetCasm,
|
||||
AppTargetCairo
|
||||
]
|
||||
|
||||
parseAsmCompileOptions :: Parser AsmCompileOptions
|
||||
parseAsmCompileOptions =
|
||||
|
@ -37,17 +37,17 @@ runCommand opts = do
|
||||
|
||||
getTarget :: CompileTarget -> Sem r Backend.Target
|
||||
getTarget = \case
|
||||
TargetCairo -> return Backend.TargetCairo
|
||||
TargetWasm32Wasi -> err "WASM"
|
||||
TargetNative64 -> err "native"
|
||||
TargetCasm -> err "CASM"
|
||||
TargetReg -> err "JuvixReg"
|
||||
TargetAnoma -> err "Anoma"
|
||||
TargetTree -> err "JuvixTree"
|
||||
TargetGeb -> err "GEB"
|
||||
TargetVampIR -> err "VampIR"
|
||||
TargetCore -> err "JuvixCore"
|
||||
TargetAsm -> err "JuvixAsm"
|
||||
AppTargetCairo -> return Backend.TargetCairo
|
||||
AppTargetWasm32Wasi -> err "WASM"
|
||||
AppTargetNative64 -> err "native"
|
||||
AppTargetCasm -> err "CASM"
|
||||
AppTargetReg -> err "JuvixReg"
|
||||
AppTargetAnoma -> err "Anoma"
|
||||
AppTargetTree -> err "JuvixTree"
|
||||
AppTargetGeb -> err "GEB"
|
||||
AppTargetVampIR -> err "VampIR"
|
||||
AppTargetCore -> err "JuvixCore"
|
||||
AppTargetAsm -> err "JuvixAsm"
|
||||
where
|
||||
err :: Text -> Sem r a
|
||||
err tgt = exitMsg (ExitFailure 1) ("error: " <> tgt <> " target not supported for CASM")
|
||||
|
@ -6,13 +6,11 @@ where
|
||||
|
||||
import Commands.Extra.Compile.Options
|
||||
import CommonOptions
|
||||
import Data.List.NonEmpty qualified as NonEmpty
|
||||
|
||||
casmSupportedTargets :: NonEmpty CompileTarget
|
||||
casmSupportedTargets =
|
||||
NonEmpty.fromList
|
||||
[ TargetCairo
|
||||
]
|
||||
AppTargetCairo
|
||||
:| []
|
||||
|
||||
parseCasmCompileOptions :: Parser CompileOptions
|
||||
parseCasmCompileOptions =
|
||||
|
@ -15,7 +15,7 @@ runCommand opts = do
|
||||
inputFile :: Path Abs File <- getMainFile (Just sinputFile)
|
||||
ep <- getEntryPoint (Just sinputFile)
|
||||
s' <- readFile inputFile
|
||||
tab <- getRight (mapLeft JuvixError (Core.runParserMain inputFile defaultModuleId mempty s'))
|
||||
tab <- getRight (Core.runParserMain inputFile defaultModuleId mempty s')
|
||||
r <- runReader ep . runError @JuvixError $ coreToAsm (Core.moduleFromInfoTable tab)
|
||||
tab' <- getRight r
|
||||
if
|
||||
|
@ -10,21 +10,21 @@ runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => CompileOption
|
||||
runCommand opts = do
|
||||
file <- getMainFile (Just (opts ^. compileInputFile))
|
||||
s <- readFile file
|
||||
tab <- getRight (mapLeft JuvixError (Core.runParserMain file defaultModuleId mempty s))
|
||||
tab <- getRight (Core.runParserMain file defaultModuleId mempty s)
|
||||
let arg =
|
||||
PipelineArg
|
||||
{ _pipelineArgOptions = opts,
|
||||
_pipelineArgModule = Core.moduleFromInfoTable tab
|
||||
}
|
||||
case opts ^. compileTarget of
|
||||
TargetWasm32Wasi -> runCPipeline arg
|
||||
TargetNative64 -> runCPipeline arg
|
||||
TargetGeb -> runGebPipeline arg
|
||||
TargetVampIR -> runVampIRPipeline arg
|
||||
TargetCore -> return ()
|
||||
TargetAsm -> runAsmPipeline arg
|
||||
TargetReg -> runRegPipeline arg
|
||||
TargetTree -> runTreePipeline arg
|
||||
TargetAnoma -> runAnomaPipeline arg
|
||||
TargetCasm -> runCasmPipeline arg
|
||||
TargetCairo -> runCairoPipeline arg
|
||||
AppTargetWasm32Wasi -> runCPipeline arg
|
||||
AppTargetNative64 -> runCPipeline arg
|
||||
AppTargetGeb -> runGebPipeline arg
|
||||
AppTargetVampIR -> runVampIRPipeline arg
|
||||
AppTargetCore -> return ()
|
||||
AppTargetAsm -> runAsmPipeline arg
|
||||
AppTargetReg -> runRegPipeline arg
|
||||
AppTargetTree -> runTreePipeline arg
|
||||
AppTargetAnoma -> runAnomaPipeline arg
|
||||
AppTargetCasm -> runCasmPipeline arg
|
||||
AppTargetCairo -> runCairoPipeline arg
|
||||
|
@ -2,7 +2,7 @@ module Commands.Dev.Core.Compile.Base where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Dev.Core.Compile.Options
|
||||
import Commands.Dev.Tree.Compile.Base (outputAnomaResult)
|
||||
import Commands.Dev.Tree.CompileOld.Base (outputAnomaResult)
|
||||
import Commands.Extra.Compile qualified as Compile
|
||||
import Data.Aeson qualified as JSON
|
||||
import Juvix.Compiler.Asm.Pretty qualified as Asm
|
||||
@ -38,17 +38,17 @@ getEntry PipelineArg {..} = do
|
||||
where
|
||||
getTarget :: CompileTarget -> Backend.Target
|
||||
getTarget = \case
|
||||
TargetWasm32Wasi -> Backend.TargetCWasm32Wasi
|
||||
TargetNative64 -> Backend.TargetCNative64
|
||||
TargetGeb -> Backend.TargetGeb
|
||||
TargetVampIR -> Backend.TargetVampIR
|
||||
TargetCore -> Backend.TargetCore
|
||||
TargetAsm -> Backend.TargetAsm
|
||||
TargetReg -> Backend.TargetReg
|
||||
TargetTree -> Backend.TargetTree
|
||||
TargetAnoma -> Backend.TargetAnoma
|
||||
TargetCasm -> Backend.TargetCairo
|
||||
TargetCairo -> Backend.TargetCairo
|
||||
AppTargetWasm32Wasi -> Backend.TargetCWasm32Wasi
|
||||
AppTargetNative64 -> Backend.TargetCNative64
|
||||
AppTargetGeb -> Backend.TargetGeb
|
||||
AppTargetVampIR -> Backend.TargetVampIR
|
||||
AppTargetCore -> Backend.TargetCore
|
||||
AppTargetAsm -> Backend.TargetAsm
|
||||
AppTargetReg -> Backend.TargetReg
|
||||
AppTargetTree -> Backend.TargetTree
|
||||
AppTargetAnoma -> Backend.TargetAnoma
|
||||
AppTargetCasm -> Backend.TargetCairo
|
||||
AppTargetCairo -> Backend.TargetCairo
|
||||
|
||||
defaultOptLevel :: Int
|
||||
defaultOptLevel
|
||||
|
@ -1,27 +0,0 @@
|
||||
module Commands.Dev.Core.Compile.BaseNew where
|
||||
|
||||
import Commands.Compile.CommonOptions
|
||||
import Juvix.Compiler.Backend qualified as Backend
|
||||
import Juvix.Compiler.Core.Data.Module qualified as Core
|
||||
|
||||
data PipelineArg = PipelineArg
|
||||
{ _pipelineArgOptions :: CompileCommonOptions,
|
||||
_pipelineArgTarget :: Backend.Target,
|
||||
_pipelineArgModule :: Core.Module
|
||||
}
|
||||
|
||||
-- getEntry :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r EntryPoint
|
||||
-- getEntry PipelineArg {..} = do
|
||||
-- ep <- getEntryPoint (Just (_pipelineArgOptions ^. compileInputFile))
|
||||
-- return $
|
||||
-- ep
|
||||
-- { _entryPointTarget = Just _pipelineArgTarget,
|
||||
-- _entryPointDebug = _pipelineArgOptions ^. compileDebug,
|
||||
-- _entryPointOptimizationLevel = fromMaybe defaultOptLevel (_pipelineArgOptions ^. compileOptimizationLevel),
|
||||
-- _entryPointInliningDepth = _pipelineArgOptions ^. compileInliningDepth
|
||||
-- }
|
||||
-- where
|
||||
-- defaultOptLevel :: Int
|
||||
-- defaultOptLevel
|
||||
-- | _pipelineArgOptions ^. compileDebug = 0
|
||||
-- | otherwise = defaultOptimizationLevel
|
@ -13,15 +13,15 @@ type CoreCompileOptions = CompileOptions
|
||||
coreSupportedTargets :: NonEmpty CompileTarget
|
||||
coreSupportedTargets =
|
||||
NonEmpty.fromList
|
||||
[ TargetNative64,
|
||||
TargetWasm32Wasi,
|
||||
TargetGeb,
|
||||
TargetVampIR,
|
||||
TargetTree,
|
||||
TargetAsm,
|
||||
TargetReg,
|
||||
TargetCasm,
|
||||
TargetCairo
|
||||
[ AppTargetNative64,
|
||||
AppTargetWasm32Wasi,
|
||||
AppTargetGeb,
|
||||
AppTargetVampIR,
|
||||
AppTargetTree,
|
||||
AppTargetAsm,
|
||||
AppTargetReg,
|
||||
AppTargetCasm,
|
||||
AppTargetCairo
|
||||
]
|
||||
|
||||
parseCoreCompileOptions :: Parser CoreCompileOptions
|
||||
|
@ -23,9 +23,9 @@ runCommand opts = do
|
||||
gopts <- askGlobalOptions
|
||||
inputFile :: Path Abs File <- fromAppPathFile sinputFile
|
||||
s' <- readFile inputFile
|
||||
tab <- getRight (mapLeft JuvixError (Core.runParserMain inputFile defaultModuleId mempty s'))
|
||||
tab <- getRight (Core.runParserMain inputFile defaultModuleId mempty s')
|
||||
let r = run $ runReader (project @GlobalOptions @Core.CoreOptions gopts) $ runError @JuvixError $ Core.applyTransformations (project opts ^. coreReadTransformations) (Core.moduleFromInfoTable tab)
|
||||
tab0 <- getRight $ mapLeft JuvixError r
|
||||
tab0 <- getRight r
|
||||
let tab' = Core.computeCombinedInfoTable $ if project opts ^. coreReadNoDisambiguate then tab0 else Core.disambiguateNames tab0
|
||||
Scoper.scopeTrace tab'
|
||||
unless (project opts ^. coreReadNoPrint) $ do
|
||||
|
@ -11,12 +11,13 @@ runCommand opts = do
|
||||
gopts <- askGlobalOptions
|
||||
inputFile :: Path Abs File <- fromAppPathFile sinputFile
|
||||
s' <- readFile inputFile
|
||||
(tab, _) <- getRight (mapLeft JuvixError (Core.runParser inputFile defaultModuleId mempty s'))
|
||||
(tab, _) <- getRight (Core.runParser inputFile defaultModuleId mempty s')
|
||||
let r =
|
||||
run $
|
||||
runReader (project gopts) $
|
||||
runError @JuvixError (Core.toStripped' Core.Identity (Core.moduleFromInfoTable tab) :: Sem '[Error JuvixError, Reader Core.CoreOptions] Core.Module)
|
||||
tab' <- getRight $ mapLeft JuvixError $ mapRight (Stripped.fromCore (project gopts ^. Core.optFieldSize) . Core.computeCombinedInfoTable) r
|
||||
run
|
||||
. runReader (project' @Core.CoreOptions gopts)
|
||||
. runError @JuvixError
|
||||
$ Core.toStripped' Core.Identity (Core.moduleFromInfoTable tab)
|
||||
tab' <- getRight $ mapRight (Stripped.fromCore (project gopts ^. Core.optFieldSize) . Core.computeCombinedInfoTable) r
|
||||
unless (project opts ^. coreStripNoPrint) $ do
|
||||
renderStdOut (Core.ppOut opts tab')
|
||||
where
|
||||
|
@ -6,7 +6,7 @@ import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Asm.Data.InfoTable
|
||||
import Juvix.Compiler.Asm.Pretty
|
||||
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => AsmOptions -> Sem r ()
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => AsmOptions 'InputMain -> Sem r ()
|
||||
runCommand opts = do
|
||||
let inputFile = opts ^. asmCompileCommonOptions . compileInputFile
|
||||
moutputFile = opts ^. asmCompileCommonOptions . compileOutputFile
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Dev.DevCompile.Asm.Options
|
||||
( module Commands.Dev.DevCompile.Asm.Options,
|
||||
module Commands.Compile.CommonOptions,
|
||||
@ -7,14 +9,18 @@ where
|
||||
import Commands.Compile.CommonOptions
|
||||
import CommonOptions
|
||||
|
||||
data AsmOptions = AsmOptions
|
||||
{ _asmCompileCommonOptions :: CompileCommonOptionsMain
|
||||
data AsmOptions (k :: InputKind) = AsmOptions
|
||||
{ _asmCompileCommonOptions :: CompileCommonOptions k
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (AsmOptions k)
|
||||
|
||||
makeLenses ''AsmOptions
|
||||
|
||||
parseAsm :: Parser AsmOptions
|
||||
parseAsm :: forall k. (SingI k) => Parser (AsmOptions k)
|
||||
parseAsm = do
|
||||
_asmCompileCommonOptions <- parseCompileCommonOptionsMain
|
||||
_asmCompileCommonOptions <- parseCompileCommonOptions
|
||||
pure AsmOptions {..}
|
||||
|
||||
instance EntryPointOptions (AsmOptions k) where
|
||||
applyOptions = applyOptions . (^. asmCompileCommonOptions)
|
||||
|
@ -6,7 +6,7 @@ import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Casm.Data.Result
|
||||
import Juvix.Compiler.Casm.Pretty
|
||||
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => CasmOptions -> Sem r ()
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => CasmOptions 'InputMain -> Sem r ()
|
||||
runCommand opts = do
|
||||
let inputFile = opts ^. casmCompileCommonOptions . compileInputFile
|
||||
moutputFile = opts ^. casmCompileCommonOptions . compileOutputFile
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Dev.DevCompile.Casm.Options
|
||||
( module Commands.Dev.DevCompile.Casm.Options,
|
||||
module Commands.Compile.CommonOptions,
|
||||
@ -7,14 +9,20 @@ where
|
||||
import Commands.Compile.CommonOptions
|
||||
import CommonOptions
|
||||
|
||||
data CasmOptions = CasmOptions
|
||||
{ _casmCompileCommonOptions :: CompileCommonOptionsMain
|
||||
data CasmOptions (k :: InputKind) = CasmOptions
|
||||
{ _casmCompileCommonOptions :: CompileCommonOptions k
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (CasmOptions k)
|
||||
|
||||
makeLenses ''CasmOptions
|
||||
|
||||
parseCasm :: Parser CasmOptions
|
||||
parseCasm :: (SingI k) => Parser (CasmOptions k)
|
||||
parseCasm = do
|
||||
_casmCompileCommonOptions <- parseCompileCommonOptionsMain
|
||||
_casmCompileCommonOptions <- parseCompileCommonOptions
|
||||
pure CasmOptions {..}
|
||||
|
||||
instance EntryPointOptions (CasmOptions k) where
|
||||
applyOptions opts =
|
||||
set entryPointTarget (Just TargetCairo)
|
||||
. applyOptions (opts ^. casmCompileCommonOptions)
|
||||
|
@ -10,7 +10,11 @@ import Juvix.Compiler.Core.Transformation qualified as Core
|
||||
compileTransformations :: [Core.TransformationId]
|
||||
compileTransformations = [Core.CombineInfoTables, Core.FilterUnreachable, Core.DisambiguateNames]
|
||||
|
||||
runCommand :: forall r. (Members '[App, TaggedLock, EmbedIO] r) => CoreOptions -> Sem r ()
|
||||
runCommand ::
|
||||
forall r.
|
||||
(Members '[App, TaggedLock, EmbedIO] r) =>
|
||||
CoreOptions 'InputMain ->
|
||||
Sem r ()
|
||||
runCommand opts = do
|
||||
let inputFile = opts ^. coreCompileCommonOptions . compileInputFile
|
||||
moutputFile = opts ^. coreCompileCommonOptions . compileOutputFile
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Dev.DevCompile.Core.Options
|
||||
( module Commands.Dev.DevCompile.Core.Options,
|
||||
module Commands.Compile.CommonOptions,
|
||||
@ -7,14 +9,18 @@ where
|
||||
import Commands.Compile.CommonOptions
|
||||
import CommonOptions
|
||||
|
||||
data CoreOptions = CoreOptions
|
||||
{ _coreCompileCommonOptions :: CompileCommonOptionsMain
|
||||
data CoreOptions (k :: InputKind) = CoreOptions
|
||||
{ _coreCompileCommonOptions :: CompileCommonOptions k
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (CoreOptions k)
|
||||
|
||||
makeLenses ''CoreOptions
|
||||
|
||||
parseCore :: Parser CoreOptions
|
||||
parseCore :: (SingI k) => Parser (CoreOptions k)
|
||||
parseCore = do
|
||||
_coreCompileCommonOptions <- parseCompileCommonOptionsMain
|
||||
_coreCompileCommonOptions <- parseCompileCommonOptions
|
||||
pure CoreOptions {..}
|
||||
|
||||
instance EntryPointOptions (CoreOptions k) where
|
||||
applyOptions = applyOptions . (^. coreCompileCommonOptions)
|
||||
|
@ -8,11 +8,11 @@ import Commands.Dev.DevCompile.Tree.Options
|
||||
import CommonOptions
|
||||
|
||||
data DevCompileCommand
|
||||
= Core CoreOptions
|
||||
| Asm AsmOptions
|
||||
| Reg RegOptions
|
||||
| Tree TreeOptions
|
||||
| Casm CasmOptions
|
||||
= Core (CoreOptions 'InputMain)
|
||||
| Asm (AsmOptions 'InputMain)
|
||||
| Reg (RegOptions 'InputMain)
|
||||
| Tree (TreeOptions 'InputMain)
|
||||
| Casm (CasmOptions 'InputMain)
|
||||
deriving stock (Data)
|
||||
|
||||
parseDevCompileCommand :: Parser DevCompileCommand
|
||||
|
@ -6,7 +6,10 @@ import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Reg.Data.InfoTable
|
||||
import Juvix.Compiler.Reg.Pretty
|
||||
|
||||
runCommand :: (Members '[App, EmbedIO, TaggedLock] r) => RegOptions -> Sem r ()
|
||||
runCommand ::
|
||||
(Members '[App, EmbedIO, TaggedLock] r) =>
|
||||
RegOptions 'InputMain ->
|
||||
Sem r ()
|
||||
runCommand opts = do
|
||||
let inputFile = opts ^. regCompileCommonOptions . compileInputFile
|
||||
moutputFile = opts ^. regCompileCommonOptions . compileOutputFile
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Dev.DevCompile.Reg.Options
|
||||
( module Commands.Dev.DevCompile.Reg.Options,
|
||||
module Commands.Compile.CommonOptions,
|
||||
@ -7,14 +9,20 @@ where
|
||||
import Commands.Compile.CommonOptions
|
||||
import CommonOptions
|
||||
|
||||
data RegOptions = RegOptions
|
||||
{ _regCompileCommonOptions :: CompileCommonOptionsMain
|
||||
data RegOptions (k :: InputKind) = RegOptions
|
||||
{ _regCompileCommonOptions :: CompileCommonOptions k
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (RegOptions k)
|
||||
|
||||
makeLenses ''RegOptions
|
||||
|
||||
parseReg :: Parser RegOptions
|
||||
parseReg :: (SingI k) => Parser (RegOptions k)
|
||||
parseReg = do
|
||||
_regCompileCommonOptions <- parseCompileCommonOptionsMain
|
||||
_regCompileCommonOptions <- parseCompileCommonOptions
|
||||
pure RegOptions {..}
|
||||
|
||||
instance EntryPointOptions (RegOptions k) where
|
||||
applyOptions opts =
|
||||
set entryPointTarget (Just TargetReg)
|
||||
. applyOptions (opts ^. regCompileCommonOptions)
|
||||
|
@ -6,7 +6,10 @@ import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Tree.Data.InfoTable
|
||||
import Juvix.Compiler.Tree.Pretty
|
||||
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => TreeOptions -> Sem r ()
|
||||
runCommand ::
|
||||
(Members '[App, TaggedLock, EmbedIO] r) =>
|
||||
TreeOptions 'InputMain ->
|
||||
Sem r ()
|
||||
runCommand opts = do
|
||||
let inputFile = opts ^. treeCompileCommonOptions . compileInputFile
|
||||
moutputFile = opts ^. treeCompileCommonOptions . compileOutputFile
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Commands.Dev.DevCompile.Tree.Options
|
||||
( module Commands.Dev.DevCompile.Tree.Options,
|
||||
module Commands.Compile.CommonOptions,
|
||||
@ -7,14 +9,18 @@ where
|
||||
import Commands.Compile.CommonOptions
|
||||
import CommonOptions
|
||||
|
||||
data TreeOptions = TreeOptions
|
||||
{ _treeCompileCommonOptions :: CompileCommonOptionsMain
|
||||
data TreeOptions (k :: InputKind) = TreeOptions
|
||||
{ _treeCompileCommonOptions :: CompileCommonOptions k
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
deriving stock instance (Typeable k, Data (InputFileType k)) => Data (TreeOptions k)
|
||||
|
||||
makeLenses ''TreeOptions
|
||||
|
||||
parseTree :: Parser TreeOptions
|
||||
parseTree :: (SingI k) => Parser (TreeOptions k)
|
||||
parseTree = do
|
||||
_treeCompileCommonOptions <- parseCompileCommonOptionsMain
|
||||
_treeCompileCommonOptions <- parseCompileCommonOptions
|
||||
pure TreeOptions {..}
|
||||
|
||||
instance EntryPointOptions (TreeOptions k) where
|
||||
applyOptions = applyOptions . (^. treeCompileCommonOptions)
|
||||
|
@ -25,7 +25,7 @@ runCommand opts = do
|
||||
_entryPointDebug = opts ^. compileDebug
|
||||
}
|
||||
case opts ^. compileTarget of
|
||||
TargetCasm -> do
|
||||
AppTargetCasm -> do
|
||||
casmFile <- Compile.outputFile opts
|
||||
r <-
|
||||
runReader entryPoint
|
||||
@ -34,7 +34,7 @@ runCommand opts = do
|
||||
$ tab
|
||||
Casm.Result {..} <- getRight r
|
||||
writeFileEnsureLn casmFile (toPlainText $ Casm.ppProgram _resultCode)
|
||||
TargetCairo -> do
|
||||
AppTargetCairo -> do
|
||||
cairoFile <- Compile.outputFile opts
|
||||
r <-
|
||||
runReader entryPoint
|
||||
@ -63,17 +63,17 @@ runCommand opts = do
|
||||
where
|
||||
getTarget :: CompileTarget -> Sem r Backend.Target
|
||||
getTarget = \case
|
||||
TargetWasm32Wasi -> return Backend.TargetCWasm32Wasi
|
||||
TargetNative64 -> return Backend.TargetCNative64
|
||||
TargetCasm -> return Backend.TargetCairo
|
||||
TargetCairo -> return Backend.TargetCairo
|
||||
TargetReg -> err "JuvixReg"
|
||||
TargetAnoma -> err "Anoma"
|
||||
TargetTree -> err "JuvixTree"
|
||||
TargetGeb -> err "GEB"
|
||||
TargetVampIR -> err "VampIR"
|
||||
TargetCore -> err "JuvixCore"
|
||||
TargetAsm -> err "JuvixAsm"
|
||||
AppTargetWasm32Wasi -> return Backend.TargetCWasm32Wasi
|
||||
AppTargetNative64 -> return Backend.TargetCNative64
|
||||
AppTargetCasm -> return Backend.TargetCairo
|
||||
AppTargetCairo -> return Backend.TargetCairo
|
||||
AppTargetReg -> err "JuvixReg"
|
||||
AppTargetAnoma -> err "Anoma"
|
||||
AppTargetTree -> err "JuvixTree"
|
||||
AppTargetGeb -> err "GEB"
|
||||
AppTargetVampIR -> err "VampIR"
|
||||
AppTargetCore -> err "JuvixCore"
|
||||
AppTargetAsm -> err "JuvixAsm"
|
||||
where
|
||||
err :: Text -> Sem r a
|
||||
err tgt = exitMsg (ExitFailure 1) ("error: " <> tgt <> " target not supported for JuvixReg")
|
||||
|
@ -6,16 +6,14 @@ where
|
||||
|
||||
import Commands.Extra.Compile.Options
|
||||
import CommonOptions
|
||||
import Data.List.NonEmpty qualified as NonEmpty
|
||||
|
||||
regSupportedTargets :: NonEmpty CompileTarget
|
||||
regSupportedTargets =
|
||||
NonEmpty.fromList
|
||||
[ TargetNative64,
|
||||
TargetWasm32Wasi,
|
||||
TargetCasm,
|
||||
TargetCairo
|
||||
]
|
||||
AppTargetNative64
|
||||
:| [ AppTargetWasm32Wasi,
|
||||
AppTargetCasm,
|
||||
AppTargetCairo
|
||||
]
|
||||
|
||||
parseRegCompileOptions :: Parser CompileOptions
|
||||
parseRegCompileOptions =
|
||||
|
@ -2,7 +2,6 @@ module Commands.Dev.Runtime.Options where
|
||||
|
||||
import Commands.Dev.Runtime.Compile.Options
|
||||
import CommonOptions
|
||||
import Data.List.NonEmpty qualified as NonEmpty
|
||||
|
||||
newtype RuntimeCommand
|
||||
= Compile CompileOptions
|
||||
@ -10,10 +9,9 @@ newtype RuntimeCommand
|
||||
|
||||
runtimeSupportedTargets :: NonEmpty CompileTarget
|
||||
runtimeSupportedTargets =
|
||||
NonEmpty.fromList
|
||||
[ TargetNative64,
|
||||
TargetWasm32Wasi
|
||||
]
|
||||
AppTargetNative64
|
||||
:| [ AppTargetWasm32Wasi
|
||||
]
|
||||
|
||||
parseRuntimeOptions :: Parser CompileOptions
|
||||
parseRuntimeOptions =
|
||||
|
@ -12,6 +12,7 @@ runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => TreeCommand -
|
||||
runCommand = \case
|
||||
Eval opts -> Eval.runCommand opts
|
||||
Compile opts -> Compile.runCommand opts
|
||||
CompileOld {} -> impossible
|
||||
Read opts -> Read.runCommand opts
|
||||
FromAsm opts -> FromAsm.runCommand opts
|
||||
Repl opts -> Repl.runCommand opts
|
||||
|
@ -1,25 +1,25 @@
|
||||
module Commands.Dev.Tree.Compile where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Dev.Tree.Compile.Base
|
||||
import Commands.Dev.Tree.Compile.Anoma qualified as Anoma
|
||||
import Commands.Dev.Tree.Compile.Asm qualified as Asm
|
||||
import Commands.Dev.Tree.Compile.Cairo qualified as Cairo
|
||||
import Commands.Dev.Tree.Compile.Casm qualified as Casm
|
||||
import Commands.Dev.Tree.Compile.Native qualified as Native
|
||||
import Commands.Dev.Tree.Compile.Options
|
||||
import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree
|
||||
import Commands.Dev.Tree.Compile.Reg qualified as Reg
|
||||
import Commands.Dev.Tree.Compile.Wasi qualified as Wasi
|
||||
|
||||
runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => CompileOptions -> Sem r ()
|
||||
runCommand opts = do
|
||||
file <- getMainFile (Just (opts ^. compileInputFile))
|
||||
s <- readFile file
|
||||
tab <- getRight (mapLeft JuvixError (Tree.runParser file s))
|
||||
let arg = PipelineArg opts file tab
|
||||
case opts ^. compileTarget of
|
||||
TargetWasm32Wasi -> runCPipeline arg
|
||||
TargetNative64 -> runCPipeline arg
|
||||
TargetGeb -> return ()
|
||||
TargetVampIR -> return ()
|
||||
TargetCore -> return ()
|
||||
TargetAsm -> runAsmPipeline arg
|
||||
TargetReg -> runRegPipeline arg
|
||||
TargetTree -> return ()
|
||||
TargetAnoma -> runAnomaPipeline arg
|
||||
TargetCasm -> runCasmPipeline arg
|
||||
TargetCairo -> runCairoPipeline arg
|
||||
runCommand ::
|
||||
forall r.
|
||||
(Members '[EmbedIO, App, TaggedLock] r) =>
|
||||
CompileCommand ->
|
||||
Sem r ()
|
||||
runCommand = \case
|
||||
Native opts -> Native.runCommand opts
|
||||
Wasi opts -> Wasi.runCommand opts
|
||||
Asm opts -> Asm.runCommand opts
|
||||
Casm opts -> Casm.runCommand opts
|
||||
Reg opts -> Reg.runCommand opts
|
||||
Anoma opts -> Anoma.runCommand opts
|
||||
Cairo opts -> Cairo.runCommand opts
|
||||
|
31
app/Commands/Dev/Tree/Compile/Anoma.hs
Normal file
31
app/Commands/Dev/Tree/Compile/Anoma.hs
Normal file
@ -0,0 +1,31 @@
|
||||
module Commands.Dev.Tree.Compile.Anoma where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Compile.Anoma.Options
|
||||
import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Nockma.Pretty qualified as Anoma
|
||||
import Juvix.Compiler.Nockma.Translation.FromTree qualified as Anoma
|
||||
import Juvix.Compiler.Tree.Data.InfoTable
|
||||
import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree
|
||||
|
||||
runCommand ::
|
||||
(Members '[App, TaggedLock, EmbedIO] r) =>
|
||||
AnomaOptions ('InputExtension 'FileExtJuvixTree) ->
|
||||
Sem r ()
|
||||
runCommand opts = do
|
||||
let opts' = opts ^. anomaCompileCommonOptions
|
||||
inputFile = Just (opts' ^. compileInputFile)
|
||||
moutputFile = opts' ^. compileOutputFile
|
||||
outFile <- getOutputFile FileExtNockma inputFile moutputFile
|
||||
mainFile <- getMainFile inputFile
|
||||
tab :: InfoTable <- readFile mainFile >>= getRight . Tree.runParser mainFile
|
||||
entrypoint <-
|
||||
applyOptions opts
|
||||
<$> getEntryPoint inputFile
|
||||
res <-
|
||||
getRight
|
||||
. run
|
||||
. runError @JuvixError
|
||||
. runReader entrypoint
|
||||
$ treeToAnoma tab
|
||||
writeFileEnsureLn outFile (Anoma.ppPrint (res ^. Anoma.anomaClosure))
|
22
app/Commands/Dev/Tree/Compile/Asm.hs
Normal file
22
app/Commands/Dev/Tree/Compile/Asm.hs
Normal file
@ -0,0 +1,22 @@
|
||||
module Commands.Dev.Tree.Compile.Asm where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Dev.DevCompile.Asm.Options
|
||||
import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Asm.Pretty qualified as Asm
|
||||
import Juvix.Compiler.Tree.Data.InfoTable
|
||||
import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree
|
||||
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => AsmOptions ('InputExtension 'FileExtJuvixTree) -> Sem r ()
|
||||
runCommand opts = do
|
||||
let inputFile = opts ^. asmCompileCommonOptions . compileInputFile
|
||||
moutputFile = opts ^. asmCompileCommonOptions . compileOutputFile
|
||||
outFile <- getOutputFile FileExtJuvixAsm (Just inputFile) moutputFile
|
||||
mainFile <- getMainFile (Just inputFile)
|
||||
tab :: InfoTable <- readFile mainFile >>= getRight . Tree.runParser mainFile
|
||||
res <-
|
||||
getRight
|
||||
. run
|
||||
. runError @JuvixError
|
||||
$ treeToAsm tab
|
||||
writeFileEnsureLn outFile (Asm.ppPrint res res)
|
26
app/Commands/Dev/Tree/Compile/Cairo.hs
Normal file
26
app/Commands/Dev/Tree/Compile/Cairo.hs
Normal file
@ -0,0 +1,26 @@
|
||||
module Commands.Dev.Tree.Compile.Cairo where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Compile.Cairo.Options
|
||||
import Commands.Extra.NewCompile
|
||||
import Data.Aeson qualified as JSON
|
||||
import Juvix.Compiler.Tree.Data.InfoTable
|
||||
import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree
|
||||
|
||||
runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => CairoOptions ('InputExtension 'FileExtJuvixTree) -> Sem r ()
|
||||
runCommand opts = do
|
||||
let inputFile = Just (opts ^. cairoCompileCommonOptions . compileInputFile)
|
||||
moutputFile = opts ^. cairoCompileCommonOptions . compileOutputFile
|
||||
outFile <- getOutputFile FileExtCasm inputFile moutputFile
|
||||
mainFile <- getMainFile inputFile
|
||||
tab :: InfoTable <- readFile mainFile >>= getRight . Tree.runParser mainFile
|
||||
entrypoint <-
|
||||
applyOptions opts
|
||||
<$> getEntryPoint inputFile
|
||||
res <-
|
||||
getRight
|
||||
. run
|
||||
. runReader entrypoint
|
||||
. runError @JuvixError
|
||||
$ treeToCairo tab
|
||||
liftIO (JSON.encodeFile (toFilePath outFile) res)
|
30
app/Commands/Dev/Tree/Compile/Casm.hs
Normal file
30
app/Commands/Dev/Tree/Compile/Casm.hs
Normal file
@ -0,0 +1,30 @@
|
||||
module Commands.Dev.Tree.Compile.Casm where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Dev.DevCompile.Casm.Options
|
||||
import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Casm.Pretty qualified as Casm
|
||||
import Juvix.Compiler.Tree.Data.InfoTable
|
||||
import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree
|
||||
|
||||
runCommand ::
|
||||
(Members '[App, TaggedLock, EmbedIO] r) =>
|
||||
CasmOptions ('InputExtension 'FileExtJuvixTree) ->
|
||||
Sem r ()
|
||||
runCommand opts = do
|
||||
let opts' = opts ^. casmCompileCommonOptions
|
||||
inputFile = Just (opts' ^. compileInputFile)
|
||||
moutputFile = opts' ^. compileOutputFile
|
||||
outFile <- getOutputFile FileExtCasm inputFile moutputFile
|
||||
mainFile <- getMainFile inputFile
|
||||
tab :: InfoTable <- readFile mainFile >>= getRight . Tree.runParser mainFile
|
||||
entrypoint <-
|
||||
applyOptions opts
|
||||
<$> getEntryPoint inputFile
|
||||
res <-
|
||||
getRight
|
||||
. run
|
||||
. runError @JuvixError
|
||||
. runReader entrypoint
|
||||
$ treeToCasm tab
|
||||
writeFileEnsureLn outFile (Casm.ppPrint res)
|
20
app/Commands/Dev/Tree/Compile/Native.hs
Normal file
20
app/Commands/Dev/Tree/Compile/Native.hs
Normal file
@ -0,0 +1,20 @@
|
||||
module Commands.Dev.Tree.Compile.Native where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Compile.Native.Options
|
||||
import Commands.Compile.NativeWasiHelper qualified as Helper
|
||||
import Commands.Dev.Tree.Compile.TreeToC qualified as TreeToC
|
||||
|
||||
runCommand ::
|
||||
(Members '[EmbedIO, App, TaggedLock] r) =>
|
||||
NativeOptions ('InputExtension 'FileExtJuvixTree) ->
|
||||
Sem r ()
|
||||
runCommand opts =
|
||||
TreeToC.treeToC treeToCArgs
|
||||
>>= Helper.fromC (nativeHelperOptions opts)
|
||||
where
|
||||
treeToCArgs =
|
||||
TreeToC.TreeToCArgs
|
||||
{ _treeToCTarget = TargetCNative64,
|
||||
_treeToCCommonOptions = (opts ^. nativeCompileCommonOptions)
|
||||
}
|
@ -1,26 +1,50 @@
|
||||
module Commands.Dev.Tree.Compile.Options
|
||||
( module Commands.Dev.Tree.Compile.Options,
|
||||
module Commands.Extra.Compile.Options,
|
||||
)
|
||||
where
|
||||
|
||||
import Commands.Compile.Anoma.Options
|
||||
import Commands.Compile.Cairo.Options
|
||||
import Commands.Compile.Native.Options
|
||||
import Commands.Compile.Wasi.Options
|
||||
import Commands.Dev.DevCompile.Asm.Options
|
||||
import Commands.Dev.DevCompile.Casm.Options
|
||||
import Commands.Dev.DevCompile.Reg.Options
|
||||
import Commands.Extra.Compile.Options
|
||||
import Commands.Extra.NewCompile
|
||||
import CommonOptions
|
||||
|
||||
treeSupportedTargets :: NonEmpty CompileTarget
|
||||
treeSupportedTargets =
|
||||
nonEmpty'
|
||||
[ TargetNative64,
|
||||
TargetWasm32Wasi,
|
||||
TargetAsm,
|
||||
TargetReg,
|
||||
TargetCasm,
|
||||
TargetCairo,
|
||||
TargetAnoma
|
||||
]
|
||||
data CompileCommand
|
||||
= Native (NativeOptions ('InputExtension 'FileExtJuvixTree))
|
||||
| Wasi (WasiOptions ('InputExtension 'FileExtJuvixTree))
|
||||
| Asm (AsmOptions ('InputExtension 'FileExtJuvixTree))
|
||||
| Reg (RegOptions ('InputExtension 'FileExtJuvixTree))
|
||||
| Casm (CasmOptions ('InputExtension 'FileExtJuvixTree))
|
||||
| Anoma (AnomaOptions ('InputExtension 'FileExtJuvixTree))
|
||||
| Cairo (CairoOptions ('InputExtension 'FileExtJuvixTree))
|
||||
deriving stock (Data)
|
||||
|
||||
parseTreeCompileOptions :: Parser CompileOptions
|
||||
parseTreeCompileOptions =
|
||||
parseCompileOptions
|
||||
treeSupportedTargets
|
||||
(parseInputFile FileExtJuvixTree)
|
||||
treeSupportedTargets :: SupportedTargets
|
||||
treeSupportedTargets =
|
||||
AppTargetNative64
|
||||
:| [ AppTargetWasm32Wasi,
|
||||
AppTargetAsm,
|
||||
AppTargetReg,
|
||||
AppTargetCasm,
|
||||
AppTargetCairo,
|
||||
AppTargetAnoma
|
||||
]
|
||||
|
||||
supportedTargets :: [(CompileTarget, Parser CompileCommand)]
|
||||
supportedTargets =
|
||||
[ (AppTargetNative64, Native <$> parseNative),
|
||||
(AppTargetWasm32Wasi, Wasi <$> parseWasi),
|
||||
(AppTargetAsm, Asm <$> parseAsm),
|
||||
(AppTargetReg, Reg <$> parseReg),
|
||||
(AppTargetCasm, Casm <$> parseCasm),
|
||||
(AppTargetAnoma, Anoma <$> parseAnoma),
|
||||
(AppTargetCairo, Cairo <$> parseCairo)
|
||||
]
|
||||
|
||||
parseCompileCommand :: Parser CompileCommand
|
||||
parseCompileCommand = commandTargetsHelper supportedTargets
|
||||
|
30
app/Commands/Dev/Tree/Compile/Reg.hs
Normal file
30
app/Commands/Dev/Tree/Compile/Reg.hs
Normal file
@ -0,0 +1,30 @@
|
||||
module Commands.Dev.Tree.Compile.Reg where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Dev.DevCompile.Reg.Options
|
||||
import Commands.Extra.NewCompile
|
||||
import Juvix.Compiler.Reg.Pretty qualified as Reg
|
||||
import Juvix.Compiler.Tree.Data.InfoTable
|
||||
import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree
|
||||
|
||||
runCommand ::
|
||||
(Members '[App, TaggedLock, EmbedIO] r) =>
|
||||
RegOptions ('InputExtension 'FileExtJuvixTree) ->
|
||||
Sem r ()
|
||||
runCommand opts = do
|
||||
let opts' = opts ^. regCompileCommonOptions
|
||||
inputFile = Just (opts' ^. compileInputFile)
|
||||
moutputFile = opts' ^. compileOutputFile
|
||||
outFile <- getOutputFile FileExtJuvixReg inputFile moutputFile
|
||||
mainFile <- getMainFile inputFile
|
||||
tab :: InfoTable <- readFile mainFile >>= getRight . Tree.runParser mainFile
|
||||
entrypoint <-
|
||||
applyOptions opts
|
||||
<$> getEntryPoint inputFile
|
||||
res <-
|
||||
getRight
|
||||
. run
|
||||
. runError @JuvixError
|
||||
. runReader entrypoint
|
||||
$ treeToReg tab
|
||||
writeFileEnsureLn outFile (Reg.ppPrint res res)
|
39
app/Commands/Dev/Tree/Compile/TreeToC.hs
Normal file
39
app/Commands/Dev/Tree/Compile/TreeToC.hs
Normal file
@ -0,0 +1,39 @@
|
||||
module Commands.Dev.Tree.Compile.TreeToC where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Compile.CommonOptions
|
||||
import Juvix.Compiler.Backend.C
|
||||
import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree
|
||||
|
||||
data TreeToCArgs = TreeToCArgs
|
||||
{ _treeToCTarget :: Target,
|
||||
_treeToCCommonOptions :: CompileCommonOptions ('InputExtension 'FileExtJuvixTree)
|
||||
}
|
||||
|
||||
makeLenses ''TreeToCArgs
|
||||
|
||||
instance EntryPointOptions TreeToCArgs where
|
||||
applyOptions opts =
|
||||
set entryPointTarget (Just (opts ^. treeToCTarget))
|
||||
. applyOptions (opts ^. treeToCCommonOptions)
|
||||
|
||||
treeToC ::
|
||||
forall r.
|
||||
(Members '[EmbedIO, App, TaggedLock] r) =>
|
||||
TreeToCArgs ->
|
||||
Sem r MiniCResult
|
||||
treeToC opts = do
|
||||
afile <-
|
||||
getMainAppFileFromInputFileType @('InputExtension 'FileExtJuvixTree)
|
||||
(opts ^. treeToCCommonOptions . compileInputFile)
|
||||
file <- fromAppPathFile afile
|
||||
s <- readFile file
|
||||
tab <- getRight (mapLeft JuvixError (Tree.runParser file s))
|
||||
entryPoint :: EntryPoint <-
|
||||
applyOptions opts
|
||||
<$> getEntryPoint (Just afile)
|
||||
getRight
|
||||
. run
|
||||
. runReader entryPoint
|
||||
. runError @JuvixError
|
||||
$ treeToMiniC tab
|
21
app/Commands/Dev/Tree/Compile/Wasi.hs
Normal file
21
app/Commands/Dev/Tree/Compile/Wasi.hs
Normal file
@ -0,0 +1,21 @@
|
||||
module Commands.Dev.Tree.Compile.Wasi where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Compile.NativeWasiHelper qualified as Helper
|
||||
import Commands.Compile.Wasi.Options
|
||||
import Commands.Dev.Tree.Compile.TreeToC qualified as TreeToC
|
||||
|
||||
runCommand ::
|
||||
forall r.
|
||||
(Members '[EmbedIO, App, TaggedLock] r) =>
|
||||
WasiOptions ('InputExtension 'FileExtJuvixTree) ->
|
||||
Sem r ()
|
||||
runCommand opts =
|
||||
TreeToC.treeToC treeToCArgs
|
||||
>>= Helper.fromC (wasiHelperOptions opts)
|
||||
where
|
||||
treeToCArgs =
|
||||
TreeToC.TreeToCArgs
|
||||
{ _treeToCTarget = TargetCNative64,
|
||||
_treeToCCommonOptions = (opts ^. wasiCompileCommonOptions)
|
||||
}
|
@ -1,7 +1,7 @@
|
||||
module Commands.Dev.Tree.Compile.Base where
|
||||
module Commands.Dev.Tree.CompileOld.Base where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Dev.Tree.Compile.Options
|
||||
import Commands.Dev.Tree.CompileOld.Options
|
||||
import Commands.Extra.Compile qualified as Compile
|
||||
import Data.Aeson qualified as JSON
|
||||
import Juvix.Compiler.Asm.Pretty qualified as Asm
|
||||
@ -24,7 +24,7 @@ data PipelineArg = PipelineArg
|
||||
getEntry :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r EntryPoint
|
||||
getEntry PipelineArg {..} = do
|
||||
ep <- getEntryPoint (Just (AppPath (preFileFromAbs _pipelineArgFile) True))
|
||||
return $
|
||||
return
|
||||
ep
|
||||
{ _entryPointTarget = Just (getTarget (_pipelineArgOptions ^. compileTarget)),
|
||||
_entryPointDebug = _pipelineArgOptions ^. compileDebug,
|
||||
@ -35,17 +35,17 @@ getEntry PipelineArg {..} = do
|
||||
where
|
||||
getTarget :: CompileTarget -> Backend.Target
|
||||
getTarget = \case
|
||||
TargetWasm32Wasi -> Backend.TargetCWasm32Wasi
|
||||
TargetNative64 -> Backend.TargetCNative64
|
||||
TargetGeb -> Backend.TargetGeb
|
||||
TargetVampIR -> Backend.TargetVampIR
|
||||
TargetCore -> Backend.TargetCore
|
||||
TargetAsm -> Backend.TargetAsm
|
||||
TargetReg -> Backend.TargetReg
|
||||
TargetTree -> Backend.TargetTree
|
||||
TargetAnoma -> Backend.TargetAnoma
|
||||
TargetCasm -> Backend.TargetCairo
|
||||
TargetCairo -> Backend.TargetCairo
|
||||
AppTargetWasm32Wasi -> Backend.TargetCWasm32Wasi
|
||||
AppTargetNative64 -> Backend.TargetCNative64
|
||||
AppTargetGeb -> Backend.TargetGeb
|
||||
AppTargetVampIR -> Backend.TargetVampIR
|
||||
AppTargetCore -> Backend.TargetCore
|
||||
AppTargetAsm -> Backend.TargetAsm
|
||||
AppTargetReg -> Backend.TargetReg
|
||||
AppTargetTree -> Backend.TargetTree
|
||||
AppTargetAnoma -> Backend.TargetAnoma
|
||||
AppTargetCasm -> Backend.TargetCairo
|
||||
AppTargetCairo -> Backend.TargetCairo
|
||||
|
||||
defaultOptLevel :: Int
|
||||
defaultOptLevel
|
27
app/Commands/Dev/Tree/CompileOld/Options.hs
Normal file
27
app/Commands/Dev/Tree/CompileOld/Options.hs
Normal file
@ -0,0 +1,27 @@
|
||||
module Commands.Dev.Tree.CompileOld.Options
|
||||
( module Commands.Dev.Tree.CompileOld.Options,
|
||||
module Commands.Extra.Compile.Options,
|
||||
)
|
||||
where
|
||||
|
||||
import Commands.Extra.Compile.Options
|
||||
import CommonOptions
|
||||
|
||||
treeSupportedTargets :: SupportedTargets
|
||||
treeSupportedTargets =
|
||||
AppTargetNative64
|
||||
:| [ AppTargetWasm32Wasi,
|
||||
AppTargetAsm,
|
||||
AppTargetReg,
|
||||
AppTargetCasm,
|
||||
AppTargetCairo,
|
||||
AppTargetAnoma
|
||||
]
|
||||
|
||||
parseTreeCompileOptions :: Parser CompileOptions
|
||||
parseTreeCompileOptions =
|
||||
parseCompileOptions
|
||||
treeSupportedTargets
|
||||
(parseInputFile FileExtJuvixTree)
|
||||
|
||||
type CompileOldOptions = CompileOptions
|
@ -1,6 +1,7 @@
|
||||
module Commands.Dev.Tree.Options where
|
||||
|
||||
import Commands.Dev.Tree.Compile.Options
|
||||
import Commands.Dev.Tree.CompileOld.Options
|
||||
import Commands.Dev.Tree.Eval.Options
|
||||
import Commands.Dev.Tree.FromAsm.Options
|
||||
import Commands.Dev.Tree.Read.Options
|
||||
@ -9,7 +10,8 @@ import CommonOptions
|
||||
|
||||
data TreeCommand
|
||||
= Eval TreeEvalOptions
|
||||
| Compile CompileOptions
|
||||
| CompileOld CompileOldOptions
|
||||
| Compile CompileCommand
|
||||
| Read TreeReadOptions
|
||||
| FromAsm TreeFromAsmOptions
|
||||
| Repl TreeReplOptions
|
||||
@ -21,6 +23,7 @@ parseTreeCommand =
|
||||
mconcat
|
||||
[ commandRepl,
|
||||
commandEval,
|
||||
commandCompileOld,
|
||||
commandCompile,
|
||||
commandRead,
|
||||
commandFromAsm
|
||||
@ -28,45 +31,54 @@ parseTreeCommand =
|
||||
where
|
||||
commandRepl :: Mod CommandFields TreeCommand
|
||||
commandRepl = command "repl" replInfo
|
||||
where
|
||||
replInfo :: ParserInfo TreeCommand
|
||||
replInfo =
|
||||
info
|
||||
(Repl <$> parseTreeReplOptions)
|
||||
(progDesc "Launch the JuvixTree REPL")
|
||||
|
||||
commandEval :: Mod CommandFields TreeCommand
|
||||
commandEval = command "eval" evalInfo
|
||||
where
|
||||
evalInfo :: ParserInfo TreeCommand
|
||||
evalInfo =
|
||||
info
|
||||
(Eval <$> parseTreeEvalOptions)
|
||||
(progDesc "Evaluate a JuvixTree file")
|
||||
|
||||
commandCompile :: Mod CommandFields TreeCommand
|
||||
commandCompile = command "compile" compileInfo
|
||||
where
|
||||
compileInfo :: ParserInfo TreeCommand
|
||||
compileInfo =
|
||||
info
|
||||
(Compile <$> parseCompileCommand)
|
||||
(progDesc "Compile a JuvixTree file")
|
||||
|
||||
commandCompileOld :: Mod CommandFields TreeCommand
|
||||
commandCompileOld = command "compile-old" compileInfo
|
||||
where
|
||||
compileInfo :: ParserInfo TreeCommand
|
||||
compileInfo =
|
||||
info
|
||||
(CompileOld <$> parseTreeCompileOptions)
|
||||
(progDesc "Compile a JuvixTree file")
|
||||
|
||||
commandRead :: Mod CommandFields TreeCommand
|
||||
commandRead = command "read" readInfo
|
||||
where
|
||||
readInfo :: ParserInfo TreeCommand
|
||||
readInfo =
|
||||
info
|
||||
(Read <$> parseTreeReadOptions)
|
||||
(progDesc "Parse a JuvixTree file and pretty print it")
|
||||
|
||||
commandFromAsm :: Mod CommandFields TreeCommand
|
||||
commandFromAsm = command "from-asm" fromAsmInfo
|
||||
|
||||
replInfo :: ParserInfo TreeCommand
|
||||
replInfo =
|
||||
info
|
||||
(Repl <$> parseTreeReplOptions)
|
||||
(progDesc "Launch the JuvixTree REPL")
|
||||
|
||||
evalInfo :: ParserInfo TreeCommand
|
||||
evalInfo =
|
||||
info
|
||||
(Eval <$> parseTreeEvalOptions)
|
||||
(progDesc "Evaluate a JuvixTree file")
|
||||
|
||||
compileInfo :: ParserInfo TreeCommand
|
||||
compileInfo =
|
||||
info
|
||||
(Compile <$> parseTreeCompileOptions)
|
||||
(progDesc "Compile a JuvixTree file")
|
||||
|
||||
readInfo :: ParserInfo TreeCommand
|
||||
readInfo =
|
||||
info
|
||||
(Read <$> parseTreeReadOptions)
|
||||
(progDesc "Parse a JuvixTree file and pretty print it")
|
||||
|
||||
fromAsmInfo :: ParserInfo TreeCommand
|
||||
fromAsmInfo =
|
||||
info
|
||||
(FromAsm <$> parseTreeFromAsmOptions)
|
||||
(progDesc "Convert a JuvixAsm file to JuvixTree and pretty print it")
|
||||
where
|
||||
fromAsmInfo :: ParserInfo TreeCommand
|
||||
fromAsmInfo =
|
||||
info
|
||||
(FromAsm <$> parseTreeFromAsmOptions)
|
||||
(progDesc "Convert a JuvixAsm file to JuvixTree and pretty print it")
|
||||
|
@ -25,37 +25,37 @@ runCompile opts = do
|
||||
ensureDir (juvixIncludeDir buildDir)
|
||||
prepareRuntime buildDir opts
|
||||
case opts ^. compileTarget of
|
||||
TargetWasm32Wasi -> clangWasmWasiCompile opts
|
||||
TargetNative64 -> clangNativeCompile opts
|
||||
TargetGeb -> return (())
|
||||
TargetVampIR -> return ()
|
||||
TargetCore -> return ()
|
||||
TargetAsm -> return ()
|
||||
TargetReg -> return ()
|
||||
TargetTree -> return ()
|
||||
TargetAnoma -> return ()
|
||||
TargetCasm -> return ()
|
||||
TargetCairo -> return ()
|
||||
AppTargetWasm32Wasi -> clangWasmWasiCompile opts
|
||||
AppTargetNative64 -> clangNativeCompile opts
|
||||
AppTargetGeb -> return (())
|
||||
AppTargetVampIR -> return ()
|
||||
AppTargetCore -> return ()
|
||||
AppTargetAsm -> return ()
|
||||
AppTargetReg -> return ()
|
||||
AppTargetTree -> return ()
|
||||
AppTargetAnoma -> return ()
|
||||
AppTargetCasm -> return ()
|
||||
AppTargetCairo -> return ()
|
||||
|
||||
prepareRuntime :: forall r. (Members '[App, EmbedIO] r) => Path Abs Dir -> CompileOptions -> Sem r ()
|
||||
prepareRuntime buildDir o = do
|
||||
mapM_ writeHeader headersDir
|
||||
case o ^. compileTarget of
|
||||
TargetWasm32Wasi
|
||||
AppTargetWasm32Wasi
|
||||
| o ^. compileDebug -> writeRuntime wasiDebugRuntime
|
||||
TargetWasm32Wasi -> writeRuntime wasiReleaseRuntime
|
||||
TargetNative64
|
||||
AppTargetWasm32Wasi -> writeRuntime wasiReleaseRuntime
|
||||
AppTargetNative64
|
||||
| o ^. compileDebug -> writeRuntime nativeDebugRuntime
|
||||
TargetNative64 -> writeRuntime nativeReleaseRuntime
|
||||
TargetGeb -> return ()
|
||||
TargetVampIR -> return ()
|
||||
TargetCore -> return ()
|
||||
TargetAsm -> return ()
|
||||
TargetReg -> return ()
|
||||
TargetTree -> return ()
|
||||
TargetAnoma -> return ()
|
||||
TargetCasm -> return ()
|
||||
TargetCairo -> return ()
|
||||
AppTargetNative64 -> writeRuntime nativeReleaseRuntime
|
||||
AppTargetGeb -> return ()
|
||||
AppTargetVampIR -> return ()
|
||||
AppTargetCore -> return ()
|
||||
AppTargetAsm -> return ()
|
||||
AppTargetReg -> return ()
|
||||
AppTargetTree -> return ()
|
||||
AppTargetAnoma -> return ()
|
||||
AppTargetCasm -> return ()
|
||||
AppTargetCairo -> return ()
|
||||
where
|
||||
wasiReleaseRuntime :: BS.ByteString
|
||||
wasiReleaseRuntime = $(FE.makeRelativeToProject "runtime/_build.wasm32-wasi/libjuvix.a" >>= FE.embedFile)
|
||||
@ -95,34 +95,34 @@ outputFile opts = do
|
||||
invokeDir <- askInvokeDir
|
||||
let baseOutputFile = invokeDir <//> filename inputFile
|
||||
return $ case opts ^. compileTarget of
|
||||
TargetNative64
|
||||
AppTargetNative64
|
||||
| opts ^. compileCOutput -> replaceExtension' cFileExt inputFile
|
||||
| opts ^. compilePreprocess -> addExtension' cFileExt (addExtension' ".out" (removeExtension' inputFile))
|
||||
| opts ^. compileAssembly -> replaceExtension' ".s" inputFile
|
||||
| otherwise -> removeExtension' baseOutputFile
|
||||
TargetWasm32Wasi
|
||||
AppTargetWasm32Wasi
|
||||
| opts ^. compileCOutput -> replaceExtension' cFileExt inputFile
|
||||
| opts ^. compilePreprocess -> addExtension' cFileExt (addExtension' ".out" (removeExtension' inputFile))
|
||||
| opts ^. compileAssembly -> replaceExtension' ".wat" inputFile
|
||||
| otherwise -> replaceExtension' ".wasm" baseOutputFile
|
||||
TargetGeb
|
||||
AppTargetGeb
|
||||
| opts ^. compileTerm -> replaceExtension' juvixGebFileExt inputFile
|
||||
| otherwise -> replaceExtension' lispFileExt baseOutputFile
|
||||
TargetVampIR ->
|
||||
AppTargetVampIR ->
|
||||
replaceExtension' vampIRFileExt baseOutputFile
|
||||
TargetCore ->
|
||||
AppTargetCore ->
|
||||
replaceExtension' juvixCoreFileExt baseOutputFile
|
||||
TargetAsm ->
|
||||
AppTargetAsm ->
|
||||
replaceExtension' juvixAsmFileExt baseOutputFile
|
||||
TargetReg ->
|
||||
AppTargetReg ->
|
||||
replaceExtension' juvixRegFileExt baseOutputFile
|
||||
TargetTree ->
|
||||
AppTargetTree ->
|
||||
replaceExtension' juvixTreeFileExt baseOutputFile
|
||||
TargetAnoma ->
|
||||
AppTargetAnoma ->
|
||||
replaceExtension' nockmaFileExt baseOutputFile
|
||||
TargetCasm ->
|
||||
AppTargetCasm ->
|
||||
replaceExtension' casmFileExt baseOutputFile
|
||||
TargetCairo ->
|
||||
AppTargetCairo ->
|
||||
replaceExtension' jsonFileExt baseOutputFile
|
||||
|
||||
clangNativeCompile ::
|
||||
|
@ -5,33 +5,37 @@ import CommonOptions hiding (show)
|
||||
import Juvix.Compiler.Pipeline.EntryPoint
|
||||
import Prelude (Show (show))
|
||||
|
||||
-- | Here we define a separate target from `Juvix.Compiler.Backend.Target`. The
|
||||
-- reason is that the type being defined here represents the targets available
|
||||
-- to the user through the CLI, whereas the Target in
|
||||
-- `Juvix.Compiler.Backend.Target` is used internally to establish certain limits.
|
||||
data CompileTarget
|
||||
= TargetNative64
|
||||
| TargetWasm32Wasi
|
||||
| TargetGeb
|
||||
| TargetVampIR
|
||||
| TargetCore
|
||||
| TargetAsm
|
||||
| TargetReg
|
||||
| TargetTree
|
||||
| TargetAnoma
|
||||
| TargetCasm
|
||||
| TargetCairo
|
||||
= AppTargetNative64
|
||||
| AppTargetWasm32Wasi
|
||||
| AppTargetGeb
|
||||
| AppTargetVampIR
|
||||
| AppTargetCore
|
||||
| AppTargetAsm
|
||||
| AppTargetReg
|
||||
| AppTargetTree
|
||||
| AppTargetAnoma
|
||||
| AppTargetCasm
|
||||
| AppTargetCairo
|
||||
deriving stock (Eq, Data, Bounded, Enum)
|
||||
|
||||
instance Show CompileTarget where
|
||||
show = \case
|
||||
TargetWasm32Wasi -> "wasm32-wasi"
|
||||
TargetNative64 -> "native"
|
||||
TargetGeb -> "geb"
|
||||
TargetVampIR -> "vampir"
|
||||
TargetCore -> "core"
|
||||
TargetAsm -> "asm"
|
||||
TargetReg -> "reg"
|
||||
TargetTree -> "tree"
|
||||
TargetAnoma -> "anoma"
|
||||
TargetCasm -> "casm"
|
||||
TargetCairo -> "cairo"
|
||||
AppTargetWasm32Wasi -> "wasi"
|
||||
AppTargetNative64 -> "native"
|
||||
AppTargetGeb -> "geb"
|
||||
AppTargetVampIR -> "vampir"
|
||||
AppTargetCore -> "core"
|
||||
AppTargetAsm -> "asm"
|
||||
AppTargetReg -> "reg"
|
||||
AppTargetTree -> "tree"
|
||||
AppTargetAnoma -> "anoma"
|
||||
AppTargetCasm -> "casm"
|
||||
AppTargetCairo -> "cairo"
|
||||
|
||||
-- | If the input file can be defaulted to the `main` in the `package.yaml` file, we
|
||||
-- can omit the input file.
|
||||
@ -60,6 +64,20 @@ makeLenses ''CompileOptions'
|
||||
fromCompileOptionsMain :: (Members '[App] r) => CompileOptionsMain -> Sem r CompileOptions
|
||||
fromCompileOptionsMain = traverseOf compileInputFile getMainAppFile
|
||||
|
||||
compileTargetDescription :: forall str. (IsString str) => CompileTarget -> str
|
||||
compileTargetDescription = \case
|
||||
AppTargetNative64 -> "Compile to native code"
|
||||
AppTargetWasm32Wasi -> "Compile to WASI (WebAssembly System Interface)"
|
||||
AppTargetAnoma -> "Compile to Anoma"
|
||||
AppTargetCairo -> "Compile to Cairo"
|
||||
AppTargetGeb -> "Compile to Geb"
|
||||
AppTargetVampIR -> "Compile to VampIR"
|
||||
AppTargetCasm -> "Compile to JuvixCasm"
|
||||
AppTargetCore -> "Compile to VampIR"
|
||||
AppTargetAsm -> "Compile to JuvixAsm"
|
||||
AppTargetReg -> "Compile to JuvixReg"
|
||||
AppTargetTree -> "Compile to JuvixTree"
|
||||
|
||||
type SupportedTargets = NonEmpty CompileTarget
|
||||
|
||||
allTargets :: [CompileTarget]
|
||||
@ -110,7 +128,7 @@ parseCompileOptions' supportedTargets parserFile = do
|
||||
)
|
||||
_compileTerm <-
|
||||
if
|
||||
| elem TargetGeb supportedTargets ->
|
||||
| elem AppTargetGeb supportedTargets ->
|
||||
switch
|
||||
( short 'G'
|
||||
<> long "only-term"
|
||||
@ -125,7 +143,7 @@ parseCompileOptions' supportedTargets parserFile = do
|
||||
)
|
||||
_compileUnsafe <-
|
||||
if
|
||||
| elem TargetVampIR supportedTargets ->
|
||||
| elem AppTargetVampIR supportedTargets ->
|
||||
switch
|
||||
( long "unsafe"
|
||||
<> help "Disable range and error checking (for targets: vampir)"
|
||||
|
@ -3,15 +3,22 @@ module Commands.Extra.NewCompile
|
||||
( module Commands.Extra.NewCompile,
|
||||
module Commands.Extra.Clang,
|
||||
module Juvix.Compiler.Core.Translation.FromInternal.Data.Context,
|
||||
module Commands.Extra.Compile.Options,
|
||||
)
|
||||
where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Compile.CommonOptions
|
||||
import Commands.Extra.Clang
|
||||
import Commands.Extra.Compile.Options (CompileTarget (..), compileTargetDescription)
|
||||
import Juvix.Compiler.Core.Translation.FromInternal.Data.Context
|
||||
|
||||
getOutputFile :: (Members '[App] r) => FileExt -> Maybe (AppPath File) -> Maybe (AppPath File) -> Sem r (Path Abs File)
|
||||
getOutputFile ::
|
||||
(Members '[App] r) =>
|
||||
FileExt ->
|
||||
Maybe (AppPath File) ->
|
||||
Maybe (AppPath File) ->
|
||||
Sem r (Path Abs File)
|
||||
getOutputFile ext inp = \case
|
||||
Just out -> fromAppPathFile out
|
||||
Nothing -> do
|
||||
@ -20,5 +27,22 @@ getOutputFile ext inp = \case
|
||||
let baseOutputFile = invokeDir <//> filename mainFile
|
||||
return (replaceExtension' (fileExtToString ext) baseOutputFile)
|
||||
|
||||
compileToCore :: (Members '[App, EmbedIO, TaggedLock] r) => CompileCommonOptions -> Sem r CoreResult
|
||||
compileToCore ::
|
||||
(Members '[App, EmbedIO, TaggedLock] r) =>
|
||||
CompileCommonOptions ('InputExtension 'FileExtJuvix) ->
|
||||
Sem r CoreResult
|
||||
compileToCore opts = runPipeline (Just (opts ^. compileInputFile)) upToCore
|
||||
|
||||
commandTargetHelper :: CompileTarget -> Parser a -> Mod CommandFields a
|
||||
commandTargetHelper t parseCommand =
|
||||
let cmd = show t
|
||||
descr = compileTargetDescription t
|
||||
in command cmd (info parseCommand (progDesc descr))
|
||||
|
||||
commandTargetsHelper :: [(CompileTarget, Parser a)] -> Parser a
|
||||
commandTargetsHelper supportedTargets =
|
||||
hsubparser $
|
||||
mconcat
|
||||
[ commandTargetHelper backend parser
|
||||
| (backend, parser) <- supportedTargets
|
||||
]
|
||||
|
@ -9,6 +9,7 @@ where
|
||||
import Control.Exception qualified as GHC
|
||||
import Data.List.NonEmpty qualified as NonEmpty
|
||||
import Juvix.Compiler.Core.Data.TransformationId.Parser qualified as Core
|
||||
import Juvix.Compiler.Pipeline.EntryPoint
|
||||
import Juvix.Compiler.Reg.Data.TransformationId.Parser qualified as Reg
|
||||
import Juvix.Compiler.Tree.Data.TransformationId.Parser qualified as Tree
|
||||
import Juvix.Data.Field
|
||||
@ -284,3 +285,6 @@ optTreeTransformationIds = optTransformationIds Tree.parseTransformations Tree.c
|
||||
|
||||
optRegTransformationIds :: Parser [Reg.TransformationId]
|
||||
optRegTransformationIds = optTransformationIds Reg.parseTransformations Reg.completionsString
|
||||
|
||||
class EntryPointOptions a where
|
||||
applyOptions :: a -> EntryPoint -> EntryPoint
|
||||
|
@ -5,3 +5,5 @@ import Juvix.Prelude
|
||||
newtype MiniCResult = MiniCResult
|
||||
{ _resultCCode :: Text
|
||||
}
|
||||
|
||||
makeLenses ''MiniCResult
|
||||
|
@ -29,6 +29,8 @@ data FileExt
|
||||
| FileExtNockma
|
||||
deriving stock (Eq)
|
||||
|
||||
$(genSingletons [''FileExt])
|
||||
|
||||
juvixFileExt :: (IsString a) => a
|
||||
juvixFileExt = ".juvix"
|
||||
|
||||
|
@ -50,7 +50,7 @@ tests:
|
||||
script: |
|
||||
temp=$(mktemp -d)
|
||||
trap 'rm -rf -- "$temp"' EXIT
|
||||
juvix dev tree compile -o $temp/test001 Tree/positive/test001.jvt
|
||||
juvix dev tree compile native -o $temp/test001 Tree/positive/test001.jvt
|
||||
$temp/test001
|
||||
stdout: |
|
||||
11
|
||||
@ -63,7 +63,7 @@ tests:
|
||||
script: |
|
||||
temp=$(mktemp -d)
|
||||
trap 'rm -rf -- "$temp"' EXIT
|
||||
juvix dev tree compile -t asm -o $temp/test001.jva Tree/positive/test001.jvt
|
||||
juvix dev tree compile asm -o $temp/test001.jva Tree/positive/test001.jvt
|
||||
juvix dev asm run $temp/test001.jva
|
||||
stdout: |
|
||||
11
|
||||
|
Loading…
Reference in New Issue
Block a user