From 52c5b9671fc076ae079020611cdac55f65c9d2fa Mon Sep 17 00:00:00 2001 From: Lukasz Czajka Date: Mon, 9 Sep 2024 12:54:00 +0200 Subject: [PATCH] pipeline --- app/Commands/Dev/Core/Compile/Base.hs | 2 +- .../Compiler/Core/Data/TransformationId.hs | 2 ++ .../Core/Data/TransformationId/Strings.hs | 3 +++ src/Juvix/Compiler/Core/Pipeline.hs | 6 +++++ src/Juvix/Compiler/Core/Transformation.hs | 2 ++ src/Juvix/Compiler/Pipeline.hs | 26 +++++++++++-------- 6 files changed, 29 insertions(+), 12 deletions(-) diff --git a/app/Commands/Dev/Core/Compile/Base.hs b/app/Commands/Dev/Core/Compile/Base.hs index 9ae05a596a..588a9dd46d 100644 --- a/app/Commands/Dev/Core/Compile/Base.hs +++ b/app/Commands/Dev/Core/Compile/Base.hs @@ -131,7 +131,7 @@ runTreePipeline pa@PipelineArg {..} = do r <- runReader entryPoint . runError @JuvixError - . coreToTree Core.IdentityTrans + . coreToTree Core.IdentityTrans [] $ _pipelineArgModule tab' <- getRight r let code = Tree.ppPrint tab' tab' diff --git a/src/Juvix/Compiler/Core/Data/TransformationId.hs b/src/Juvix/Compiler/Core/Data/TransformationId.hs index edc1a89040..edbb154473 100644 --- a/src/Juvix/Compiler/Core/Data/TransformationId.hs +++ b/src/Juvix/Compiler/Core/Data/TransformationId.hs @@ -16,6 +16,7 @@ data TransformationId | IdentityTrans | UnrollRecursion | ComputeTypeInfo + | ComputeCaseANF | MatchToCase | EtaExpandApps | DisambiguateNames @@ -91,6 +92,7 @@ instance TransformationId' TransformationId where IntToPrimInt -> strIntToPrimInt ConvertBuiltinTypes -> strConvertBuiltinTypes ComputeTypeInfo -> strComputeTypeInfo + ComputeCaseANF -> strComputeCaseANF UnrollRecursion -> strUnrollRecursion DisambiguateNames -> strDisambiguateNames CombineInfoTables -> strCombineInfoTables diff --git a/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs b/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs index adaa1d0c74..0ae7b475b9 100644 --- a/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs +++ b/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs @@ -56,6 +56,9 @@ strConvertBuiltinTypes = "convert-builtin-types" strComputeTypeInfo :: Text strComputeTypeInfo = "compute-type-info" +strComputeCaseANF :: Text +strComputeCaseANF = "compute-case-anf" + strUnrollRecursion :: Text strUnrollRecursion = "unroll-recursion" diff --git a/src/Juvix/Compiler/Core/Pipeline.hs b/src/Juvix/Compiler/Core/Pipeline.hs index a784303e8b..4ec9024f02 100644 --- a/src/Juvix/Compiler/Core/Pipeline.hs +++ b/src/Juvix/Compiler/Core/Pipeline.hs @@ -24,3 +24,9 @@ toStripped checkId = mapReader fromEntryPoint . applyTransformations (toStripped -- | Perform transformations on stored Core necessary before the translation to VampIR toVampIR :: (Members '[Error JuvixError, Reader EntryPoint] r) => Module -> Sem r Module toVampIR = mapReader fromEntryPoint . applyTransformations toVampIRTransformations + +extraAnomaTransformations :: [TransformationId] +extraAnomaTransformations = [ComputeCaseANF] + +applyExtraTransformations :: (Members '[Error JuvixError, Reader EntryPoint] r) => [TransformationId] -> Module -> Sem r Module +applyExtraTransformations transforms = mapReader fromEntryPoint . applyTransformations transforms diff --git a/src/Juvix/Compiler/Core/Transformation.hs b/src/Juvix/Compiler/Core/Transformation.hs index da7705c303..03d6d268c4 100644 --- a/src/Juvix/Compiler/Core/Transformation.hs +++ b/src/Juvix/Compiler/Core/Transformation.hs @@ -19,6 +19,7 @@ import Juvix.Compiler.Core.Transformation.Check.Exec import Juvix.Compiler.Core.Transformation.Check.Rust import Juvix.Compiler.Core.Transformation.Check.VampIR import Juvix.Compiler.Core.Transformation.CombineInfoTables (combineInfoTables) +import Juvix.Compiler.Core.Transformation.ComputeCaseANF import Juvix.Compiler.Core.Transformation.ComputeTypeInfo import Juvix.Compiler.Core.Transformation.ConvertBuiltinTypes import Juvix.Compiler.Core.Transformation.DisambiguateNames @@ -72,6 +73,7 @@ applyTransformations ts tbl = foldM (flip appTrans) tbl ts IntToPrimInt -> return . intToPrimInt ConvertBuiltinTypes -> return . convertBuiltinTypes ComputeTypeInfo -> return . computeTypeInfo + ComputeCaseANF -> return . computeCaseANF UnrollRecursion -> unrollRecursion MatchToCase -> mapError (JuvixError @CoreError) . matchToCase EtaExpandApps -> return . etaExpansionApps diff --git a/src/Juvix/Compiler/Pipeline.hs b/src/Juvix/Compiler/Pipeline.hs index 2f6ac71cf6..ad95a0a790 100644 --- a/src/Juvix/Compiler/Pipeline.hs +++ b/src/Juvix/Compiler/Pipeline.hs @@ -165,7 +165,7 @@ upToTree :: (Members '[HighlightBuilder, Reader Parser.ParserResult, Reader EntryPoint, Reader Store.ModuleTable, Files, NameIdGen, Error JuvixError] r) => Sem r Tree.InfoTable upToTree = - upToStoredCore >>= \Core.CoreResult {..} -> storedCoreToTree Core.IdentityTrans _coreResultModule + upToStoredCore >>= \Core.CoreResult {..} -> storedCoreToTree Core.IdentityTrans [] _coreResultModule upToAsm :: (Members '[HighlightBuilder, Reader Parser.ParserResult, Reader EntryPoint, Reader Store.ModuleTable, Files, NameIdGen, Error JuvixError] r) => @@ -226,17 +226,21 @@ upToCoreTypecheck = do storedCoreToTree :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.TransformationId -> + [Core.TransformationId] -> Core.Module -> Sem r Tree.InfoTable -storedCoreToTree checkId md = do +storedCoreToTree checkId extraTransforms md = do fsize <- asks (^. entryPointFieldSize) - Tree.fromCore . Stripped.fromCore fsize . Core.computeCombinedInfoTable <$> Core.toStripped checkId md + Tree.fromCore + . Stripped.fromCore fsize + . Core.computeCombinedInfoTable + <$> (Core.toStripped checkId md >>= Core.applyExtraTransformations extraTransforms) storedCoreToAnoma :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r NockmaTree.AnomaResult -storedCoreToAnoma = storedCoreToTree Core.CheckAnoma >=> treeToAnoma +storedCoreToAnoma = storedCoreToTree Core.CheckAnoma Core.extraAnomaTransformations >=> treeToAnoma storedCoreToAsm :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Asm.InfoTable -storedCoreToAsm = storedCoreToTree Core.CheckExec >=> treeToAsm +storedCoreToAsm = storedCoreToTree Core.CheckExec [] >=> treeToAsm storedCoreToReg :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Reg.InfoTable storedCoreToReg = storedCoreToAsm >=> asmToReg @@ -245,13 +249,13 @@ storedCoreToMiniC :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core. storedCoreToMiniC = storedCoreToAsm >=> asmToMiniC storedCoreToRust :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Rust.Result -storedCoreToRust = storedCoreToTree Core.CheckRust >=> treeToReg >=> regToRust +storedCoreToRust = storedCoreToTree Core.CheckRust [] >=> treeToReg >=> regToRust storedCoreToRiscZeroRust :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Rust.Result -storedCoreToRiscZeroRust = storedCoreToTree Core.CheckRust >=> treeToReg >=> regToRiscZeroRust +storedCoreToRiscZeroRust = storedCoreToTree Core.CheckRust [] >=> treeToReg >=> regToRiscZeroRust storedCoreToCasm :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Casm.Result -storedCoreToCasm = local (set entryPointFieldSize cairoFieldSize) . storedCoreToTree Core.CheckCairo >=> treeToCasm +storedCoreToCasm = local (set entryPointFieldSize cairoFieldSize) . storedCoreToTree Core.CheckCairo [] >=> treeToCasm storedCoreToCairo :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Cairo.Result storedCoreToCairo = storedCoreToCasm >=> casmToCairo @@ -263,8 +267,8 @@ storedCoreToVampIR = Core.toVampIR >=> VampIR.fromCore . Core.computeCombinedInf -- Workflows from Core -------------------------------------------------------------------------------- -coreToTree :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.TransformationId -> Core.Module -> Sem r Tree.InfoTable -coreToTree checkId = Core.toStored >=> storedCoreToTree checkId +coreToTree :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.TransformationId -> [Core.TransformationId] -> Core.Module -> Sem r Tree.InfoTable +coreToTree checkId extraTransforms = Core.toStored >=> storedCoreToTree checkId extraTransforms coreToAsm :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Asm.InfoTable coreToAsm = Core.toStored >=> storedCoreToAsm @@ -279,7 +283,7 @@ coreToCairo :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module coreToCairo = Core.toStored >=> storedCoreToCairo coreToAnoma :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r NockmaTree.AnomaResult -coreToAnoma = coreToTree Core.CheckAnoma >=> treeToAnoma +coreToAnoma = coreToTree Core.CheckAnoma Core.extraAnomaTransformations >=> treeToAnoma coreToRust :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Rust.Result coreToRust = Core.toStored >=> storedCoreToRust