Reverted back to old arity raising

The corresponding test case passes this way.
This commit is contained in:
Anabra 2018-11-25 01:07:57 +01:00
parent e74e9c3838
commit 3711138a8f
4 changed files with 8 additions and 3 deletions

1
.gitignore vendored
View File

@ -22,3 +22,4 @@ cabal.project.local
output/ output/
*.ibc *.ibc
*.agdai *.agdai
.output

View File

@ -39,7 +39,7 @@ import Transformations.Optimising.SimpleDeadParameterElimination (simpleDeadPara
import Transformations.Optimising.CSE (commonSubExpressionElimination) import Transformations.Optimising.CSE (commonSubExpressionElimination)
import Transformations.Optimising.CaseCopyPropagation (caseCopyPropagation) import Transformations.Optimising.CaseCopyPropagation (caseCopyPropagation)
import Transformations.Optimising.GeneralizedUnboxing (generalizedUnboxing) import Transformations.Optimising.GeneralizedUnboxing (generalizedUnboxing)
import Transformations.Optimising.ArityRaisingSimple (arityRaising) import Transformations.Optimising.ArityRaising (arityRaising)
import Transformations.Optimising.CaseHoisting (caseHoisting) import Transformations.Optimising.CaseHoisting (caseHoisting)
import Transformations.Optimising.Inlining (lateInlining) import Transformations.Optimising.Inlining (lateInlining)
import Transformations.Optimising.NonSharedElimination (nonSharedElimination) import Transformations.Optimising.NonSharedElimination (nonSharedElimination)

View File

@ -126,7 +126,7 @@ transformation n = \case
CaseCopyPropagation -> noEffectMap $ noTypeEnv caseCopyPropagation CaseCopyPropagation -> noEffectMap $ noTypeEnv caseCopyPropagation
CaseHoisting -> noEffectMap caseHoisting CaseHoisting -> noEffectMap caseHoisting
GeneralizedUnboxing -> noEffectMap generalizedUnboxing GeneralizedUnboxing -> noEffectMap generalizedUnboxing
ArityRaising -> noEffectMap (arityRaising n) ArityRaising -> noEffectMap arityRaising
LateInlining -> noEffectMap lateInlining LateInlining -> noEffectMap lateInlining
UnitPropagation -> noEffectMap unitPropagation UnitPropagation -> noEffectMap unitPropagation
@ -346,6 +346,7 @@ saveTransformationInfo name content = do
outputDir <- view poOutputDir outputDir <- view poOutputDir
let fname = printf "%03d.%s" n name let fname = printf "%03d.%s" n name
liftIO $ do liftIO $ do
createDirectoryIfMissing True outputDir
writeFile (outputDir </> fname) $ show $ plain $ pretty content writeFile (outputDir </> fname) $ show $ plain $ pretty content
saveTypeEnv :: PipelineM () saveTypeEnv :: PipelineM ()

View File

@ -14,7 +14,7 @@ runTests = hspec spec
spec :: Spec spec :: Spec
spec = do spec = do
-- TODO: Reenable before merge -- TODO: Reenable before merge
xit "multi indirection - full remove" $ do it "multi indirection - full remove" $ do
let before = [prog| let before = [prog|
grinMain = grinMain =
p2 <- store (CInt 1) p2 <- store (CInt 1)
@ -57,9 +57,12 @@ spec = do
[ Pass [HPT CompileToAbstractProgram, HPT RunAbstractProgramPure] [ Pass [HPT CompileToAbstractProgram, HPT RunAbstractProgramPure]
, T ArityRaising , T ArityRaising
, T CopyPropagation , T CopyPropagation
, Pass [HPT CompileToAbstractProgram, HPT RunAbstractProgramPure]
, T SimpleDeadVariableElimination , T SimpleDeadVariableElimination
, Pass [HPT CompileToAbstractProgram, HPT RunAbstractProgramPure]
, T ArityRaising , T ArityRaising
, T CopyPropagation , T CopyPropagation
, Pass [HPT CompileToAbstractProgram, HPT RunAbstractProgramPure]
, T SimpleDeadVariableElimination , T SimpleDeadVariableElimination
] ]
(pipelineInfo, transformed) <- pipeline defaultOpts Nothing before ppln (pipelineInfo, transformed) <- pipeline defaultOpts Nothing before ppln