├── .gitattributes ├── .github └── FUNDING.yml ├── .gitignore ├── .travis.yml ├── BACKERS.md ├── README.md ├── bench.sh ├── bugs ├── arity-raising │ ├── arity-raising-bug-05.grin │ └── arity-should-work-01.grin ├── common-subexpression--copy-propagation │ └── 014.T-CommonSubExpressionElimination ├── cse │ └── bug01 │ │ ├── 034.SimpleDeadParameterElimination.binary │ │ ├── 034.SimpleDeadParameterElimination.grin │ │ ├── 035.CommonSubExpressionElimination.binary │ │ ├── 035.CommonSubExpressionElimination.grin │ │ └── how-to-reproduce.txt ├── dead-code-elimination │ ├── dce_effect_bug01.grin │ └── dce_minimal_bug.grin ├── generalized-unboxing │ └── bug01.grin ├── hpt │ ├── 023.LateInlining.grin │ └── 023.Statistics ├── parser │ └── float-literal.grin └── right-hoist-fetch │ ├── SplitFetch.6 │ ├── rhf_bug1.grin │ └── rhf_test1.grin ├── default.nix ├── docs ├── AbstractInterpretation.md ├── Analysis-Experiment.md ├── Design.md ├── Documentation.md ├── Exception-Support.md ├── GRIN-LLVM-CodeGen.md ├── GRIN-Type-System.md ├── MemoryManagement.md ├── Milestone-1.md ├── Milestone-2.md ├── RUNTIME.md ├── Readings.md └── TODO.md ├── flake.lock ├── flake.nix ├── grin ├── LICENSE ├── Setup.hs ├── app │ └── CLI │ │ ├── Lib.hs │ │ └── Main.hs ├── experiments │ └── FreshNames.hs ├── grin-benchmark.html ├── grin.cabal ├── grin │ ├── confluence_test.grin │ ├── do.grin │ ├── improvement1.grin │ ├── mem-leak-test.grin │ ├── minimal.grin │ ├── minimal2.grin │ ├── opt-stages-high-level │ │ ├── 002.simple.ll │ │ ├── 002.simple.s │ │ ├── 011.opt.grin │ │ ├── 011.opt.ll │ │ ├── 011.opt.s │ │ ├── c │ │ ├── notes │ │ ├── pp-min-full.sh │ │ ├── pp-min.sh │ │ ├── stage-00.grin │ │ ├── stage-01.grin │ │ ├── stage-02.grin │ │ ├── stage-03.grin │ │ ├── stage-05.grin │ │ ├── stage-06.grin │ │ ├── stage-07.grin │ │ ├── stage-08.grin │ │ └── test.c │ ├── opt-stages │ │ ├── stage-00.grin │ │ ├── stage-01.grin │ │ ├── stage-02.grin │ │ ├── stage-03.grin │ │ ├── stage-04.grin │ │ ├── stage-05.grin │ │ ├── stage-06.grin │ │ ├── stage-07.grin │ │ ├── stage-08.grin │ │ ├── stage-09.grin │ │ ├── stage-10.grin │ │ ├── stage-11.grin │ │ └── stage-12.grin │ ├── right.grin │ ├── sum-simple-output │ │ ├── 001.T-SparseCaseOptimisation │ │ ├── 002.T-CopyPropagation │ │ ├── 003.T-CaseCopyPropagation │ │ ├── 004.T-ArityRaising │ │ ├── 005.T-InlineEval │ │ ├── 006.T-BindNormalisation │ │ ├── 007.T-SparseCaseOptimisation │ │ ├── 008.T-CopyPropagation │ │ ├── 009.T-DeadVariableElimination │ │ ├── 010.T-CommonSubExpressionElimination │ │ ├── 011.T-GeneralizedUnboxing │ │ ├── 012.T-ArityRaising │ │ ├── 013.T-LateInlining │ │ ├── 014.T-BindNormalisation │ │ ├── 015.T-EvaluatedCaseElimination │ │ ├── 016.T-TrivialCaseElimination │ │ ├── 017.T-CopyPropagation │ │ ├── 018.T-DeadVariableElimination │ │ ├── 019.T-ArityRaising │ │ ├── 020.T-CopyPropagation │ │ ├── 021.T-DeadVariableElimination │ │ ├── 022.T-CaseHoisting │ │ ├── 023.T-ArityRaising │ │ ├── 024.T-CopyPropagation │ │ ├── 025.T-DeadVariableElimination │ │ ├── 026.T-CommonSubExpressionElimination │ │ ├── 027.T-ArityRaising │ │ ├── 028.T-CopyPropagation │ │ ├── 029.T-DeadVariableElimination │ │ ├── 030.T-ArityRaising │ │ ├── 031.T-CopyPropagation │ │ ├── 032.T-DeadVariableElimination │ │ ├── 033.high-level-opt-code.ll │ │ └── 033.high-level-opt-code.s │ ├── sum_opt.grin │ ├── sum_opt_desugared.grin │ ├── sum_opt_lint_errors.grin │ ├── sum_simple.grin │ ├── sum_simple_inlined_eval.grin │ └── undefined │ │ └── simple.grin ├── prim_ops.c ├── prim_ops.h ├── src │ ├── AbstractInterpretation │ │ ├── BinaryIR.hs │ │ ├── BinaryResult.hs │ │ ├── CreatedBy │ │ │ ├── CodeGen.hs │ │ │ ├── CodeGenBase.hs │ │ │ ├── Pretty.hs │ │ │ ├── Readback.hs │ │ │ ├── Result.hs │ │ │ └── Util.hs │ │ ├── EffectTracking │ │ │ ├── CodeGen.hs │ │ │ ├── CodeGenBase.hs │ │ │ ├── Pretty.hs │ │ │ └── Result.hs │ │ ├── ExtendedSyntax │ │ │ ├── BinaryIR.hs │ │ │ ├── BinaryResult.hs │ │ │ ├── CreatedBy │ │ │ │ ├── CodeGen.hs │ │ │ │ ├── CodeGenBase.hs │ │ │ │ ├── Pretty.hs │ │ │ │ ├── Readback.hs │ │ │ │ ├── Result.hs │ │ │ │ └── Util.hs │ │ │ ├── EffectTracking │ │ │ │ ├── CodeGen.hs │ │ │ │ ├── CodeGenBase.hs │ │ │ │ ├── Pretty.hs │ │ │ │ └── Result.hs │ │ │ ├── HeapPointsTo │ │ │ │ ├── CodeGen.hs │ │ │ │ ├── CodeGenBase.hs │ │ │ │ ├── Pretty.hs │ │ │ │ └── Result.hs │ │ │ ├── IR.hs │ │ │ ├── LiveVariable │ │ │ │ ├── CodeGen.hs │ │ │ │ ├── CodeGenBase.hs │ │ │ │ ├── Pretty.hs │ │ │ │ └── Result.hs │ │ │ ├── OptimiseAbstractProgram.hs │ │ │ ├── PrettyIR.hs │ │ │ ├── Reduce.hs │ │ │ ├── ReduceCpp.hs │ │ │ ├── Sharing │ │ │ │ ├── CodeGen.hs │ │ │ │ ├── Pretty.hs │ │ │ │ └── Result.hs │ │ │ └── Util.hs │ │ ├── HeapPointsTo │ │ │ ├── CodeGen.hs │ │ │ ├── CodeGenBase.hs │ │ │ ├── Pretty.hs │ │ │ └── Result.hs │ │ ├── IR.hs │ │ ├── LiveVariable │ │ │ ├── CodeGen.hs │ │ │ ├── CodeGenBase.hs │ │ │ ├── Pretty.hs │ │ │ └── Result.hs │ │ ├── Model.hs │ │ ├── OptimiseAbstractProgram.hs │ │ ├── PrettyIR.hs │ │ ├── Reduce.hs │ │ ├── ReduceCpp.hs │ │ ├── Sharing │ │ │ ├── CodeGen.hs │ │ │ ├── Pretty.hs │ │ │ └── Result.hs │ │ └── Util.hs │ ├── Grin │ │ ├── EffectMap.hs │ │ ├── ExtendedSyntax │ │ │ ├── EffectMap.hs │ │ │ ├── GADT.hs │ │ │ ├── Grin.hs │ │ │ ├── Lint.hs │ │ │ ├── Nametable.hs │ │ │ ├── Parse.hs │ │ │ ├── Parse │ │ │ │ ├── AST.hs │ │ │ │ ├── Basic.hs │ │ │ │ └── TypeEnv.hs │ │ │ ├── Pretty.hs │ │ │ ├── PrettyLint.hs │ │ │ ├── PrimOpsPrelude.hs │ │ │ ├── Statistics.hs │ │ │ ├── Syntax.hs │ │ │ ├── SyntaxDefs.hs │ │ │ ├── TH.hs │ │ │ ├── TypeCheck.hs │ │ │ ├── TypeEnv.hs │ │ │ └── TypeEnvDefs.hs │ │ ├── Grin.hs │ │ ├── Lint.hs │ │ ├── Nametable.hs │ │ ├── Parse.hs │ │ ├── Parse │ │ │ ├── AST.hs │ │ │ ├── Basic.hs │ │ │ └── TypeEnv.hs │ │ ├── Pretty.hs │ │ ├── PrettyLint.hs │ │ ├── PrimOpsPrelude.hs │ │ ├── Research.hs │ │ ├── Statistics.hs │ │ ├── Syntax.hs │ │ ├── SyntaxDefs.hs │ │ ├── TH.hs │ │ ├── TypeCheck.hs │ │ ├── TypeEnv.hs │ │ └── TypeEnvDefs.hs │ ├── Lens │ │ └── Micro │ │ │ └── Extra.hs │ ├── NOTES │ ├── Pipeline │ │ ├── Eval.hs │ │ ├── Optimizations.hs │ │ └── Pipeline.hs │ ├── Reducer │ │ ├── Base.hs │ │ ├── IO.hs │ │ ├── Interpreter │ │ │ ├── Base.hs │ │ │ ├── Definitional.hs │ │ │ ├── Definitional │ │ │ │ ├── Cib.hs │ │ │ │ ├── Instance.hs │ │ │ │ └── Internal.hs │ │ │ ├── Env.hs │ │ │ └── Store.hs │ │ ├── LLVM │ │ │ ├── Base.hs │ │ │ ├── CodeGen.hs │ │ │ ├── InferType.hs │ │ │ ├── JIT.hs │ │ │ ├── PrimOps.hs │ │ │ └── TypeGen.hs │ │ ├── PrimOps.hs │ │ └── Pure.hs │ ├── TODO │ ├── Test │ │ ├── Assertions.hs │ │ ├── Check.hs │ │ ├── ExtendedSyntax │ │ │ ├── Assertions.hs │ │ │ ├── New │ │ │ │ └── Test.hs │ │ │ ├── Old │ │ │ │ ├── Grammar.hs │ │ │ │ └── Test.hs │ │ │ └── Util.hs │ │ ├── Grammar.hs │ │ ├── IO.hs │ │ ├── Test.hs │ │ ├── Test.hs.incomplete │ │ └── Util.hs │ ├── Transformations │ │ ├── BindNormalisation.hs │ │ ├── CountVariableUse.hs │ │ ├── EffectMap.hs │ │ ├── ExtendedSyntax │ │ │ ├── BindNormalisation.hs │ │ │ ├── Conversion.hs │ │ │ ├── CountVariableUse.hs │ │ │ ├── EffectMap.hs │ │ │ ├── GenerateEval.hs │ │ │ ├── MangleNames.hs │ │ │ ├── Names.hs │ │ │ ├── Optimising │ │ │ │ ├── CSE.hs │ │ │ │ ├── CopyPropagation.hs │ │ │ │ ├── EvaluatedCaseElimination.hs │ │ │ │ └── TrivialCaseElimination.hs │ │ │ ├── StaticSingleAssignment.hs │ │ │ └── Util.hs │ │ ├── GenerateEval.hs │ │ ├── MangleNames.hs │ │ ├── Names.hs │ │ ├── Optimising │ │ │ ├── ArityRaising.hs │ │ │ ├── CSE.hs │ │ │ ├── CaseCopyPropagation.hs │ │ │ ├── CaseHoisting.hs │ │ │ ├── ConstantFolding.hs │ │ │ ├── ConstantPropagation.hs │ │ │ ├── CopyPropagation.hs │ │ │ ├── DeadDataElimination.hs │ │ │ ├── DeadFunctionElimination.hs │ │ │ ├── DeadParameterElimination.hs │ │ │ ├── DeadVariableElimination.hs │ │ │ ├── EvaluatedCaseElimination.hs │ │ │ ├── GeneralizedUnboxing.hs │ │ │ ├── Inlining.hs │ │ │ ├── NonSharedElimination.hs │ │ │ ├── SimpleDeadFunctionElimination.hs │ │ │ ├── SimpleDeadParameterElimination.hs │ │ │ ├── SimpleDeadVariableElimination.hs │ │ │ ├── SparseCaseOptimisation.hs │ │ │ ├── TrivialCaseElimination.hs │ │ │ └── UpdateElimination.hs │ │ ├── Simplifying │ │ │ ├── BindingPatternSimplification.hs │ │ │ ├── CaseSimplification.hs │ │ │ ├── ProducerNameIntroduction.hs │ │ │ ├── RegisterIntroduction.hs │ │ │ ├── RightHoistFetch2.hs │ │ │ ├── SplitFetch.hs │ │ │ ├── Vectorisation.hs │ │ │ └── Vectorisation2.hs │ │ ├── StaticSingleAssignment.hs │ │ ├── UnitPropagation.hs │ │ └── Util.hs │ ├── node_support.todo │ └── todo.micro ├── test-data │ ├── .gitignore │ ├── dead-data-elimination │ │ ├── length.grin │ │ ├── length.grin.expected │ │ ├── length2.grin │ │ ├── pnode.grin │ │ └── pnode.grin.expected │ ├── dead-parameter-elimination │ │ ├── pnode.grin │ │ ├── pnode.grin.expected │ │ └── pnode.grin.opts │ ├── idris-grin │ │ ├── c01 │ │ │ ├── 01 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ │ └── 02 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ ├── c02 │ │ │ ├── 01 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ │ ├── 03 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ │ └── 04 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ ├── c03 │ │ │ └── 01 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ ├── c06 │ │ │ └── 01 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ ├── c07 │ │ │ ├── 01 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ │ ├── 02 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ │ └── 03 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ ├── c08 │ │ │ ├── 01 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ │ └── 02 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ ├── c09 │ │ │ └── 01 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ ├── c10 │ │ │ ├── 01 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ │ ├── 02 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ │ ├── 03 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ │ └── 04 │ │ │ │ └── 004.TrivialCaseElimination.binary │ │ └── c11 │ │ │ ├── 02 │ │ │ └── 004.TrivialCaseElimination.binary │ │ │ ├── 04 │ │ │ └── 004.TrivialCaseElimination.binary │ │ │ ├── 05 │ │ │ └── 004.CopyPropagation.binary │ │ │ └── 09 │ │ │ └── 004.TrivialCaseElimination.binary │ └── sum-simple │ │ ├── sum_simple.binary │ │ ├── sum_simple_exp.grin │ │ ├── sum_simple_exp.grin.expected │ │ └── sum_simple_exp.grin.opts ├── test-runtime │ └── runtime.c ├── test │ ├── AbstractInterpretation │ │ ├── CreatedBySpec.hs │ │ ├── EffectTrackingSpec.hs │ │ ├── ExtendedSyntax │ │ │ ├── CreatedBySpec.hs │ │ │ ├── EffectTrackingSpec.hs │ │ │ ├── HptSpec.hs │ │ │ ├── IRSpec.hs │ │ │ ├── LiveVariableSpec.hs │ │ │ ├── OptimiseAbstractProgramSpec.hs │ │ │ └── SharingSpec.hs │ │ ├── HptSpec.hs │ │ ├── IRSpec.hs │ │ ├── LiveVariableSpec.hs │ │ ├── OptimiseAbstractProgramSpec.hs │ │ └── SharingSpec.hs │ ├── Benchmark.hs │ ├── EndToEnd.hs │ ├── ExtendedSyntax │ │ ├── LintSpec.hs │ │ ├── NametableSpec.hs │ │ └── ParserSpec.hs │ ├── LintSpec.hs │ ├── NametableSpec.hs │ ├── ParserSpec.hs │ ├── PipelineSpec.hs │ ├── PrettySpec.hs │ ├── PrimOpsSpec.hs │ ├── Reducer │ │ └── Interpreter │ │ │ └── Definitional │ │ │ └── CibSpec.hs │ ├── Samples │ │ ├── ArityFullRemoveSpec.hs │ │ └── SumListSpec.hs │ ├── Spec.hs │ ├── Test │ │ ├── EndToEnd.hs │ │ ├── EndToEndSpec.hs │ │ └── Hspec │ │ │ └── PipelineExample.hs │ ├── TestSpec.hs │ └── Transformations │ │ ├── BindNormalisationSpec.hs │ │ ├── ConfluenceSpec.hs │ │ ├── ExtendedSyntax │ │ ├── BindNormalisationSpec.hs │ │ ├── ConversionSpec.hs │ │ ├── MangleNamesSpec.hs │ │ ├── Optimising │ │ │ ├── CSESpec.hs │ │ │ ├── CopyPropagationSpec.hs │ │ │ ├── EvaluatedCaseEliminationSpec.hs │ │ │ └── TrivialCaseEliminationSpec.hs │ │ └── StaticSingleAssignmentSpec.hs │ │ ├── MangleNamesSpec.hs │ │ ├── Optimising │ │ ├── ArityRaisingSpec.hs │ │ ├── CSESpec.hs │ │ ├── CaseCopyPropagationSpec.hs │ │ ├── CaseHoistingSpec.hs │ │ ├── ConstantFoldingSpec.hs │ │ ├── ConstantPropagationSpec.hs │ │ ├── CopyPropagationSpec.hs │ │ ├── DeadDataEliminationSpec.hs │ │ ├── DeadFunctionEliminationSpec.hs │ │ ├── DeadParameterEliminationSpec.hs │ │ ├── DeadVariableEliminationSpec.hs │ │ ├── EvaluatedCaseEliminationSpec.hs │ │ ├── GeneralizedUnboxingSpec.hs │ │ ├── InliningSpec.hs │ │ ├── SimpleDeadFunctionEliminationSpec.hs │ │ ├── SimpleDeadParameterEliminationSpec.hs │ │ ├── SimpleDeadVariableEliminationSpec.hs │ │ ├── SparseCaseOptimisationSpec.hs │ │ ├── TrivialCaseEliminationSpec.hs │ │ └── UpdateEliminationSpec.hs │ │ ├── Simplifying │ │ ├── BindingPatternSimplificationSpec.hs │ │ ├── CaseSimplificationSpec.hs │ │ ├── ProducerNameIntroductionSpec.hs │ │ ├── RegisterIntroductionSpec.hs │ │ ├── RightHoistFetchSpec.hs │ │ ├── SplitFetchSpec.hs │ │ └── VectorisationSpec.hs │ │ └── StaticSingleAssignmentSpec.hs └── test_prim_ops.c ├── images ├── algebras.svg ├── arity-raising.png ├── case-copy-propagation.png ├── case-hoisting.png ├── case-simplification.png ├── common-sub-expression-elimination-1.png ├── common-sub-expression-elimination-2.png ├── copy-propagation-left.png ├── copy-propagation-right.png ├── evaluated-case-elimination.png ├── generalised-unboxing.png ├── grin-syntax.png ├── late-inlining.png ├── recursion-schemes-cheat-sheet.svg ├── register-introduction.png ├── right-hoist-fetch.png ├── sparse-case-optimisation.png ├── split-fetch-operation.png ├── trivial-case-elimination.png ├── unboxing-of-function-return-values.png ├── update-elimination.png ├── vectorisation.png └── whnf-update-elimination.png ├── nix ├── haskell.nix ├── sources.json └── sources.nix ├── notes ├── created-by.todo ├── datalog-cfa-info ├── dead-code-elimination.todo ├── debug_tooling ├── dynamic-grin.plan ├── effects.md ├── examples.note ├── future-impact ├── grin-speedup.plan ├── ideas.data-flow-analysis ├── live-variable.todo ├── liveness-and-effects.md ├── milestones ├── node_visualization ├── optimisation-notes ├── random-thougths ├── todo.asap ├── todo.benchmark ├── todo.codegen ├── todo.contributors ├── todo.critiques ├── todo.daily ├── todo.five-months ├── todo.gc ├── todo.ghc-frontend ├── todo.grin-syntax ├── todo.hpt ├── todo.ideas ├── todo.jul-aug-sep ├── todo.just-to-practice ├── todo.name-handling ├── todo.opt-ideas ├── todo.pipeline ├── todo.spmd ├── todo.sprint ├── todo.stg ├── todo.testing └── whole-program-compilation-challenges ├── papers ├── .gitignore ├── MoL-2010-19.text.pdf ├── The GRIN Project.pdf ├── boquist.pdf ├── data-layout │ └── Compiling Tree Transforms to Operate on Packed Representations.pdf ├── eutypes-2019 │ └── tex │ │ ├── abstract.tex │ │ ├── bib_database.bib │ │ ├── bibliography.tex │ │ ├── main.pdf │ │ ├── main.tex │ │ └── style.sty ├── grin-benchmarks.tar.gz ├── memory-management │ ├── 10.1.1.88.6828.pdf │ ├── UCAM-CL-TR-908.pdf │ ├── concurrency │ │ ├── Liveness-and-Safety-for-Channel-Based-Programming.pdf │ │ └── Safety-and-Liveness-in-Concurrent-Pointer-Programs.pdf │ ├── hraRevised.pdf │ └── necessity.ps └── tracing-jit-haskell-schilling.pdf ├── playground ├── hpt │ ├── 000.sum_simple_ghc.dfbin │ ├── IR.h │ ├── IR_load.cpp │ ├── IR_reduce.cpp │ ├── IR_save_result.cpp │ ├── IR_test.cpp │ ├── c │ └── hpt.cpp └── sum │ ├── sum-ghc-8.4.1-llvm-O0.s │ ├── sum-ghc-8.4.1-llvm-O3.s │ ├── sum-ghc-8.4.1.ll │ ├── sum-ghc-native-O2.asm │ └── sum.hs ├── sample └── tsumupto.lambdabin.grin.binary ├── shell.nix └── stack.yaml /.gitattributes: -------------------------------------------------------------------------------- 1 | playground/* linguist-documentation 2 | papers/* linguist-documentation 3 | images/* linguist-documentation 4 | *.html linguist-documentation 5 | 6 | grin/grin/* linguist-documentation 7 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | #github: # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] 4 | patreon: csaba_hruska 5 | # Replace with a single Patreon username 6 | #open_collective: # Replace with a single Open Collective username 7 | #ko_fi: # Replace with a single Ko-fi username 8 | #tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel 9 | #community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry 10 | #liberapay: # Replace with a single Liberapay username 11 | #issuehunt: # Replace with a single IssueHunt username 12 | #otechie: # Replace with a single Otechie username 13 | #custom: # Replace with a single custom sponsorship URL 14 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-* 3 | cabal-dev 4 | *.s 5 | *.ll 6 | *.hi 7 | *.chi 8 | *.chs.h 9 | *.dyn_o 10 | *.dyn_hi 11 | .hpc 12 | .hsenv 13 | .cabal-sandbox/ 14 | cabal.sandbox.config 15 | *.prof 16 | *.aux 17 | *.hp 18 | *.eventlog 19 | .stack-work/ 20 | cabal.project.local 21 | cabal.project.local~ 22 | .HTF/ 23 | output/ 24 | *.ibc 25 | *.agdai 26 | .output 27 | .grin-output/ 28 | grin/.end-to-end-test/ 29 | .vscode/ 30 | *.out 31 | *.out.ll 32 | *.out.s 33 | .ghc.environment.* 34 | hie.yaml 35 | *.lock 36 | result 37 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | dist: xenial 3 | language: c 4 | 5 | env: 6 | global: 7 | - GCC=gcc-5 8 | - GXX=g++-5 9 | - LLVM_VER=7.1.0 10 | 11 | cache: 12 | directories: 13 | - $HOME/.stack/ 14 | 15 | addons: 16 | apt: 17 | packages: 18 | - gcc-5 19 | - g++-5 20 | - libgmp-dev 21 | - llvm-7-dev 22 | sources: 23 | - llvm-toolchain-xenial-7 24 | - ubuntu-toolchain-r-test 25 | 26 | before_install: 27 | - mkdir -p ~/.local/bin 28 | - export PATH=~/.local/bin:$PATH 29 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 30 | - export CC=/usr/bin/$GCC 31 | - export CXX=/usr/bin/$GXX 32 | 33 | install: 34 | - stack update 35 | - travis_wait 120 stack --no-terminal --install-ghc test --only-dependencies --coverage 36 | 37 | script: 38 | - mkdir .output 39 | - stack test grin:grin-end-to-end-test grin:grin-test --coverage 40 | - stack exec grin -- grin/grin/sum_simple.grin --quiet 41 | 42 | after_script: 43 | - travis_retry curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.4.0/shc-linux-x64-8.0.1.tar.bz2 | tar -xj 44 | - ./shc --repo-token=8QkWaPJlRbej9X5N5AaXSommTtN7uEqRT combined all 45 | -------------------------------------------------------------------------------- /bench.sh: -------------------------------------------------------------------------------- 1 | stack bench grin --benchmark-arguments '--output=$benchmark.html' 2 | -------------------------------------------------------------------------------- /bugs/arity-raising/arity-should-work-01.grin: -------------------------------------------------------------------------------- 1 | {- 2 | run 3 | stack exec -- grin -t --ar arity-should-work-01.grin 4 | 5 | error: it seems that arity should kick in but it does not! 6 | 7 | Pipeline: T ArityRaising has effect: None 8 | -} 9 | 10 | sum.unboxed a1 l1 = 11 | v.0 <- fetch l1 12 | (Fupto upto.1.0 upto.2.0) <- pure v.0 13 | v.2.0.0 <- fetch upto.1.0 14 | (CInt i0$.0.0) <- pure v.2.0.0 15 | v.3.0.0 <- fetch upto.2.0 16 | (CInt i1$.0.0) <- pure v.3.0.0 17 | b0$.0.0 <- _prim_int_gt i0$.0.0 i1$.0.0 18 | case b0$.0.0 of 19 | #False -> 20 | i4$.0 <- pure 1 21 | unboxed.CInt.0.0.0 <- _prim_int_add i0$.0.0 i4$.0 22 | succV.0.0 <- pure (CInt unboxed.CInt.0.0.0) 23 | succ.0.0 <- store succV.0.0 24 | tail.0.0 <- store (Fupto succ.0.0 upto.2.0) 25 | v.6.1.0 <- fetch a1 26 | (CInt i4$.1.0) <- pure v.6.1.0 27 | unboxed.CInt.1.0 <- _prim_int_add i0$.0.0 i4$.1.0 28 | a2V.0 <- pure (CInt unboxed.CInt.1.0) 29 | a2.0 <- store a2V.0 30 | sum.unboxed a2.0 tail.0.0 31 | #True -> 32 | v.1.0 <- fetch a1 33 | (CInt unboxed.CInt.0.0) <- pure v.1.0 34 | pure unboxed.CInt.0.0 35 | 36 | grinMain = 37 | box2 <- store (CInt 1) 38 | box3 <- store (CInt 10) 39 | box4 <- store (CInt 0) 40 | l2 <- store (Fupto box2 box3) 41 | unboxed.CInt.2 <- sum.unboxed box4 l2 42 | _prim_int_print unboxed.CInt.2 43 | pure (CUnit) 44 | -------------------------------------------------------------------------------- /bugs/cse/bug01/034.SimpleDeadParameterElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/bugs/cse/bug01/034.SimpleDeadParameterElimination.binary -------------------------------------------------------------------------------- /bugs/cse/bug01/035.CommonSubExpressionElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/bugs/cse/bug01/035.CommonSubExpressionElimination.binary -------------------------------------------------------------------------------- /bugs/cse/bug01/how-to-reproduce.txt: -------------------------------------------------------------------------------- 1 | euler% stack exec grin -- ./bugs/cse/bug01/034.SimpleDeadParameterElimination.binary --load-binary --eval --quiet 2 | Same 4 3 | Same 5 4 | Same 3 5 | Same 4 6 | True 7 | True 8 | True 9 | euler% stack exec grin -- ./bugs/cse/bug01/034.SimpleDeadParameterElimination.binary --load-binary --hpt --cse --eval --quiet 10 | Same 4 11 | Same 5 12 | Same 3 13 | True 14 | True 15 | True 16 | euler% 17 | -------------------------------------------------------------------------------- /bugs/dead-code-elimination/dce_minimal_bug.grin: -------------------------------------------------------------------------------- 1 | {- 2 | RUN: 3 | stack exec -- grin dce_minimal_bug.grin --bn --pni --cby --lva -p -e --pe --dce -p 4 | -} 5 | 6 | grinMain = 7 | result_main <- Main.main1 $ -- BUG: DCE removes this line ; Main.main1 is effectful 8 | _prim_int_print $ 0 9 | 10 | Main.main1 = 11 | _prim_int_print $ 1 12 | -------------------------------------------------------------------------------- /bugs/hpt/023.Statistics: -------------------------------------------------------------------------------- 1 | Definitions: 19 2 | Binds: 5771 3 | Blocks: 316 4 | Cases: 714 5 | Alternatives: 1225 6 | Function calls: 519 7 | Returns: 4230 8 | Stores: 1145 9 | Fethces: 407 10 | Updates: 0 11 | ------------------ 12 | Summary: 14030 -------------------------------------------------------------------------------- /bugs/right-hoist-fetch/SplitFetch.6: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | (CInt r') <- eval t4 7 | _prim_int_print r' 8 | 9 | upto m n = 10 | (CInt m') <- eval m 11 | (CInt n') <- eval n 12 | b' <- _prim_int_gt m' n' 13 | case b' of 14 | True -> pure (CNil) 15 | False -> m1' <- _prim_int_add m' 1 16 | m1 <- store (CInt m1') 17 | p <- store (Fupto m1 n) 18 | pure (CCons m p) 19 | 20 | sum l = 21 | (l20 l21 l22) <- eval l 22 | case l20 of 23 | CNil -> pure (CInt 0) 24 | CCons -> (CInt x') <- eval l21 25 | (CInt s') <- sum l22 26 | ax' <- _prim_int_add x' s' 27 | pure (CInt ax') 28 | 29 | eval q = 30 | v0 <- fetch q[0] 31 | v1 <- fetch q[1] 32 | v2 <- fetch q[2] 33 | pure () 34 | case v0 of 35 | CInt -> pure (v0 v1 v2) 36 | CNil -> pure (v0 v1 v2) 37 | CCons -> pure (v0 v1 v2) 38 | Fupto -> (w0 w1 w2) <- upto v1 v2 39 | update q (w0 w1 w2) 40 | pure (w0 w1 w2) 41 | Fsum -> (z0 z1) <- sum v1 42 | update q (z0 z1) 43 | pure (z0 z1) 44 | -------------------------------------------------------------------------------- /bugs/right-hoist-fetch/rhf_bug1.grin: -------------------------------------------------------------------------------- 1 | eval q = 2 | v0 <- fetch q[0] 3 | v1 <- fetch q[1] 4 | case v0 of 5 | CInt -> pure (v0 v1) 6 | -------------------------------------------------------------------------------- /bugs/right-hoist-fetch/rhf_test1.grin: -------------------------------------------------------------------------------- 1 | 2 | -- create various variable dependency cases 3 | {- 4 | Heap Notation for values 5 | 1 -> CCons[{2},{3}] (CCons $2 $3) CCons[2, 3] CCons[$2, $3] (CCons $2 $3) 6 | 2 -> CInt[{T_Int64}] (CInt T_Int64) CInt[T_Int64] CInt[38] (CInt 38) 7 | 3 -> CNil[] (CNil) CNil[] CNil[] (CNil) 8 | Env 9 | q -> {1} $1 1 $2 $3 10 | -} 11 | eval q = -- $1 12 | v0 <- fetch q[0] -- CCons 13 | v1 <- fetch q[1] -- $2 14 | m0 <- fetch v1[0] -- CInt 15 | m1 <- fetch v1[0] -- 38 16 | -- TODO: add dependency chain 17 | case v0 of 18 | CInt -> pure (v0 v1) 19 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | let 2 | pkgs = import ./nix/haskell.nix; 3 | in 4 | pkgs.haskell-nix.project { 5 | src = pkgs.haskell-nix.haskellLib.cleanGit { 6 | name = "grin"; 7 | src = ./.; 8 | }; 9 | } 10 | -------------------------------------------------------------------------------- /docs/Design.md: -------------------------------------------------------------------------------- 1 | # Compiler goals 2 | 3 | - keep mapping between source code and machine code 4 | - debugging 5 | - step by step execution 6 | - breakpoints 7 | - observe values/thunks/nodes at runtime 8 | - collect statistics at runtime 9 | - nice UI (reusing exisiting tools; js libs, etc) 10 | 11 | # Other 12 | 13 | - parallel compilation 14 | - local and global optimizer 15 | 16 | # Technology 17 | 18 | - simple AST + shape functor + recursion-schemes 19 | - simple name handling 20 | - JIT backend as a library (e.g. monad transformer?) 21 | -------------------------------------------------------------------------------- /docs/Documentation.md: -------------------------------------------------------------------------------- 1 | ## Write it as a thesis 2 | 3 | The text can be reused for 4 | - book 5 | - web page 6 | - code documentation 7 | 8 | ## New material over Boquist's PhD thesis 9 | - HPT as type inference 10 | - LLVM backend 11 | - HPT as abstract interpretation with native codegen 12 | - node layout language 13 | - partial HPT (i.e. single module) 14 | - recursion schemes 15 | - on the fly node layout migration at runtime on live program data 16 | - compilation with transformation history (bidirectional source map) 17 | - separate heap (array) for each tag (node layout) 18 | -------------------------------------------------------------------------------- /docs/Exception-Support.md: -------------------------------------------------------------------------------- 1 | # Exception Support 2 | 3 | The goal is to support GHC Exception semantics in GRIN. 4 | 5 | ## GHC Exceptions 6 | 7 | - [A semantics for imprecise exceptions](https://www.microsoft.com/en-us/research/wp-content/uploads/1999/05/except.pdf), by Simon Peyton Jones, Alastair Reid, Tony Hoare, Simon Marlow, Fergus Henderson, in PLDI'99. 8 | - [Asynchronous exceptions in Haskell](https://www.microsoft.com/en-us/research/wp-content/uploads/2016/07/asynch-exns.pdf), by Simon Marlow, Simon Peyton Jones, Andy Moran and John Reppy, in PLDI'01. 9 | - [An Extensible Dynamically-Typed Hierarchy of Exceptions](https://simonmar.github.io/bib/papers/ext-exceptions.pdf), by Simon Marlow, in Haskell '06. 10 | 11 | ## Exception support in UHC 12 | 13 | [Exceptional GRIN](http://nbviewer.jupyter.org/github/uhc/uhc/blob/master/EHC/text/grinc/exceptionalgrin-final.pdf) (Christof Douma's master thesis) 14 | 15 | ## Exception Handling in LLVM 16 | 17 | https://llvm.org/docs/ExceptionHandling.html 18 | 19 | http://itanium-cxx-abi.github.io/cxx-abi/abi-eh.html 20 | -------------------------------------------------------------------------------- /docs/MemoryManagement.md: -------------------------------------------------------------------------------- 1 | # Memory management 2 | 3 | ## Heap pointer 4 | - do not use register pinning to store heap pointer 5 | - instead always pass heap pointer as a function argument 6 | - each thread has own heap and heap pointer 7 | - save heap pointer to a global variable when calling foreign function 8 | 9 | ## Compile time garbage collection 10 | [ASAP: As Static As Possible memory management](http://www.cl.cam.ac.uk/techreports/UCAM-CL-TR-908.html) 11 | 12 | related: [Dead data elimination](http://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/MoL-2010-19.text.pdf#page=55) in [A modern back-end for a dependently typed language](http://nbviewer.jupyter.org/github/grin-compiler/grin/blob/master/papers/MoL-2010-19.text.pdf) 13 | 14 | ## Sample Project 15 | [Sample project](https://github.com/robinvd/lang-experiments) for LLVM stack map based GC. 16 | 17 | ## Readings 18 | - http://craftinginterpreters.com/garbage-collection.html 19 | -------------------------------------------------------------------------------- /docs/Milestone-1.md: -------------------------------------------------------------------------------- 1 | # MVP 2 | 3 | ## builtin types 4 | 5 | - word 6 | - int 7 | - float 8 | - bool 9 | 10 | ## primops 11 | 12 | - add / sub (float + int + word) 13 | - mul / div (float + int + word) 14 | - gt / ge / lt / le (float + int + word) 15 | - eq / ne (float + int + word + bool) 16 | 17 | ## features 18 | - [x] node support for codegen 19 | - [x] no garbage collector 20 | - [x] support for builtin types and primops 21 | - [x] single module (no module system) 22 | - [x] GRIN type system 23 | - [x] typed transformations 24 | - [x] compiled HPT 25 | 26 | ## documentation 27 | - HPT 28 | - llvm codegen ; HPT as LLVM type inference 29 | - shape functor ; pro / cons 30 | - GRIN type system 31 | 32 | ## sample programs 33 | - observe compilation stages: GRIN -> LLVM -> x64 34 | 35 | ## after the MVP 36 | - LLVM codegen from high level GRIN without analysis 37 | - migrate runtime values from universal representation to the optimized one 38 | -------------------------------------------------------------------------------- /docs/Milestone-2.md: -------------------------------------------------------------------------------- 1 | # Working framework 2 | 3 | name handling is the biggest blocker ; module support is also related 4 | 5 | ## goal: robust and working optimizer framework 6 | 7 | duration: 2 weeks 8 | 9 | deadline: May 6 10 | 11 | ### new additions 12 | - ~~module system~~ 13 | - [x] name handling 14 | - [x] SSA name conversion pass to allow local name scopes 15 | - ~~locally new names (in block + pass to flatten out and maintain uniqueness)~~ 16 | - ~~name scopes (module, function)~~ 17 | - [x] liberal name support (like in llvm, i.e. %"any characer 1234 {}!@#$%} -" 18 | - [ ] context aware logging framework (for errors and debugging) 19 | - [x] pass manager ; run passes until the fixpoint is reached 20 | - ~~add `allocate` memory operation to grin ; required by circular data structures~~ 21 | - [x] grin syntax for type signatures 22 | - [x] grin syntax to declare primops with their type signature 23 | - [x] grin validator pass 24 | - ~~hpt result based dead code elimination pass~~ 25 | 26 | ### finish 27 | - [x] lambda frontend 28 | - [x] type system 29 | - [ ] simplification transformations (answer if vectorisation equals with a mapping to tagged unions) 30 | - [ ] missing optimisations 31 | - [x] case hoisting 32 | - [ ] whnf update elimination 33 | - [x] dead parameter elimination 34 | - [ ] simplify llvm codegen (factor out complex operations as passes) 35 | -------------------------------------------------------------------------------- /docs/RUNTIME.md: -------------------------------------------------------------------------------- 1 | * Garbage collector 2 | * Long-term goal: write the GC itself in GRIN. This requires some reified representation of the GRIN datastructures, i.e. an ADT capturing the Node types, which we can coerce into a runtime state. It would essentially be the dual of what a debugger does: take the runtime state and turn it into a traversable datastructure. 3 | * For now we should write it in Rust or similar low-level language, KISS. 4 | * Threading 5 | * FFI 6 | * Debugging/inspection 7 | * Dynamic bytecode loading 8 | * Interactive prompt to runtime? 9 | * JIT compiler 10 | * Tracer 11 | * Stats/profiling - memory consumption etc 12 | 13 | * Read 14 | * lhc notes: https://github.com/Lemmih/lhc/blob/master/bedrock/NOTES 15 | * Disruptor: https://lmax-exchange.github.io/disruptor/files/Disruptor-1.0.pdf 16 | * JVM GC: http://info.azul.com/rs/090-OKK-659/images/WP-Understanding%20Java%20Garbage%20Collection%20-%2020170110.pdf 17 | * Hotspot parallel gc: http://www.oracle.com/technetwork/java/javase/tech/memorymanagement-whitepaper-1-150020.pdf 18 | * http://judy.sourceforge.net/doc/10minutes.htm -------------------------------------------------------------------------------- /docs/TODO.md: -------------------------------------------------------------------------------- 1 | # Todo ideas 2 | 3 | - distinguish Val constuctors (LambdaPattern ConstansPattern SimpleValue Value) 4 | - rename Val types to a more descriptive names; see above 5 | - better name representation instead of strings 6 | - generate unique names when branching (unique name A + branching direction = unique name B) 7 | - efficient substitution 8 | - type safer and easy to use AST 9 | 10 | 11 | # CodeGen 12 | 13 | - simplify/refactor LLVM codegen 14 | - vectorisation = tagged union conversion (on branch: var-tag-node-is-tagged-union) ; better syntax for tagged union (parser + pretty printer) 15 | - read back LLVM reduced result to Haskell data (including the heap) 16 | 17 | # GRIN framework 18 | 19 | - scoped type environment 20 | - scoped names ; it would make inlining easy (the idea is similar to bound) 21 | - HPT 22 | - optimisiations 23 | - type env 24 | 25 | # HPT 26 | 27 | - LLVM backend for HPT IR 28 | - inline support 29 | 30 | # SIMD / SPMD 31 | - [The story of ispc](http://pharr.org/matt/blog/2018/04/30/ispc-all.html) 32 | - [Intel SPMD Program Compiler](https://ispc.github.io) 33 | - [Tutorial: Creating an SPMD Vectorizer for OpenCL with LLVM](https://www.youtube.com/watch?v=ePu6c4FLc9I) 34 | 35 | # GRIN language 36 | 37 | ### shared blocks 38 | 39 | - add support for named blocks and a corresponding call block command i.e. `tailcall` / `continue` / `join` / `follow` __BLOCK_NAME__ 40 | 41 | ### STG primops 42 | 43 | - add primops to support STG style unknown funtion call. Whith these primops incremental compilation could be supported 44 | - static analysis of STG primops to transform STG closures and info tables to ordinary GRIN C/F/P nodes 45 | -------------------------------------------------------------------------------- /grin/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Andor Pénzes, Csaba Hruska, Péter Podlovics 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Andor Pénzes, Csaba Hruska, Péter Podlovics 17 | nor the names of other contributors may be used to endorse or 18 | promote products derived from this software without specific 19 | prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /grin/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /grin/app/CLI/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import System.Environment (getArgs) 4 | import CLI.Lib (mainWithArgs) 5 | 6 | 7 | main :: IO () 8 | main = do 9 | args <- getArgs 10 | mainWithArgs args 11 | -------------------------------------------------------------------------------- /grin/grin/confluence_test.grin: -------------------------------------------------------------------------------- 1 | grinMain = 2 | p1 <- store (CInt 0) 3 | p2 <- store (CInt 1) 4 | p3 <- store (CInt 1000) 5 | p4 <- store (Fupto p2 p3) 6 | p5 <- store (Fsum p1 p4) 7 | (Fsum p15 p16) <- fetch p5 8 | n13' <- sum p15 p16 9 | _prim_int_print n13' 10 | 11 | sum p10 p11 = 12 | (Fupto p17 p18) <- fetch p11 13 | p6 <- pure p17 14 | p7 <- pure p18 15 | (CInt n2') <- fetch p6 16 | (CInt n3') <- fetch p7 17 | b1' <- _prim_int_gt n2' n3' 18 | do 19 | case b1' of 20 | #True -> 21 | v10_1 <- pure (CNil) 22 | case v10_1 of 23 | (CNil) -> 24 | (CInt n14') <- fetch p10 25 | pure n14' 26 | (CCons p12 p13) -> 27 | (CInt n5') <- fetch p10 28 | (CInt n6') <- fetch p12 29 | n7' <- _prim_int_add n5' n6' 30 | p14 <- store (CInt n7') 31 | sum p14 p13 32 | #False -> 33 | n4' <- _prim_int_add n2' 1 34 | p8 <- store (CInt n4') 35 | p9 <- store (Fupto p8 p7) 36 | v10_2 <- pure (CCons p6 p9) 37 | case v10_2 of 38 | (CNil) -> 39 | (CInt n14'_2) <- fetch p10 40 | pure n14'_2 41 | (CCons p12_2 p13_2) -> 42 | (CInt n5'_2) <- fetch p10 43 | (CInt n6'_2) <- fetch p12_2 44 | n7'_2 <- _prim_int_add n5'_2 n6'_2 45 | p14_2 <- store (CInt n7'_2) 46 | sum p14_2 p13_2 -------------------------------------------------------------------------------- /grin/grin/do.grin: -------------------------------------------------------------------------------- 1 | grinMain = 2 | n13 <- sum 0 1 10 3 | _prim_int_print n13 4 | 5 | sum n29 n30 n31 = 6 | b2 <- _prim_int_gt n30 n31 7 | if b2 then 8 | x <- do 9 | case CFalse of 10 | CFalse -> pure () 11 | pure n29 12 | else 13 | n18 <- _prim_int_add n30 1 14 | n28 <- _prim_int_add n29 n30 15 | sum n28 n18 n31 16 | -------------------------------------------------------------------------------- /grin/grin/minimal.grin: -------------------------------------------------------------------------------- 1 | grinMain = 2 | n30 <- pure 2 3 | n18 <- _prim_int_add n30 1 4 | n31 <- sum n18 5 | n28 <- _prim_int_add n18 31 6 | pure n28 7 | 8 | sum b2 = pure 111 9 | -------------------------------------------------------------------------------- /grin/grin/minimal2.grin: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fadd t1 t2) 5 | (CInt r') <- eval t3 6 | _prim_int_print r' 7 | 8 | add m n = 9 | (CInt m') <- eval m 10 | (CInt n') <- eval n 11 | b' <- _prim_int_add m' n' 12 | pure (CInt b') 13 | 14 | eval q = 15 | v <- fetch q 16 | case v of 17 | (CInt x'1) -> pure v 18 | (Fadd a b) -> w <- add a b 19 | update q w 20 | pure w 21 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/011.opt.grin: -------------------------------------------------------------------------------- 1 | grinMain = 2 | n13' <- sum 0 1 1000 3 | _prim_int_print n13' 4 | 5 | sum p10 p111 p112 = 6 | b1' <- _prim_int_gt p111 p112 7 | case b1' of 8 | #True -> 9 | do 10 | pure p10 11 | #False -> 12 | n4' <- _prim_int_add p111 1 13 | do 14 | n7'_2 <- _prim_int_add p10 p111 15 | sum n7'_2 n4' p112 16 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/011.opt.ll: -------------------------------------------------------------------------------- 1 | ; ModuleID = 'basic' 2 | source_filename = "" 3 | 4 | @_heap_ptr_ = global i64 0 5 | 6 | declare void @_prim_int_print(i64) 7 | 8 | define void @grinMain() #0 { 9 | grinMain.entry: 10 | %"n13'.0" = tail call fastcc i64 @sum(i64 0, i64 1, i64 1000) 11 | call void @_prim_int_print(i64 %"n13'.0") 12 | ret void 13 | 14 | error_block: ; No predecessors! 15 | tail call void @_prim_int_print(i64 666) 16 | unreachable 17 | } 18 | 19 | define private fastcc i64 @sum(i64 %p10, i64 %p111, i64 %p112) #0 { 20 | sum.entry: 21 | %"b1'.1" = icmp sgt i64 %p111, %p112 22 | switch i1 %"b1'.1", label %error_block [ 23 | i1 true, label %block.bool_True.2 24 | i1 false, label %block.bool_False.3 25 | ] 26 | 27 | block.bool_True.2: ; preds = %sum.entry 28 | br label %block.exit.7 29 | 30 | block.bool_False.3: ; preds = %sum.entry 31 | %"n4'.4" = add i64 %p111, 1 32 | %"n7'_2.5" = add i64 %p10, %p111 33 | %result.bool_False.6 = tail call fastcc i64 @sum(i64 %"n7'_2.5", i64 %"n4'.4", i64 %p112) 34 | br label %block.exit.7 35 | 36 | block.exit.7: ; preds = %block.bool_False.3, %block.bool_True.2 37 | %result.sum.8 = phi i64 [ %p10, %block.bool_True.2 ], [ %result.bool_False.6, %block.bool_False.3 ] 38 | ret i64 %result.sum.8 39 | 40 | error_block: ; preds = %sum.entry 41 | tail call void @_prim_int_print(i64 666) 42 | unreachable 43 | } 44 | 45 | attributes #0 = { "no-jump-tables"="true" } 46 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/011.opt.s: -------------------------------------------------------------------------------- 1 | .text 2 | .file "" 3 | .globl grinMain # -- Begin function grinMain 4 | .p2align 4, 0x90 5 | .type grinMain,@function 6 | grinMain: # @grinMain 7 | .cfi_startproc 8 | # BB#0: # %grinMain.entry 9 | movl $500500, %edi # imm = 0x7A314 10 | jmp _prim_int_print # TAILCALL 11 | .Lfunc_end0: 12 | .size grinMain, .Lfunc_end0-grinMain 13 | .cfi_endproc 14 | # -- End function 15 | .type _heap_ptr_,@object # @_heap_ptr_ 16 | .bss 17 | .globl _heap_ptr_ 18 | .p2align 3 19 | _heap_ptr_: 20 | .quad 0 # 0x0 21 | .size _heap_ptr_, 8 22 | 23 | 24 | .section ".note.GNU-stack","",@progbits 25 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/c: -------------------------------------------------------------------------------- 1 | SIMPLE="002.simple" 2 | OPT="011.opt" 3 | 4 | llc-5.0 -O3 -relocation-model=pic -filetype=obj ${SIMPLE}.ll 5 | gcc -O3 test.c ${SIMPLE}.o -s -o slow 6 | ./slow 7 | 8 | llc-5.0 -O3 -relocation-model=pic -filetype=obj ${OPT}.ll 9 | gcc -O3 test.c ${OPT}.o -s -o opt 10 | ./opt 11 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/notes: -------------------------------------------------------------------------------- 1 | pipeline 2 | 00: 3 | - frontend grin codegen 4 | 01: 5 | - eval inline 6 | - update elimination based on sharing analysis 7 | 02: 8 | - evaluated case elimination 9 | - trivial case elimination 10 | 03: 11 | - unboxing return values 12 | - copy propagation 13 | after: NO! 14 | - vectorisation 15 | - case simplification 16 | 05: 17 | - late inlining (upto) 18 | - bind normalisation 19 | 06: 20 | - case hoising 21 | - dead code elimination (upto) 22 | 07: 23 | - constant propagation 24 | - copy propagation 25 | 08: 26 | - common sub-expression elimination 27 | - dead code elimination (variable) 28 | - copy propagation 29 | - dead code elimination (variable) 30 | 09: 31 | - arity raising 32 | 10: 33 | - dead code elimination (variable) 34 | - copy propagation 35 | 11: 36 | - arity raising 37 | 12: 38 | - copy propagation 39 | - dead code elimination (variable) 40 | 41 | NOTE: 42 | from 06 the current system should do 43 | 44 | round A: 45 | - arity raising 46 | 47 | - case hoising 48 | to be implemented 49 | 50 | - copy propagation 51 | - common sub-expression elimination 52 | - constant propagation 53 | - dead code elimination (upto) 54 | - dead code elimination (variable) 55 | - bind normalisation 56 | 57 | round B: 58 | - evaluated case elimination 59 | - trivial case elimination 60 | - eval inline 61 | - late inlining (upto) 62 | - unboxing return values 63 | - update elimination based on sharing analysis 64 | - vectorisation 65 | - case simplification 66 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/pp-min-full.sh: -------------------------------------------------------------------------------- 1 | reset 2 | stack exec -- grin -o . -p \ 3 | -t --save-llvm slow --save-grin slow.grin --llvm \ 4 | --ie --dpe --bn -t \ 5 | --sco --ece --tce -t \ 6 | --gub -t --cp \ 7 | --li --dpe --bn -t \ 8 | --cp --dve --ch -t \ 9 | --bn -t \ 10 | --cse --cp --dve \ 11 | --ar --cp --dve \ 12 | --hpt \ 13 | --ar --cp --dve \ 14 | -p --hpt --save-llvm fast --llvm \ 15 | stage-00.grin 16 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/pp-min.sh: -------------------------------------------------------------------------------- 1 | reset 2 | stack exec -- grin -o . -p \ 3 | --bn --cnp --hpt \ 4 | --save-llvm simple --llvm \ 5 | --cse --cp --dve \ 6 | --ar --cp --dve \ 7 | --hpt \ 8 | --ar --cp --dve \ 9 | --hpt -p --llvm \ 10 | --save-llvm opt --save-grin opt.grin --ast \ 11 | stage-06.grin 12 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/stage-00.grin: -------------------------------------------------------------------------------- 1 | -- page 302 2 | {- 3 | after: 4 | - frontend grin codegen 5 | -} 6 | 7 | grinMain = 8 | p1 <- store (CInt 0) 9 | p2 <- store (CInt 1) 10 | p3 <- store (CInt 1000) 11 | p4 <- store (Fupto p2 p3) 12 | p5 <- store (Fsum p1 p4) 13 | (CInt n1') <- eval p5 14 | _prim_int_print n1' 15 | 16 | upto p6 p7 = 17 | (CInt n2') <- eval p6 18 | (CInt n3') <- eval p7 19 | b1' <- _prim_int_gt n2' n3' 20 | case b1' of 21 | #True -> 22 | pure (CNil) 23 | #False -> 24 | n4' <- _prim_int_add n2' 1 25 | p8 <- store (CInt n4') 26 | p9 <- store (Fupto p8 p7) 27 | pure (CCons p6 p9) 28 | 29 | sum p10 p11 = 30 | v1 <- eval p11 31 | case v1 of 32 | (CNil) -> 33 | eval p10 34 | (CCons p12 p13) -> 35 | (CInt n5') <- eval p10 36 | (CInt n6') <- eval p12 37 | n7' <- _prim_int_add n5' n6' 38 | p14 <- store (CInt n7') 39 | sum p14 p13 40 | 41 | eval e_p1 = 42 | e_v1 <- fetch e_p1 43 | case e_v1 of 44 | #default -> 45 | pure e_v1 46 | (Fupto e_p2 e_p3) -> 47 | e_v2 <- upto e_p2 e_p3 48 | --update e_p1 e_v2 49 | pure e_v2 50 | (Fsum e_p4 e_p5) -> 51 | e_v3 <- sum e_p4 e_p5 52 | --update e_p1 e_v3 53 | pure e_v3 54 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/stage-02.grin: -------------------------------------------------------------------------------- 1 | -- page 305 2 | {- 3 | after: 4 | - evaluated case elimination 5 | - trivial case elimination 6 | -} 7 | 8 | grinMain = 9 | p1 <- store (CInt 0) 10 | p2 <- store (CInt 1) 11 | p3 <- store (CInt 1000) 12 | p4 <- store (Fupto p2 p3) 13 | p5 <- store (Fsum p1 p4) 14 | v2 <- fetch p5 15 | (Fsum p15 p16) <- pure v2 16 | v3 <- sum p15 p16 17 | (CInt n1') <- pure v3 18 | _prim_int_print n1' 19 | 20 | upto p6 p7 = 21 | v4 <- fetch p6 22 | v5 <- pure v4 23 | (CInt n2') <- pure v5 24 | v6 <- fetch p7 25 | v7 <- pure v6 26 | (CInt n3') <- pure v7 27 | b1' <- _prim_int_gt n2' n3' 28 | case b1' of 29 | #True -> 30 | pure (CNil) 31 | #False -> 32 | n4' <- _prim_int_add n2' 1 33 | p8 <- store (CInt n4') 34 | p9 <- store (Fupto p8 p7) 35 | pure (CCons p6 p9) 36 | 37 | sum p10 p11 = 38 | v8 <- fetch p11 39 | (Fupto p17 p18) <- pure v8 40 | v9 <- upto p17 p18 41 | v10 <- pure v9 42 | case v10 of 43 | (CNil) -> 44 | v11 <- fetch p10 45 | v12 <- pure v11 46 | pure v12 47 | (CCons p12 p13) -> 48 | v13 <- fetch p10 49 | v15 <- pure v13 50 | (CInt n5') <- pure v15 51 | v16 <- fetch p12 52 | v17 <- pure v16 53 | (CInt n6') <- pure v17 54 | n7' <- _prim_int_add n5' n6' 55 | p14 <- store (CInt n7') 56 | sum p14 p13 57 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/stage-03.grin: -------------------------------------------------------------------------------- 1 | -- page 306 2 | {- 3 | after: 4 | - unboxing return values 5 | - copy propagation 6 | -} 7 | 8 | grinMain = 9 | p1 <- store (CInt 0) 10 | p2 <- store (CInt 1) 11 | p3 <- store (CInt 1000) 12 | p4 <- store (Fupto p2 p3) 13 | p5 <- store (Fsum p1 p4) 14 | (Fsum p15 p16) <- fetch p5 15 | n13' <- sum p15 p16 16 | _prim_int_print n13' 17 | 18 | upto p6 p7 = 19 | (CInt n2') <- fetch p6 20 | (CInt n3') <- fetch p7 21 | b1' <- _prim_int_gt n2' n3' 22 | case b1' of 23 | #True -> 24 | pure (CNil) 25 | #False -> 26 | n4' <- _prim_int_add n2' 1 27 | p8 <- store (CInt n4') 28 | p9 <- store (Fupto p8 p7) 29 | pure (CCons p6 p9) 30 | 31 | sum p10 p11 = 32 | (Fupto p17 p18) <- fetch p11 33 | v10 <- upto p17 p18 34 | case v10 of 35 | (CNil) -> 36 | (CInt n14') <- fetch p10 37 | pure n14' 38 | (CCons p12 p13) -> 39 | (CInt n5') <- fetch p10 40 | (CInt n6') <- fetch p12 41 | n7' <- _prim_int_add n5' n6' 42 | p14 <- store (CInt n7') 43 | sum p14 p13 44 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/stage-06.grin: -------------------------------------------------------------------------------- 1 | -- case hoisting 2 | 3 | -- no change 4 | grinMain = 5 | p1 <- store (CInt 0) 6 | p2 <- store (CInt 1) 7 | p3 <- store (CInt 1000) 8 | p4 <- store (Fupto p2 p3) 9 | p5 <- store (Fsum p1 p4) 10 | (Fsum p15 p16) <- fetch p5 11 | n13' <- sum p15 p16 12 | _prim_int_print n13' 13 | 14 | sum p10 p11 = 15 | (Fupto p17 p18) <- fetch p11 16 | p6 <- pure p17 17 | p7 <- pure p18 18 | (CInt n2') <- fetch p6 19 | (CInt n3') <- fetch p7 20 | b1' <- _prim_int_gt n2' n3' 21 | do 22 | case b1' of 23 | #True -> 24 | v10_1 <- pure (CNil) 25 | case v10_1 of 26 | (CNil) -> 27 | (CInt n14') <- fetch p10 28 | pure n14' 29 | (CCons p12 p13) -> 30 | (CInt n5') <- fetch p10 31 | (CInt n6') <- fetch p12 32 | n7' <- _prim_int_add n5' n6' 33 | p14 <- store (CInt n7') 34 | sum p14 p13 35 | #False -> 36 | n4' <- _prim_int_add n2' 1 37 | p8 <- store (CInt n4') 38 | p9 <- store (Fupto p8 p7) 39 | v10_2 <- pure (CCons p6 p9) 40 | case v10_2 of 41 | (CNil) -> 42 | (CInt n14'_2) <- fetch p10 43 | pure n14'_2 44 | (CCons p12_2 p13_2) -> 45 | (CInt n5'_2) <- fetch p10 46 | (CInt n6'_2) <- fetch p12_2 47 | n7'_2 <- _prim_int_add n5'_2 n6'_2 48 | p14_2 <- store (CInt n7'_2) 49 | sum p14_2 p13_2 50 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/stage-07.grin: -------------------------------------------------------------------------------- 1 | -- case hoisting 2 | 3 | -- no change 4 | grinMain = 5 | p1 <- store (CInt 0) 6 | p2 <- store (CInt 1) 7 | p3 <- store (CInt 1000) 8 | p4 <- store (Fupto p2 p3) 9 | p5 <- store (Fsum p1 p4) 10 | (Fsum p15 p16) <- fetch p5 11 | n13' <- sum p15 p16 12 | _prim_int_print n13' 13 | 14 | sum p10 p11 = 15 | (Fupto p17 p18) <- fetch p11 16 | p6 <- pure p17 17 | p7 <- pure p18 18 | (CInt n2') <- fetch p6 19 | (CInt n3') <- fetch p7 20 | b1' <- _prim_int_gt n2' n3' 21 | case b1' of 22 | #True -> 23 | v10_1 <- pure (CNil) 24 | (CInt n14') <- fetch p10 25 | pure n14' 26 | #False -> 27 | n4' <- _prim_int_add n2' 1 28 | p8 <- store (CInt n4') 29 | p9 <- store (Fupto p8 p7) 30 | v10_2 <- pure (CCons p6 p9) 31 | (CInt n5'_2) <- fetch p10 32 | (CInt n6'_2) <- fetch p6 33 | n7'_2 <- _prim_int_add n5'_2 n6'_2 34 | p14_2 <- store (CInt n7'_2) 35 | sum p14_2 p9 36 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/stage-08.grin: -------------------------------------------------------------------------------- 1 | -- cse, dead variable, copy prop 2 | 3 | -- no change 4 | grinMain = 5 | p1 <- store (CInt 0) 6 | p2 <- store (CInt 1) 7 | p3 <- store (CInt 1000) 8 | p4 <- store (Fupto p2 p3) 9 | n13' <- sum p1 p4 10 | _prim_int_print n13' 11 | 12 | sum p10 p11 = 13 | (Fupto p6 p7) <- fetch p11 14 | (CInt n2') <- fetch p6 15 | (CInt n3') <- fetch p7 16 | b1' <- _prim_int_gt n2' n3' 17 | case b1' of 18 | #True -> 19 | (CInt n14') <- fetch p10 20 | pure n14' 21 | #False -> 22 | n4' <- _prim_int_add n2' 1 23 | p8 <- store (CInt n4') 24 | p9 <- store (Fupto p8 p7) 25 | (CInt n5'_2) <- fetch p10 26 | n7'_2 <- _prim_int_add n5'_2 n2' 27 | p14_2 <- store (CInt n7'_2) 28 | sum p14_2 p9 29 | -------------------------------------------------------------------------------- /grin/grin/opt-stages-high-level/test.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | extern int64_t _heap_ptr_; 6 | int64_t grinMain(); 7 | 8 | int64_t _prim_int_print(int64_t i) { 9 | printf("%ld\n", i); 10 | return i; 11 | } 12 | 13 | int main() { 14 | int64_t* heap = malloc(100*1024*1024); 15 | _heap_ptr_ = (int64_t)heap; 16 | grinMain(); 17 | printf("used memory: %ld bytes\n", (uint64_t)_heap_ptr_ - (uint64_t)heap); 18 | free(heap); 19 | return 0; 20 | } 21 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-00.grin: -------------------------------------------------------------------------------- 1 | -- page 302 2 | {- 3 | after: 4 | - frontend grin codegen 5 | -} 6 | 7 | grinMain = 8 | p1 <- store (CInt 0) 9 | p2 <- store (CInt 1) 10 | p3 <- store (CInt 1000) 11 | p4 <- store (Fupto p2 p3) 12 | p5 <- store (Fsum p1 p4) 13 | (CInt n1') <- eval p5 14 | _prim_int_print n1' 15 | 16 | upto p6 p7 = 17 | (CInt n2') <- eval p6 18 | (CInt n3') <- eval p7 19 | b1' <- _prim_int_gt n2' n3' 20 | case b1' of 21 | #True -> 22 | pure (CNil) 23 | #False -> 24 | n4' <- _prim_int_add n2' 1 25 | p8 <- store (CInt n4') 26 | p9 <- store (Fupto p8 p7) 27 | pure (CCons p6 p9) 28 | 29 | sum p10 p11 = 30 | v1 <- eval p11 31 | case v1 of 32 | (CNil) -> 33 | eval p10 34 | (CCons p12 p13) -> 35 | (CInt n5') <- eval p10 36 | (CInt n6') <- eval p12 37 | n7' <- _prim_int_add n5' n6' 38 | p14 <- store (CInt n7') 39 | sum p14 p13 40 | 41 | eval e_p1 = 42 | e_v1 <- fetch e_p1 43 | case e_v1 of 44 | #default -> 45 | pure e_v1 46 | (Fupto e_p2 e_p3) -> 47 | e_v2 <- upto e_p2 e_p3 48 | update e_p1 e_v2 49 | pure e_v2 50 | (Fsum e_p4 e_p5) -> 51 | e_v3 <- sum e_p4 e_p5 52 | update e_p1 e_v3 53 | pure e_v3 54 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-02.grin: -------------------------------------------------------------------------------- 1 | -- page 305 2 | {- 3 | after: 4 | - evaluated case elimination 5 | - trivial case elimination 6 | -} 7 | 8 | grinMain = 9 | p1 <- store (CInt 0) 10 | p2 <- store (CInt 1) 11 | p3 <- store (CInt 1000) 12 | p4 <- store (Fupto p2 p3) 13 | p5 <- store (Fsum p1 p4) 14 | v2 <- fetch p5 15 | (Fsum p15 p16) <- pure v2 16 | v3 <- sum p15 p16 17 | (CInt n1') <- pure v3 18 | _prim_int_print n1' 19 | 20 | upto p6 p7 = 21 | v4 <- fetch p6 22 | v5 <- pure v4 23 | (CInt n2') <- pure v5 24 | v6 <- fetch p7 25 | v7 <- pure v6 26 | (CInt n3') <- pure v7 27 | b1' <- _prim_int_gt n2' n3' 28 | case b1' of 29 | #True -> 30 | pure (CNil) 31 | #False -> 32 | n4' <- _prim_int_add n2' 1 33 | p8 <- store (CInt n4') 34 | p9 <- store (Fupto p8 p7) 35 | pure (CCons p6 p9) 36 | 37 | sum p10 p11 = 38 | v8 <- fetch p11 39 | (Fupto p17 p18) <- pure v8 40 | v9 <- upto p17 p18 41 | v10 <- pure v9 42 | case v10 of 43 | (CNil) -> 44 | v11 <- fetch p10 45 | v12 <- pure v11 46 | pure v12 47 | (CCons p12 p13) -> 48 | v13 <- fetch p10 49 | v15 <- pure v13 50 | (CInt n5') <- pure v15 51 | v16 <- fetch p12 52 | v17 <- pure v16 53 | (CInt n6') <- pure v17 54 | n7' <- _prim_int_add n5' n6' 55 | p14 <- store (CInt n7') 56 | sum p14 p13 57 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-03.grin: -------------------------------------------------------------------------------- 1 | -- page 306 2 | {- 3 | after: 4 | - unboxing return values 5 | - copy propagation 6 | -} 7 | 8 | grinMain = 9 | p1 <- store (CInt 0) 10 | p2 <- store (CInt 1) 11 | p3 <- store (CInt 1000) 12 | p4 <- store (Fupto p2 p3) 13 | p5 <- store (Fsum p1 p4) 14 | (Fsum p15 p16) <- fetch p5 15 | n13' <- sum p15 p16 16 | _prim_int_print n13' 17 | 18 | upto p6 p7 = 19 | (CInt n2') <- fetch p6 20 | (CInt n3') <- fetch p7 21 | b1' <- _prim_int_gt n2' n3' 22 | case b1' of 23 | #True -> 24 | pure (CNil) 25 | #False -> 26 | n4' <- _prim_int_add n2' 1 27 | p8 <- store (CInt n4') 28 | p9 <- store (Fupto p8 p7) 29 | pure (CCons p6 p9) 30 | 31 | sum p10 p11 = 32 | (Fupto p17 p18) <- fetch p11 33 | v10 <- upto p17 p18 34 | case v10 of 35 | (CNil) -> 36 | (CInt n14') <- fetch p10 37 | pure n14' 38 | (CCons p12 p13) -> 39 | (CInt n5') <- fetch p10 40 | (CInt n6') <- fetch p12 41 | n7' <- _prim_int_add n5' n6' 42 | p14 <- store (CInt n7') 43 | sum p14 p13 44 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-04.grin: -------------------------------------------------------------------------------- 1 | -- page 307 2 | {- 3 | after: 4 | - vectorisation 5 | - case simplification 6 | -} 7 | 8 | -- not changed 9 | grinMain = 10 | p1 <- store (CInt 0) 11 | p2 <- store (CInt 1) 12 | p3 <- store (CInt 1000) 13 | p4 <- store (Fupto p2 p3) 14 | p5 <- store (Fsum p1 p4) 15 | (Fsum p15 p16) <- fetch p5 16 | n13' <- sum p15 p16 17 | _prim_int_print n13' 18 | 19 | -- not changed 20 | upto p6 p7 = 21 | (CInt n2') <- fetch p6 22 | (CInt n3') <- fetch p7 23 | b1' <- _prim_int_gt n2' n3' 24 | case b1' of 25 | #True -> 26 | pure (CNil) 27 | #False -> 28 | n4' <- _prim_int_add n2' 1 29 | p8 <- store (CInt n4') 30 | p9 <- store (Fupto p8 p7) 31 | pure (CCons p6 p9) 32 | 33 | -- changed 34 | sum p10 p11 = 35 | (Fupto p17 p18) <- fetch p11 36 | (n15' p19 p20) <- upto p17 p18 37 | case n15' of 38 | (CNil) -> 39 | (CInt n14') <- fetch p10 40 | pure n14' 41 | (CCons) -> 42 | (CInt n5') <- fetch p10 43 | (CInt n6') <- fetch p19 44 | n7' <- _prim_int_add n5' n6' 45 | p14 <- store (CInt n7') 46 | sum p14 p20 47 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-05.grin: -------------------------------------------------------------------------------- 1 | -- page 309 2 | {- 3 | after: 4 | - late inlining (upto) 5 | - bind normalisation 6 | -} 7 | 8 | -- no change 9 | grinMain = 10 | p1 <- store (CInt 0) 11 | p2 <- store (CInt 1) 12 | p3 <- store (CInt 1000) 13 | p4 <- store (Fupto p2 p3) 14 | p5 <- store (Fsum p1 p4) 15 | (Fsum p15 p16) <- fetch p5 16 | n13' <- sum p15 p16 17 | _prim_int_print n13' 18 | 19 | -- no change 20 | upto p6 p7 = 21 | (CInt n2') <- fetch p6 22 | (CInt n3') <- fetch p7 23 | b1' <- _prim_int_gt n2' n3' 24 | case b1' of 25 | #True -> 26 | pure (CNil) 27 | #False -> 28 | n4' <- _prim_int_add n2' 1 29 | p8 <- store (CInt n4') 30 | p9 <- store (Fupto p8 p7) 31 | pure (CCons p6 p9) 32 | 33 | -- change 34 | sum p10 p11 = 35 | (Fupto p17 p18) <- fetch p11 36 | (CInt n16') <- fetch p17 37 | (CInt n17') <- fetch p18 38 | b2' <- _prim_int_gt n16' n17' 39 | (n15' p19 p20) <- do 40 | case b2' of 41 | #True -> 42 | pure (CNil) 43 | #False -> 44 | n18' <- _prim_int_add n16' 1 45 | p21 <- store (CInt n18') 46 | p22 <- store (Fupto p21 p18) 47 | pure (CCons p17 p22) 48 | case n15' of 49 | (CNil) -> 50 | (CInt n14') <- fetch p10 51 | pure n14' 52 | (CCons) -> 53 | (CInt n5') <- fetch p10 54 | (CInt n6') <- fetch p19 55 | n7' <- _prim_int_add n5' n6' 56 | p14 <- store (CInt n7') 57 | sum p14 p20 58 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-06.grin: -------------------------------------------------------------------------------- 1 | -- page 310 2 | {- 3 | after: 4 | - case hoising 5 | - dead code elimination (upto) 6 | -} 7 | 8 | grinMain = 9 | p1 <- store (CInt 0) 10 | p2 <- store (CInt 1) 11 | p3 <- store (CInt 1000) 12 | p4 <- store (Fupto p2 p3) 13 | p5 <- store (Fsum p1 p4) 14 | (Fsum p15 p16) <- fetch p5 15 | n13' <- sum p15 p16 16 | _prim_int_print n13' 17 | 18 | sum p10 p11 = 19 | (Fupto p17 p18) <- fetch p11 20 | (CInt n16') <- fetch p17 21 | (CInt n17') <- fetch p18 22 | b2' <- _prim_int_gt n16' n17' 23 | case b2' of 24 | #True -> 25 | (n19' p23 p24) <- pure (CNil) 26 | case n19' of 27 | (CNil) -> 28 | (CInt n20') <- fetch p10 29 | pure n20' 30 | (CCons) -> 31 | (CInt n21') <- fetch p10 32 | (CInt n22') <- fetch p23 33 | n23' <- _prim_int_add n21' n22' 34 | p25 <- store (CInt n23') 35 | sum p25 p24 36 | #False -> 37 | n18' <- _prim_int_add n16' 1 38 | p21 <- store (CInt n18') 39 | p22 <- store (Fupto p21 p18) 40 | (n24' p26 p27) <- pure (CCons p17 p22) 41 | case n24' of 42 | (CNil) -> 43 | (CInt n25') <- fetch p10 44 | pure n25' 45 | (CCons) -> 46 | (CInt n26') <- fetch p10 47 | (CInt n27') <- fetch p26 48 | n28' <- _prim_int_add n26' n27' 49 | p28 <- store (CInt n28') 50 | sum p28 p27 51 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-07.grin: -------------------------------------------------------------------------------- 1 | -- page 311 2 | {- 3 | after: 4 | - constant propagation 5 | - copy propagation 6 | -} 7 | 8 | grinMain = 9 | p1 <- store (CInt 0) 10 | p2 <- store (CInt 1) 11 | p3 <- store (CInt 1000) 12 | p4 <- store (Fupto p2 p3) 13 | p5 <- store (Fsum p1 p4) 14 | (Fsum p15 p16) <- fetch p5 15 | n13' <- sum p15 p16 16 | _prim_int_print n13' 17 | 18 | sum p10 p11 = 19 | (Fupto p17 p18) <- fetch p11 20 | (CInt n16') <- fetch p17 21 | (CInt n17') <- fetch p18 22 | b2' <- _prim_int_gt n16' n17' 23 | case b2' of 24 | #True -> 25 | p24 <- pure () 26 | p23 <- pure () 27 | (CInt n20') <- fetch p10 28 | pure n20' 29 | #False -> 30 | n18' <- _prim_int_add n16' 1 31 | p21 <- store (CInt n18') 32 | p22 <- store (Fupto p21 p18) 33 | (CInt n26') <- fetch p10 34 | (CInt n27') <- fetch p17 35 | n28' <- _prim_int_add n26' n27' 36 | p28 <- store (CInt n28') 37 | sum p28 p22 38 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-08.grin: -------------------------------------------------------------------------------- 1 | -- page 312 ; top 2 | {- 3 | after: 4 | - common sub-expression elimination 5 | - dead code elimination (variable) 6 | - copy propagation 7 | - dead code elimination (variable) 8 | -} 9 | 10 | grinMain = 11 | p1 <- store (CInt 0) 12 | p2 <- store (CInt 1) 13 | p3 <- store (CInt 1000) 14 | p4 <- store (Fupto p2 p3) 15 | n13' <- sum p1 p4 16 | _prim_int_print n13' 17 | 18 | sum p10 p11 = 19 | (Fupto p17 p18) <- fetch p11 20 | (CInt n16') <- fetch p17 21 | (CInt n17') <- fetch p18 22 | b2' <- _prim_int_gt n16' n17' 23 | case b2' of 24 | #True -> 25 | (CInt n20') <- fetch p10 26 | pure n20' 27 | #False -> 28 | n18' <- _prim_int_add n16' 1 29 | p21 <- store (CInt n18') 30 | p22 <- store (Fupto p21 p18) 31 | (CInt n26') <- fetch p10 32 | n28' <- _prim_int_add n26' n16' 33 | p28 <- store (CInt n28') 34 | sum p28 p22 35 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-09.grin: -------------------------------------------------------------------------------- 1 | -- page 312 ; bottom 2 | {- 3 | after: 4 | - arity raising 5 | -} 6 | 7 | grinMain = 8 | p1 <- store (CInt 0) 9 | p2 <- store (CInt 1) 10 | p3 <- store (CInt 1000) 11 | p4 <- store (Fupto p2 p3) 12 | n13' <- sum 0 p2 p3 13 | _prim_int_print n13' 14 | 15 | sum n29' p29 p30 = 16 | (Fupto p17 p18) <- pure (Fupto p29 p30) 17 | (CInt n16') <- fetch p17 18 | (CInt n17') <- fetch p18 19 | b2' <- _prim_int_gt n16' n17' 20 | case b2' of 21 | #True -> 22 | (CInt n20') <- pure (CInt n29') 23 | pure n20' 24 | #False -> 25 | n18' <- _prim_int_add n16' 1 26 | p21 <- store (CInt n18') 27 | p22 <- store (Fupto p21 p18) 28 | (CInt n26') <- pure (CInt n29') 29 | n28' <- _prim_int_add n26' n16' 30 | p28 <- store (CInt n28') 31 | sum n28' p21 p18 32 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-10.grin: -------------------------------------------------------------------------------- 1 | -- page 313 2 | {- 3 | after: 4 | - dead code elimination (variable) 5 | - copy propagation 6 | -} 7 | 8 | grinMain = 9 | p2 <- store (CInt 1) 10 | p3 <- store (CInt 1000) 11 | n13' <- sum 0 p2 p3 12 | _prim_int_print n13' 13 | 14 | sum n29' p29 p30 = 15 | (CInt n16') <- fetch p29 16 | (CInt n17') <- fetch p30 17 | b2' <- _prim_int_gt n16' n17' 18 | case b2' of 19 | #True -> 20 | pure n29' 21 | #False -> 22 | n18' <- _prim_int_add n16' 1 23 | p21 <- store (CInt n18') 24 | n28' <- _prim_int_add n29' n16' 25 | sum n28' p21 p30 26 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-11.grin: -------------------------------------------------------------------------------- 1 | -- page 314 ; top 2 | {- 3 | after: 4 | - arity raising 5 | -} 6 | 7 | grinMain = 8 | p2 <- store (CInt 1) 9 | p3 <- store (CInt 1000) 10 | n13' <- sum 0 1 1000 11 | _prim_int_print n13' 12 | 13 | sum n29' n30' n31' = 14 | (CInt n16') <- pure (CInt n30') 15 | (CInt n17') <- pure (CInt n31') 16 | b2' <- _prim_int_gt n16' n17' 17 | case b2' of 18 | #True -> 19 | pure n29' 20 | #False -> 21 | n18' <- _prim_int_add n16' 1 22 | p21 <- store (CInt n18') 23 | n28' <- _prim_int_add n29' n16' 24 | sum n28' n18' n31' 25 | -------------------------------------------------------------------------------- /grin/grin/opt-stages/stage-12.grin: -------------------------------------------------------------------------------- 1 | -- page 314 ; bottom 2 | {- 3 | after: 4 | - copy propagation 5 | - dead code elimination (variable) 6 | -} 7 | 8 | grinMain = 9 | n13' <- sum 0 1 1000 10 | _prim_int_print n13' 11 | 12 | sum n29' n30' n31' = 13 | b2' <- _prim_int_gt n30' n31' 14 | case b2' of 15 | #True -> 16 | pure n29' 17 | #False -> 18 | n18' <- _prim_int_add n30' 1 19 | n28' <- _prim_int_add n29' n30' 20 | sum n28' n18' n31' 21 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/001.T-SparseCaseOptimisation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | (CInt r') <- eval t4 7 | _prim_int_print r' 8 | 9 | upto m n = 10 | (CInt m') <- eval m 11 | (CInt n') <- eval n 12 | b' <- _prim_int_gt m' n' 13 | case b' of 14 | #True -> 15 | pure (CNil) 16 | #False -> 17 | m1' <- _prim_int_add m' 1 18 | m1 <- store (CInt m1') 19 | p <- store (Fupto m1 n) 20 | pure (CCons m p) 21 | 22 | sum l = 23 | l2 <- eval l 24 | case l2 of 25 | (CNil) -> 26 | pure (CInt 0) 27 | (CCons x xs) -> 28 | (CInt x') <- eval x 29 | (CInt s') <- sum xs 30 | ax' <- _prim_int_add x' s' 31 | pure (CInt ax') 32 | 33 | eval q = 34 | v <- fetch q 35 | case v of 36 | (CInt x'1) -> 37 | pure v 38 | (Fupto a b) -> 39 | w <- upto a b 40 | pure w 41 | (Fsum c) -> 42 | z <- sum c 43 | pure z 44 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/002.T-CopyPropagation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | (CInt r') <- eval t4 7 | _prim_int_print r' 8 | 9 | upto m n = 10 | (CInt m') <- eval m 11 | (CInt n') <- eval n 12 | b' <- _prim_int_gt m' n' 13 | case b' of 14 | #True -> 15 | pure (CNil) 16 | #False -> 17 | m1' <- _prim_int_add m' 1 18 | m1 <- store (CInt m1') 19 | p <- store (Fupto m1 n) 20 | pure (CCons m p) 21 | 22 | sum l = 23 | l2 <- eval l 24 | case l2 of 25 | (CNil) -> 26 | pure (CInt 0) 27 | (CCons x xs) -> 28 | (CInt x') <- eval x 29 | (CInt s') <- sum xs 30 | ax' <- _prim_int_add x' s' 31 | pure (CInt ax') 32 | 33 | eval q = 34 | v <- fetch q 35 | case v of 36 | (CInt x'1) -> 37 | pure v 38 | (Fupto a b) -> 39 | upto a b 40 | (Fsum c) -> 41 | sum c 42 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/003.T-CaseCopyPropagation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | (CInt r') <- eval t4 7 | _prim_int_print r' 8 | 9 | upto m n = 10 | (CInt m') <- eval m 11 | (CInt n') <- eval n 12 | b' <- _prim_int_gt m' n' 13 | case b' of 14 | #True -> 15 | pure (CNil) 16 | #False -> 17 | m1' <- _prim_int_add m' 1 18 | m1 <- store (CInt m1') 19 | p <- store (Fupto m1 n) 20 | pure (CCons m p) 21 | 22 | sum l = 23 | l2 <- eval l 24 | do 25 | ccp.0 <- case l2 of 26 | (CNil) -> 27 | pure 0 28 | (CCons x xs) -> 29 | (CInt x') <- eval x 30 | (CInt s') <- sum xs 31 | ax' <- _prim_int_add x' s' 32 | pure ax' 33 | pure (CInt ccp.0) 34 | 35 | eval q = 36 | v <- fetch q 37 | case v of 38 | (CInt x'1) -> 39 | pure v 40 | (Fupto a b) -> 41 | upto a b 42 | (Fsum c) -> 43 | sum c 44 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/004.T-ArityRaising: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | (CInt r') <- eval t4 7 | _prim_int_print r' 8 | 9 | upto m n = 10 | (CInt m') <- eval m 11 | (CInt n') <- eval n 12 | b' <- _prim_int_gt m' n' 13 | case b' of 14 | #True -> 15 | pure (CNil) 16 | #False -> 17 | m1' <- _prim_int_add m' 1 18 | m1 <- store (CInt m1') 19 | p <- store (Fupto m1 n) 20 | pure (CCons m p) 21 | 22 | sum l = 23 | l2 <- eval l 24 | ccp.0 <- case l2 of 25 | (CNil) -> 26 | pure 0 27 | (CCons x xs) -> 28 | (CInt x') <- eval x 29 | (CInt s') <- sum xs 30 | ax' <- _prim_int_add x' s' 31 | pure ax' 32 | pure (CInt ccp.0) 33 | 34 | eval q = 35 | v <- fetch q 36 | case v of 37 | (CInt x'1) -> 38 | pure v 39 | (Fupto a b) -> 40 | upto a b 41 | (Fsum c) -> 42 | sum c 43 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/006.T-BindNormalisation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | q.0 <- pure t4 7 | v.0 <- fetch q.0 8 | (CInt r') <- case v.0 of 9 | (CInt x'1.0) -> 10 | pure v.0 11 | (Fupto a.0 b.0) -> 12 | upto a.0 b.0 13 | (Fsum c.0) -> 14 | sum c.0 15 | _prim_int_print r' 16 | 17 | upto m n = 18 | q.1 <- pure m 19 | v.1 <- fetch q.1 20 | (CInt m') <- case v.1 of 21 | (CInt x'1.1) -> 22 | pure v.1 23 | (Fupto a.1 b.1) -> 24 | upto a.1 b.1 25 | (Fsum c.1) -> 26 | sum c.1 27 | q.2 <- pure n 28 | v.2 <- fetch q.2 29 | (CInt n') <- case v.2 of 30 | (CInt x'1.2) -> 31 | pure v.2 32 | (Fupto a.2 b.2) -> 33 | upto a.2 b.2 34 | (Fsum c.2) -> 35 | sum c.2 36 | b' <- _prim_int_gt m' n' 37 | case b' of 38 | #True -> 39 | pure (CNil) 40 | #False -> 41 | m1' <- _prim_int_add m' 1 42 | m1 <- store (CInt m1') 43 | p <- store (Fupto m1 n) 44 | pure (CCons m p) 45 | 46 | sum l = 47 | q.3 <- pure l 48 | v.3 <- fetch q.3 49 | l2 <- case v.3 of 50 | (CInt x'1.3) -> 51 | pure v.3 52 | (Fupto a.3 b.3) -> 53 | upto a.3 b.3 54 | (Fsum c.3) -> 55 | sum c.3 56 | ccp.0 <- case l2 of 57 | (CNil) -> 58 | pure 0 59 | (CCons x xs) -> 60 | q.4 <- pure x 61 | v.4 <- fetch q.4 62 | (CInt x') <- case v.4 of 63 | (CInt x'1.4) -> 64 | pure v.4 65 | (Fupto a.4 b.4) -> 66 | upto a.4 b.4 67 | (Fsum c.4) -> 68 | sum c.4 69 | (CInt s') <- sum xs 70 | ax' <- _prim_int_add x' s' 71 | pure ax' 72 | pure (CInt ccp.0) 73 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/007.T-SparseCaseOptimisation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | q.0 <- pure t4 7 | v.0 <- fetch q.0 8 | (CInt r') <- case v.0 of 9 | (Fsum c.0) -> 10 | sum c.0 11 | _prim_int_print r' 12 | 13 | upto m n = 14 | q.1 <- pure m 15 | v.1 <- fetch q.1 16 | (CInt m') <- case v.1 of 17 | (CInt x'1.1) -> 18 | pure v.1 19 | q.2 <- pure n 20 | v.2 <- fetch q.2 21 | (CInt n') <- case v.2 of 22 | (CInt x'1.2) -> 23 | pure v.2 24 | b' <- _prim_int_gt m' n' 25 | case b' of 26 | #True -> 27 | pure (CNil) 28 | #False -> 29 | m1' <- _prim_int_add m' 1 30 | m1 <- store (CInt m1') 31 | p <- store (Fupto m1 n) 32 | pure (CCons m p) 33 | 34 | sum l = 35 | q.3 <- pure l 36 | v.3 <- fetch q.3 37 | l2 <- case v.3 of 38 | (Fupto a.3 b.3) -> 39 | upto a.3 b.3 40 | ccp.0 <- case l2 of 41 | (CNil) -> 42 | pure 0 43 | (CCons x xs) -> 44 | q.4 <- pure x 45 | v.4 <- fetch q.4 46 | (CInt x') <- case v.4 of 47 | (CInt x'1.4) -> 48 | pure v.4 49 | (CInt s') <- sum xs 50 | ax' <- _prim_int_add x' s' 51 | pure ax' 52 | pure (CInt ccp.0) 53 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/008.T-CopyPropagation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | q.0 <- pure t4 7 | v.0 <- fetch t4 8 | (CInt r') <- case v.0 of 9 | (Fsum c.0) -> 10 | sum c.0 11 | _prim_int_print r' 12 | 13 | upto m n = 14 | q.1 <- pure m 15 | v.1 <- fetch m 16 | (CInt m') <- case v.1 of 17 | (CInt x'1.1) -> 18 | pure v.1 19 | q.2 <- pure n 20 | v.2 <- fetch n 21 | (CInt n') <- case v.2 of 22 | (CInt x'1.2) -> 23 | pure v.2 24 | b' <- _prim_int_gt m' n' 25 | case b' of 26 | #True -> 27 | pure (CNil) 28 | #False -> 29 | m1' <- _prim_int_add m' 1 30 | m1 <- store (CInt m1') 31 | p <- store (Fupto m1 n) 32 | pure (CCons m p) 33 | 34 | sum l = 35 | q.3 <- pure l 36 | v.3 <- fetch l 37 | l2 <- case v.3 of 38 | (Fupto a.3 b.3) -> 39 | upto a.3 b.3 40 | ccp.0 <- case l2 of 41 | (CNil) -> 42 | pure 0 43 | (CCons x xs) -> 44 | q.4 <- pure x 45 | v.4 <- fetch x 46 | (CInt x') <- case v.4 of 47 | (CInt x'1.4) -> 48 | pure v.4 49 | (CInt s') <- sum xs 50 | _prim_int_add x' s' 51 | pure (CInt ccp.0) 52 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/009.T-DeadVariableElimination: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | v.0 <- fetch t4 7 | (CInt r') <- case v.0 of 8 | (Fsum c.0) -> 9 | sum c.0 10 | _prim_int_print r' 11 | 12 | upto m n = 13 | v.1 <- fetch m 14 | (CInt m') <- case v.1 of 15 | (CInt x'1.1) -> 16 | pure v.1 17 | v.2 <- fetch n 18 | (CInt n') <- case v.2 of 19 | (CInt x'1.2) -> 20 | pure v.2 21 | b' <- _prim_int_gt m' n' 22 | case b' of 23 | #True -> 24 | pure (CNil) 25 | #False -> 26 | m1' <- _prim_int_add m' 1 27 | m1 <- store (CInt m1') 28 | p <- store (Fupto m1 n) 29 | pure (CCons m p) 30 | 31 | sum l = 32 | v.3 <- fetch l 33 | l2 <- case v.3 of 34 | (Fupto a.3 b.3) -> 35 | upto a.3 b.3 36 | ccp.0 <- case l2 of 37 | (CNil) -> 38 | pure 0 39 | (CCons x xs) -> 40 | v.4 <- fetch x 41 | (CInt x') <- case v.4 of 42 | (CInt x'1.4) -> 43 | pure v.4 44 | (CInt s') <- sum xs 45 | _prim_int_add x' s' 46 | pure (CInt ccp.0) 47 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/010.T-CommonSubExpressionElimination: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | v.0 <- pure (Fsum t3) 7 | (CInt r') <- case v.0 of 8 | (Fsum c.0) -> 9 | sum c.0 10 | _prim_int_print r' 11 | 12 | upto m n = 13 | v.1 <- fetch m 14 | (CInt m') <- case v.1 of 15 | (CInt x'1.1) -> 16 | pure v.1 17 | v.2 <- fetch n 18 | (CInt n') <- case v.2 of 19 | (CInt x'1.2) -> 20 | pure v.2 21 | b' <- _prim_int_gt m' n' 22 | case b' of 23 | #True -> 24 | pure (CNil) 25 | #False -> 26 | m1' <- _prim_int_add m' 1 27 | m1 <- store (CInt m1') 28 | p <- store (Fupto m1 n) 29 | pure (CCons m p) 30 | 31 | sum l = 32 | v.3 <- fetch l 33 | l2 <- case v.3 of 34 | (Fupto a.3 b.3) -> 35 | upto a.3 b.3 36 | ccp.0 <- case l2 of 37 | (CNil) -> 38 | pure 0 39 | (CCons x xs) -> 40 | v.4 <- fetch x 41 | (CInt x') <- case v.4 of 42 | (CInt x'1.4) -> 43 | pure v.4 44 | (CInt s') <- sum xs 45 | _prim_int_add x' s' 46 | pure (CInt ccp.0) 47 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/011.T-GeneralizedUnboxing: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | v.0 <- pure (Fsum t3) 7 | (CInt r') <- case v.0 of 8 | (Fsum c.0) -> 9 | do 10 | unboxed.CInt.0 <- sum.unboxed c.0 11 | pure (CInt unboxed.CInt.0) 12 | _prim_int_print r' 13 | 14 | upto m n = 15 | v.1 <- fetch m 16 | (CInt m') <- case v.1 of 17 | (CInt x'1.1) -> 18 | pure v.1 19 | v.2 <- fetch n 20 | (CInt n') <- case v.2 of 21 | (CInt x'1.2) -> 22 | pure v.2 23 | b' <- _prim_int_gt m' n' 24 | case b' of 25 | #True -> 26 | pure (CNil) 27 | #False -> 28 | m1' <- _prim_int_add m' 1 29 | m1 <- store (CInt m1') 30 | p <- store (Fupto m1 n) 31 | pure (CCons m p) 32 | 33 | sum.unboxed l = 34 | v.3 <- fetch l 35 | l2 <- case v.3 of 36 | (Fupto a.3 b.3) -> 37 | upto a.3 b.3 38 | ccp.0 <- case l2 of 39 | (CNil) -> 40 | pure 0 41 | (CCons x xs) -> 42 | v.4 <- fetch x 43 | (CInt x') <- case v.4 of 44 | (CInt x'1.4) -> 45 | pure v.4 46 | (CInt s') <- do 47 | unboxed.CInt.1 <- sum.unboxed xs 48 | pure (CInt unboxed.CInt.1) 49 | _prim_int_add x' s' 50 | pure ccp.0 51 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/012.T-ArityRaising: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | v.0 <- pure (Fsum t3) 7 | (CInt r') <- case v.0 of 8 | (Fsum c.0) -> 9 | unboxed.CInt.0 <- sum.unboxed c.0 10 | pure (CInt unboxed.CInt.0) 11 | _prim_int_print r' 12 | 13 | upto m n = 14 | v.1 <- fetch m 15 | (CInt m') <- case v.1 of 16 | (CInt x'1.1) -> 17 | pure v.1 18 | v.2 <- fetch n 19 | (CInt n') <- case v.2 of 20 | (CInt x'1.2) -> 21 | pure v.2 22 | b' <- _prim_int_gt m' n' 23 | case b' of 24 | #True -> 25 | pure (CNil) 26 | #False -> 27 | m1' <- _prim_int_add m' 1 28 | m1 <- store (CInt m1') 29 | p <- store (Fupto m1 n) 30 | pure (CCons m p) 31 | 32 | sum.unboxed l = 33 | v.3 <- fetch l 34 | l2 <- case v.3 of 35 | (Fupto a.3 b.3) -> 36 | upto a.3 b.3 37 | ccp.0 <- case l2 of 38 | (CNil) -> 39 | pure 0 40 | (CCons x xs) -> 41 | v.4 <- fetch x 42 | (CInt x') <- case v.4 of 43 | (CInt x'1.4) -> 44 | pure v.4 45 | unboxed.CInt.1 <- sum.unboxed xs 46 | (CInt s') <- pure (CInt unboxed.CInt.1) 47 | _prim_int_add x' s' 48 | pure ccp.0 49 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/013.T-LateInlining: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | v.0 <- pure (Fsum t3) 7 | (CInt r') <- case v.0 of 8 | (Fsum c.0) -> 9 | unboxed.CInt.0 <- sum.unboxed c.0 10 | pure (CInt unboxed.CInt.0) 11 | _prim_int_print r' 12 | 13 | sum.unboxed l = 14 | v.3 <- fetch l 15 | l2 <- case v.3 of 16 | (Fupto a.3 b.3) -> 17 | do 18 | m.0 <- pure a.3 19 | n.0 <- pure b.3 20 | v.1.0 <- fetch m.0 21 | (CInt m'.0) <- case v.1.0 of 22 | (CInt x'1.1.0) -> 23 | pure v.1.0 24 | v.2.0 <- fetch n.0 25 | (CInt n'.0) <- case v.2.0 of 26 | (CInt x'1.2.0) -> 27 | pure v.2.0 28 | b'.0 <- _prim_int_gt m'.0 n'.0 29 | case b'.0 of 30 | #True -> 31 | pure (CNil) 32 | #False -> 33 | m1'.0 <- _prim_int_add m'.0 1 34 | m1.0 <- store (CInt m1'.0) 35 | p.0 <- store (Fupto m1.0 n.0) 36 | pure (CCons m.0 p.0) 37 | ccp.0 <- case l2 of 38 | (CNil) -> 39 | pure 0 40 | (CCons x xs) -> 41 | v.4 <- fetch x 42 | (CInt x') <- case v.4 of 43 | (CInt x'1.4) -> 44 | pure v.4 45 | unboxed.CInt.1 <- sum.unboxed xs 46 | (CInt s') <- pure (CInt unboxed.CInt.1) 47 | _prim_int_add x' s' 48 | pure ccp.0 49 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/014.T-BindNormalisation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | v.0 <- pure (Fsum t3) 7 | (CInt r') <- case v.0 of 8 | (Fsum c.0) -> 9 | unboxed.CInt.0 <- sum.unboxed c.0 10 | pure (CInt unboxed.CInt.0) 11 | _prim_int_print r' 12 | 13 | sum.unboxed l = 14 | v.3 <- fetch l 15 | l2 <- case v.3 of 16 | (Fupto a.3 b.3) -> 17 | m.0 <- pure a.3 18 | n.0 <- pure b.3 19 | v.1.0 <- fetch m.0 20 | (CInt m'.0) <- case v.1.0 of 21 | (CInt x'1.1.0) -> 22 | pure v.1.0 23 | v.2.0 <- fetch n.0 24 | (CInt n'.0) <- case v.2.0 of 25 | (CInt x'1.2.0) -> 26 | pure v.2.0 27 | b'.0 <- _prim_int_gt m'.0 n'.0 28 | case b'.0 of 29 | #True -> 30 | pure (CNil) 31 | #False -> 32 | m1'.0 <- _prim_int_add m'.0 1 33 | m1.0 <- store (CInt m1'.0) 34 | p.0 <- store (Fupto m1.0 n.0) 35 | pure (CCons m.0 p.0) 36 | ccp.0 <- case l2 of 37 | (CNil) -> 38 | pure 0 39 | (CCons x xs) -> 40 | v.4 <- fetch x 41 | (CInt x') <- case v.4 of 42 | (CInt x'1.4) -> 43 | pure v.4 44 | unboxed.CInt.1 <- sum.unboxed xs 45 | (CInt s') <- pure (CInt unboxed.CInt.1) 46 | _prim_int_add x' s' 47 | pure ccp.0 48 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/015.T-EvaluatedCaseElimination: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | v.0 <- pure (Fsum t3) 7 | (CInt r') <- case v.0 of 8 | (Fsum c.0) -> 9 | unboxed.CInt.0 <- sum.unboxed c.0 10 | pure (CInt unboxed.CInt.0) 11 | _prim_int_print r' 12 | 13 | sum.unboxed l = 14 | v.3 <- fetch l 15 | l2 <- case v.3 of 16 | (Fupto a.3 b.3) -> 17 | m.0 <- pure a.3 18 | n.0 <- pure b.3 19 | v.1.0 <- fetch m.0 20 | (CInt m'.0) <- pure v.1.0 21 | v.2.0 <- fetch n.0 22 | (CInt n'.0) <- pure v.2.0 23 | b'.0 <- _prim_int_gt m'.0 n'.0 24 | case b'.0 of 25 | #True -> 26 | pure (CNil) 27 | #False -> 28 | m1'.0 <- _prim_int_add m'.0 1 29 | m1.0 <- store (CInt m1'.0) 30 | p.0 <- store (Fupto m1.0 n.0) 31 | pure (CCons m.0 p.0) 32 | ccp.0 <- case l2 of 33 | (CNil) -> 34 | pure 0 35 | (CCons x xs) -> 36 | v.4 <- fetch x 37 | (CInt x') <- pure v.4 38 | unboxed.CInt.1 <- sum.unboxed xs 39 | (CInt s') <- pure (CInt unboxed.CInt.1) 40 | _prim_int_add x' s' 41 | pure ccp.0 42 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/016.T-TrivialCaseElimination: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | v.0 <- pure (Fsum t3) 7 | (CInt r') <- do 8 | (Fsum c.0) <- pure v.0 9 | unboxed.CInt.0 <- sum.unboxed c.0 10 | pure (CInt unboxed.CInt.0) 11 | _prim_int_print r' 12 | 13 | sum.unboxed l = 14 | v.3 <- fetch l 15 | l2 <- do 16 | (Fupto a.3 b.3) <- pure v.3 17 | m.0 <- pure a.3 18 | n.0 <- pure b.3 19 | v.1.0 <- fetch m.0 20 | (CInt m'.0) <- pure v.1.0 21 | v.2.0 <- fetch n.0 22 | (CInt n'.0) <- pure v.2.0 23 | b'.0 <- _prim_int_gt m'.0 n'.0 24 | case b'.0 of 25 | #True -> 26 | pure (CNil) 27 | #False -> 28 | m1'.0 <- _prim_int_add m'.0 1 29 | m1.0 <- store (CInt m1'.0) 30 | p.0 <- store (Fupto m1.0 n.0) 31 | pure (CCons m.0 p.0) 32 | ccp.0 <- case l2 of 33 | (CNil) -> 34 | pure 0 35 | (CCons x xs) -> 36 | v.4 <- fetch x 37 | (CInt x') <- pure v.4 38 | unboxed.CInt.1 <- sum.unboxed xs 39 | (CInt s') <- pure (CInt unboxed.CInt.1) 40 | _prim_int_add x' s' 41 | pure ccp.0 42 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/017.T-CopyPropagation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | t4 <- store (Fsum t3) 6 | v.0 <- pure (Fsum t3) 7 | (CInt r') <- do 8 | c.0 <- pure t3 9 | unboxed.CInt.0 <- sum.unboxed t3 10 | pure (CInt unboxed.CInt.0) 11 | _prim_int_print r' 12 | 13 | sum.unboxed l = 14 | v.3 <- fetch l 15 | l2 <- do 16 | (Fupto a.3 b.3) <- pure v.3 17 | m.0 <- pure a.3 18 | n.0 <- pure b.3 19 | v.1.0 <- fetch a.3 20 | (CInt m'.0) <- pure v.1.0 21 | v.2.0 <- fetch b.3 22 | (CInt n'.0) <- pure v.2.0 23 | b'.0 <- _prim_int_gt m'.0 n'.0 24 | case b'.0 of 25 | #True -> 26 | pure (CNil) 27 | #False -> 28 | m1'.0 <- _prim_int_add m'.0 1 29 | m1.0 <- store (CInt m1'.0) 30 | p.0 <- store (Fupto m1.0 b.3) 31 | pure (CCons a.3 p.0) 32 | case l2 of 33 | (CNil) -> 34 | pure 0 35 | (CCons x xs) -> 36 | v.4 <- fetch x 37 | (CInt x') <- pure v.4 38 | unboxed.CInt.1 <- sum.unboxed xs 39 | s' <- pure unboxed.CInt.1 40 | _prim_int_add x' unboxed.CInt.1 41 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/018.T-DeadVariableElimination: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | (CInt r') <- do 6 | unboxed.CInt.0 <- sum.unboxed t3 7 | pure (CInt unboxed.CInt.0) 8 | _prim_int_print r' 9 | 10 | sum.unboxed l = 11 | v.3 <- fetch l 12 | l2 <- do 13 | (Fupto a.3 b.3) <- pure v.3 14 | v.1.0 <- fetch a.3 15 | (CInt m'.0) <- pure v.1.0 16 | v.2.0 <- fetch b.3 17 | (CInt n'.0) <- pure v.2.0 18 | b'.0 <- _prim_int_gt m'.0 n'.0 19 | case b'.0 of 20 | #True -> 21 | pure (CNil) 22 | #False -> 23 | m1'.0 <- _prim_int_add m'.0 1 24 | m1.0 <- store (CInt m1'.0) 25 | p.0 <- store (Fupto m1.0 b.3) 26 | pure (CCons a.3 p.0) 27 | case l2 of 28 | (CNil) -> 29 | pure 0 30 | (CCons x xs) -> 31 | v.4 <- fetch x 32 | (CInt x') <- pure v.4 33 | unboxed.CInt.1 <- sum.unboxed xs 34 | _prim_int_add x' unboxed.CInt.1 35 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/019.T-ArityRaising: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | unboxed.CInt.0 <- sum.unboxed t3 6 | (CInt r') <- pure (CInt unboxed.CInt.0) 7 | _prim_int_print r' 8 | 9 | sum.unboxed l = 10 | v.3 <- fetch l 11 | (Fupto a.3 b.3) <- pure v.3 12 | v.1.0 <- fetch a.3 13 | (CInt m'.0) <- pure v.1.0 14 | v.2.0 <- fetch b.3 15 | (CInt n'.0) <- pure v.2.0 16 | b'.0 <- _prim_int_gt m'.0 n'.0 17 | l2 <- case b'.0 of 18 | #True -> 19 | pure (CNil) 20 | #False -> 21 | m1'.0 <- _prim_int_add m'.0 1 22 | m1.0 <- store (CInt m1'.0) 23 | p.0 <- store (Fupto m1.0 b.3) 24 | pure (CCons a.3 p.0) 25 | case l2 of 26 | (CNil) -> 27 | pure 0 28 | (CCons x xs) -> 29 | v.4 <- fetch x 30 | (CInt x') <- pure v.4 31 | unboxed.CInt.1 <- sum.unboxed xs 32 | _prim_int_add x' unboxed.CInt.1 33 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/020.T-CopyPropagation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | unboxed.CInt.0 <- sum.unboxed t3 6 | r' <- pure unboxed.CInt.0 7 | _prim_int_print unboxed.CInt.0 8 | 9 | sum.unboxed l = 10 | v.3 <- fetch l 11 | (Fupto a.3 b.3) <- pure v.3 12 | v.1.0 <- fetch a.3 13 | (CInt m'.0) <- pure v.1.0 14 | v.2.0 <- fetch b.3 15 | (CInt n'.0) <- pure v.2.0 16 | b'.0 <- _prim_int_gt m'.0 n'.0 17 | l2 <- case b'.0 of 18 | #True -> 19 | pure (CNil) 20 | #False -> 21 | m1'.0 <- _prim_int_add m'.0 1 22 | m1.0 <- store (CInt m1'.0) 23 | p.0 <- store (Fupto m1.0 b.3) 24 | pure (CCons a.3 p.0) 25 | case l2 of 26 | (CNil) -> 27 | pure 0 28 | (CCons x xs) -> 29 | v.4 <- fetch x 30 | (CInt x') <- pure v.4 31 | unboxed.CInt.1 <- sum.unboxed xs 32 | _prim_int_add x' unboxed.CInt.1 33 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/021.T-DeadVariableElimination: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | unboxed.CInt.0 <- sum.unboxed t3 6 | _prim_int_print unboxed.CInt.0 7 | 8 | sum.unboxed l = 9 | v.3 <- fetch l 10 | (Fupto a.3 b.3) <- pure v.3 11 | v.1.0 <- fetch a.3 12 | (CInt m'.0) <- pure v.1.0 13 | v.2.0 <- fetch b.3 14 | (CInt n'.0) <- pure v.2.0 15 | b'.0 <- _prim_int_gt m'.0 n'.0 16 | l2 <- case b'.0 of 17 | #True -> 18 | pure (CNil) 19 | #False -> 20 | m1'.0 <- _prim_int_add m'.0 1 21 | m1.0 <- store (CInt m1'.0) 22 | p.0 <- store (Fupto m1.0 b.3) 23 | pure (CCons a.3 p.0) 24 | case l2 of 25 | (CNil) -> 26 | pure 0 27 | (CCons x xs) -> 28 | v.4 <- fetch x 29 | (CInt x') <- pure v.4 30 | unboxed.CInt.1 <- sum.unboxed xs 31 | _prim_int_add x' unboxed.CInt.1 32 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/022.T-CaseHoisting: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | unboxed.CInt.0 <- sum.unboxed t3 6 | _prim_int_print unboxed.CInt.0 7 | 8 | sum.unboxed l = 9 | v.3 <- fetch l 10 | (Fupto a.3 b.3) <- pure v.3 11 | v.1.0 <- fetch a.3 12 | (CInt m'.0) <- pure v.1.0 13 | v.2.0 <- fetch b.3 14 | (CInt n'.0) <- pure v.2.0 15 | b'.0 <- _prim_int_gt m'.0 n'.0 16 | case b'.0 of 17 | #True -> 18 | l2.0 <- do 19 | pure (CNil) 20 | (CNil) <- pure l2.0 21 | pure 0 22 | #False -> 23 | l2.1 <- do 24 | m1'.0 <- _prim_int_add m'.0 1 25 | m1.0 <- store (CInt m1'.0) 26 | p.0 <- store (Fupto m1.0 b.3) 27 | pure (CCons a.3 p.0) 28 | (CCons x.0 xs.0) <- pure l2.1 29 | v.4.0 <- fetch x.0 30 | (CInt x'.0) <- pure v.4.0 31 | unboxed.CInt.1.0 <- sum.unboxed xs.0 32 | _prim_int_add x'.0 unboxed.CInt.1.0 33 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/023.T-ArityRaising: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | unboxed.CInt.0 <- sum.unboxed t3 6 | _prim_int_print unboxed.CInt.0 7 | 8 | sum.unboxed l = 9 | v.3 <- fetch l 10 | (Fupto a.3 b.3) <- pure v.3 11 | v.1.0 <- fetch a.3 12 | (CInt m'.0) <- pure v.1.0 13 | v.2.0 <- fetch b.3 14 | (CInt n'.0) <- pure v.2.0 15 | b'.0 <- _prim_int_gt m'.0 n'.0 16 | case b'.0 of 17 | #True -> 18 | l2.0 <- pure (CNil) 19 | (CNil) <- pure l2.0 20 | pure 0 21 | #False -> 22 | m1'.0 <- _prim_int_add m'.0 1 23 | m1.0 <- store (CInt m1'.0) 24 | p.0 <- store (Fupto m1.0 b.3) 25 | l2.1 <- pure (CCons a.3 p.0) 26 | (CCons x.0 xs.0) <- pure l2.1 27 | v.4.0 <- fetch x.0 28 | (CInt x'.0) <- pure v.4.0 29 | unboxed.CInt.1.0 <- sum.unboxed xs.0 30 | _prim_int_add x'.0 unboxed.CInt.1.0 31 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/024.T-CopyPropagation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | unboxed.CInt.0 <- sum.unboxed t3 6 | _prim_int_print unboxed.CInt.0 7 | 8 | sum.unboxed l = 9 | v.3 <- fetch l 10 | (Fupto a.3 b.3) <- pure v.3 11 | v.1.0 <- fetch a.3 12 | (CInt m'.0) <- pure v.1.0 13 | v.2.0 <- fetch b.3 14 | (CInt n'.0) <- pure v.2.0 15 | b'.0 <- _prim_int_gt m'.0 n'.0 16 | case b'.0 of 17 | #True -> 18 | l2.0 <- pure (CNil) 19 | pure 0 20 | #False -> 21 | m1'.0 <- _prim_int_add m'.0 1 22 | m1.0 <- store (CInt m1'.0) 23 | p.0 <- store (Fupto m1.0 b.3) 24 | l2.1 <- pure (CCons a.3 p.0) 25 | x.0 <- pure a.3 26 | xs.0 <- pure p.0 27 | v.4.0 <- fetch a.3 28 | (CInt x'.0) <- pure v.4.0 29 | unboxed.CInt.1.0 <- sum.unboxed p.0 30 | _prim_int_add x'.0 unboxed.CInt.1.0 31 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/025.T-DeadVariableElimination: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | unboxed.CInt.0 <- sum.unboxed t3 6 | _prim_int_print unboxed.CInt.0 7 | 8 | sum.unboxed l = 9 | v.3 <- fetch l 10 | (Fupto a.3 b.3) <- pure v.3 11 | v.1.0 <- fetch a.3 12 | (CInt m'.0) <- pure v.1.0 13 | v.2.0 <- fetch b.3 14 | (CInt n'.0) <- pure v.2.0 15 | b'.0 <- _prim_int_gt m'.0 n'.0 16 | case b'.0 of 17 | #True -> 18 | pure 0 19 | #False -> 20 | m1'.0 <- _prim_int_add m'.0 1 21 | m1.0 <- store (CInt m1'.0) 22 | p.0 <- store (Fupto m1.0 b.3) 23 | v.4.0 <- fetch a.3 24 | (CInt x'.0) <- pure v.4.0 25 | unboxed.CInt.1.0 <- sum.unboxed p.0 26 | _prim_int_add x'.0 unboxed.CInt.1.0 27 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/026.T-CommonSubExpressionElimination: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | unboxed.CInt.0 <- sum.unboxed t3 6 | _prim_int_print unboxed.CInt.0 7 | 8 | sum.unboxed l = 9 | v.3 <- fetch l 10 | (Fupto a.3 b.3) <- pure v.3 11 | v.1.0 <- fetch a.3 12 | (CInt m'.0) <- pure v.1.0 13 | v.2.0 <- fetch b.3 14 | (CInt n'.0) <- pure v.2.0 15 | b'.0 <- _prim_int_gt m'.0 n'.0 16 | case b'.0 of 17 | #True -> 18 | pure 0 19 | #False -> 20 | m1'.0 <- _prim_int_add m'.0 1 21 | m1.0 <- store (CInt m1'.0) 22 | p.0 <- store (Fupto m1.0 b.3) 23 | v.4.0 <- pure v.1.0 24 | (CInt x'.0) <- pure v.4.0 25 | unboxed.CInt.1.0 <- sum.unboxed p.0 26 | _prim_int_add x'.0 unboxed.CInt.1.0 27 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/027.T-ArityRaising: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | unboxed.CInt.0 <- sum.unboxed t1 t2 6 | _prim_int_print unboxed.CInt.0 7 | 8 | sum.unboxed l1 l2 = 9 | v.3 <- pure (Fupto l1 l2) 10 | (Fupto a.3 b.3) <- pure v.3 11 | v.1.0 <- fetch a.3 12 | (CInt m'.0) <- pure v.1.0 13 | v.2.0 <- fetch b.3 14 | (CInt n'.0) <- pure v.2.0 15 | b'.0 <- _prim_int_gt m'.0 n'.0 16 | case b'.0 of 17 | #True -> 18 | pure 0 19 | #False -> 20 | m1'.0 <- _prim_int_add m'.0 1 21 | m1.0 <- store (CInt m1'.0) 22 | p.0 <- store (Fupto m1.0 b.3) 23 | v.4.0 <- pure v.1.0 24 | (CInt x'.0) <- pure v.4.0 25 | unboxed.CInt.1.0 <- sum.unboxed m1.0 b.3 26 | _prim_int_add x'.0 unboxed.CInt.1.0 27 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/028.T-CopyPropagation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | t3 <- store (Fupto t1 t2) 5 | unboxed.CInt.0 <- sum.unboxed t1 t2 6 | _prim_int_print unboxed.CInt.0 7 | 8 | sum.unboxed l1 l2 = 9 | v.3 <- pure (Fupto l1 l2) 10 | a.3 <- pure l1 11 | b.3 <- pure l2 12 | v.1.0 <- fetch l1 13 | (CInt m'.0) <- pure v.1.0 14 | v.2.0 <- fetch l2 15 | (CInt n'.0) <- pure v.2.0 16 | b'.0 <- _prim_int_gt m'.0 n'.0 17 | case b'.0 of 18 | #True -> 19 | pure 0 20 | #False -> 21 | m1'.0 <- _prim_int_add m'.0 1 22 | m1.0 <- store (CInt m1'.0) 23 | p.0 <- store (Fupto m1.0 l2) 24 | v.4.0 <- pure v.1.0 25 | (CInt x'.0) <- pure v.1.0 26 | unboxed.CInt.1.0 <- sum.unboxed m1.0 l2 27 | _prim_int_add x'.0 unboxed.CInt.1.0 28 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/029.T-DeadVariableElimination: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | unboxed.CInt.0 <- sum.unboxed t1 t2 5 | _prim_int_print unboxed.CInt.0 6 | 7 | sum.unboxed l1 l2 = 8 | v.1.0 <- fetch l1 9 | (CInt m'.0) <- pure v.1.0 10 | v.2.0 <- fetch l2 11 | (CInt n'.0) <- pure v.2.0 12 | b'.0 <- _prim_int_gt m'.0 n'.0 13 | case b'.0 of 14 | #True -> 15 | pure 0 16 | #False -> 17 | m1'.0 <- _prim_int_add m'.0 1 18 | m1.0 <- store (CInt m1'.0) 19 | (CInt x'.0) <- pure v.1.0 20 | unboxed.CInt.1.0 <- sum.unboxed m1.0 l2 21 | _prim_int_add x'.0 unboxed.CInt.1.0 22 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/030.T-ArityRaising: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | unboxed.CInt.0 <- sum.unboxed 1 10000 5 | _prim_int_print unboxed.CInt.0 6 | 7 | sum.unboxed l1 l2 = 8 | v.1.0 <- pure (CInt l1) 9 | (CInt m'.0) <- pure v.1.0 10 | v.2.0 <- pure (CInt l2) 11 | (CInt n'.0) <- pure v.2.0 12 | b'.0 <- _prim_int_gt m'.0 n'.0 13 | case b'.0 of 14 | #True -> 15 | pure 0 16 | #False -> 17 | m1'.0 <- _prim_int_add m'.0 1 18 | m1.0 <- store (CInt m1'.0) 19 | (CInt x'.0) <- pure v.1.0 20 | unboxed.CInt.1.0 <- sum.unboxed m1'.0 l2 21 | _prim_int_add x'.0 unboxed.CInt.1.0 22 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/031.T-CopyPropagation: -------------------------------------------------------------------------------- 1 | grinMain = 2 | t1 <- store (CInt 1) 3 | t2 <- store (CInt 10000) 4 | unboxed.CInt.0 <- sum.unboxed 1 10000 5 | _prim_int_print unboxed.CInt.0 6 | 7 | sum.unboxed l1 l2 = 8 | v.1.0 <- pure (CInt l1) 9 | m'.0 <- pure l1 10 | v.2.0 <- pure (CInt l2) 11 | n'.0 <- pure l2 12 | b'.0 <- _prim_int_gt l1 l2 13 | case b'.0 of 14 | #True -> 15 | pure 0 16 | #False -> 17 | m1'.0 <- _prim_int_add l1 1 18 | m1.0 <- store (CInt m1'.0) 19 | x'.0 <- pure l1 20 | unboxed.CInt.1.0 <- sum.unboxed m1'.0 l2 21 | _prim_int_add l1 unboxed.CInt.1.0 22 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/032.T-DeadVariableElimination: -------------------------------------------------------------------------------- 1 | grinMain = 2 | unboxed.CInt.0 <- sum.unboxed 1 10000 3 | _prim_int_print unboxed.CInt.0 4 | 5 | sum.unboxed l1 l2 = 6 | b'.0 <- _prim_int_gt l1 l2 7 | case b'.0 of 8 | #True -> 9 | pure 0 10 | #False -> 11 | m1'.0 <- _prim_int_add l1 1 12 | unboxed.CInt.1.0 <- sum.unboxed m1'.0 l2 13 | _prim_int_add l1 unboxed.CInt.1.0 14 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/033.high-level-opt-code.ll: -------------------------------------------------------------------------------- 1 | ; ModuleID = 'basic' 2 | source_filename = "" 3 | 4 | @_heap_ptr_ = global i64 0 5 | 6 | declare void @_prim_int_print(i64) 7 | 8 | define void @grinMain() #0 { 9 | grinMain.entry: 10 | %unboxed.CInt.0.0 = tail call fastcc i64 @sum.unboxed(i64 1, i64 10000) 11 | call void @_prim_int_print(i64 %unboxed.CInt.0.0) 12 | ret void 13 | 14 | error_block: ; No predecessors! 15 | tail call void @_prim_int_print(i64 666) 16 | unreachable 17 | } 18 | 19 | define private fastcc i64 @sum.unboxed(i64 %l1, i64 %l2) #0 { 20 | sum.unboxed.entry: 21 | %"b'.0.1" = icmp sgt i64 %l1, %l2 22 | switch i1 %"b'.0.1", label %error_block [ 23 | i1 true, label %block.bool_True.2 24 | i1 false, label %block.bool_False.3 25 | ] 26 | 27 | block.bool_True.2: ; preds = %sum.unboxed.entry 28 | br label %block.exit.7 29 | 30 | block.bool_False.3: ; preds = %sum.unboxed.entry 31 | %"m1'.0.4" = add i64 %l1, 1 32 | %unboxed.CInt.1.0.5 = tail call fastcc i64 @sum.unboxed(i64 %"m1'.0.4", i64 %l2) 33 | %result.bool_False.6 = add i64 %l1, %unboxed.CInt.1.0.5 34 | br label %block.exit.7 35 | 36 | block.exit.7: ; preds = %block.bool_False.3, %block.bool_True.2 37 | %result.sum.unboxed.8 = phi i64 [ 0, %block.bool_True.2 ], [ %result.bool_False.6, %block.bool_False.3 ] 38 | ret i64 %result.sum.unboxed.8 39 | 40 | error_block: ; preds = %sum.unboxed.entry 41 | tail call void @_prim_int_print(i64 666) 42 | unreachable 43 | } 44 | 45 | attributes #0 = { "no-jump-tables"="true" } 46 | -------------------------------------------------------------------------------- /grin/grin/sum-simple-output/033.high-level-opt-code.s: -------------------------------------------------------------------------------- 1 | .text 2 | .file "" 3 | .globl grinMain # -- Begin function grinMain 4 | .p2align 4, 0x90 5 | .type grinMain,@function 6 | grinMain: # @grinMain 7 | .cfi_startproc 8 | # BB#0: # %grinMain.entry 9 | movl $50005000, %edi # imm = 0x2FB0408 10 | jmp _prim_int_print # TAILCALL 11 | .Lfunc_end0: 12 | .size grinMain, .Lfunc_end0-grinMain 13 | .cfi_endproc 14 | # -- End function 15 | .type _heap_ptr_,@object # @_heap_ptr_ 16 | .bss 17 | .globl _heap_ptr_ 18 | .p2align 3 19 | _heap_ptr_: 20 | .quad 0 # 0x0 21 | .size _heap_ptr_, 8 22 | 23 | 24 | .section ".note.GNU-stack","",@progbits 25 | -------------------------------------------------------------------------------- /grin/grin/sum_opt.grin: -------------------------------------------------------------------------------- 1 | grinMain = 2 | n13 <- sum 0 1 100000 3 | _prim_int_print n13 4 | 5 | sum n29 n30 n31 = 6 | b2 <- _prim_int_gt n30 n31 7 | if b2 then 8 | pure n29 9 | else 10 | n18 <- _prim_int_add n30 1 11 | n28 <- _prim_int_add n29 n30 12 | sum n28 n18 n31 13 | -------------------------------------------------------------------------------- /grin/grin/sum_opt_desugared.grin: -------------------------------------------------------------------------------- 1 | grinMain = 2 | n13 <- sum 0 1 10000 3 | _prim_int_print n13 4 | 5 | sum n29 n30 n31 = 6 | b2 <- _prim_int_gt n30 n31 7 | case b2 of 8 | #False -> n18 <- _prim_int_add n30 1 9 | n28 <- _prim_int_add n29 n30 10 | sum n28 n18 n31 11 | #default -> pure n29 12 | -------------------------------------------------------------------------------- /grin/grin/sum_opt_lint_errors.grin: -------------------------------------------------------------------------------- 1 | grinMain = 2 | n13 <- sum 0 1 100000 3 | _prim_int_print n13 4 | 5 | sum n29 n30 n31 = 6 | b2 <- _prim_int_gt n30 n31_ 7 | if b2 then 8 | pure n29 9 | else 10 | n18 <- _prim_int_add n30 1 11 | n28 <- _prim_int_add n29_ n30_ 12 | sum n28 n18 n31 13 | -------------------------------------------------------------------------------- /grin/grin/sum_simple.grin: -------------------------------------------------------------------------------- 1 | grinMain = t1 <- store (CInt 1) 2 | t2 <- store (CInt 10000) 3 | t3 <- store (Fupto t1 t2) 4 | t4 <- store (Fsum t3) 5 | (CInt r') <- eval t4 6 | _prim_int_print r' 7 | 8 | upto m n = (CInt m') <- eval m 9 | (CInt n') <- eval n 10 | b' <- _prim_int_gt m' n' 11 | if b' then 12 | pure (CNil) 13 | else 14 | m1' <- _prim_int_add m' 1 15 | m1 <- store (CInt m1') 16 | p <- store (Fupto m1 n) 17 | pure (CCons m p) 18 | 19 | sum l = l2 <- eval l 20 | case l2 of 21 | (CNil) -> pure (CInt 0) 22 | (CCons x xs) -> (CInt x') <- eval x 23 | (CInt s') <- sum xs 24 | ax' <- _prim_int_add x' s' 25 | pure (CInt ax') 26 | 27 | eval q = v <- fetch q 28 | case v of 29 | (CInt x'1) -> pure (CInt x'1) 30 | (CNil) -> pure (CNil) 31 | (CCons y ys) -> pure (CCons y ys) 32 | (Fupto a b) -> w <- upto a b 33 | update q w 34 | pure w 35 | (Fsum c) -> z <- sum c 36 | update q z 37 | pure z 38 | -------------------------------------------------------------------------------- /grin/grin/undefined/simple.grin: -------------------------------------------------------------------------------- 1 | grinMain = 2 | n0 <- pure (CPair 5 (#undefined :: {})) 3 | case n0 of 4 | (CPair c0 c1) -> 5 | x0 <- fetch c1 6 | pure c0 -------------------------------------------------------------------------------- /grin/prim_ops.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | struct string { 8 | char* data; 9 | int64_t length; 10 | }; 11 | 12 | struct string* create_string_len(int64_t l); 13 | struct string* create_string_copy(char *str); 14 | 15 | // ASSUMPTION: The buffer has enough memory allocated to store the string 16 | void cstring(char* buffer, struct string* s); 17 | 18 | void _prim_string_print(struct string* p1); 19 | void _prim_int_print(int64_t p1); 20 | struct string* _prim_read_string(); 21 | void _prim_usleep(int64_t p1); 22 | void _prim_error(struct string* p1); 23 | int64_t _prim_ffi_file_eof(int64_t p1); 24 | struct string* _prim_string_concat(struct string* p1, struct string* p2); 25 | struct string* _prim_string_reverse(struct string* p1); 26 | int64_t _prim_string_eq(struct string* p1, struct string* p2); 27 | int64_t _prim_string_head(struct string* p1); 28 | int64_t _prim_string_len(struct string* p1); 29 | struct string* _prim_string_tail(struct string* p1); 30 | struct string* _prim_string_cons(int64_t p1, struct string* p2); 31 | int64_t _prim_string_lt(struct string* p1, struct string* p2); 32 | struct string* _prim_int_str(int64_t p1); 33 | int64_t _prim_str_int(struct string* p1); 34 | float _prim_int_float(int64_t p1); 35 | struct string* _prim_float_string(float p1); 36 | int64_t _prim_char_int(char p1); 37 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/CreatedBy/Pretty.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | module AbstractInterpretation.CreatedBy.Pretty where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Text.PrettyPrint.ANSI.Leijen 6 | 7 | import Data.Map (Map) 8 | import qualified Data.Map as Map 9 | 10 | import Grin.Pretty 11 | import Grin.Grin (Tag, Name) 12 | 13 | import AbstractInterpretation.CreatedBy.Result 14 | import AbstractInterpretation.HeapPointsTo.Pretty 15 | 16 | instance Pretty ProducerSet where 17 | pretty (ProducerSet ps) = prettyBracedList 18 | . map prettySimplePair 19 | . Map.toList $ ps 20 | 21 | instance Pretty ProducerMap where 22 | pretty (ProducerMap pm) = prettyKeyValue $ Map.toList pm 23 | 24 | instance Pretty ProducerGraph where 25 | pretty (ProducerGraph pMap) = pretty pMap 26 | 27 | instance Pretty GroupedProducers where 28 | pretty (All prods) = yellow (text "Producer Groups (all)") 29 | <$$> indent 4 (pretty prods) 30 | pretty (Active prods) = yellow (text "Producer Groups (only for actives)") 31 | <$$> indent 4 (pretty prods) 32 | 33 | instance Pretty CByResult where 34 | pretty CByResult{..} = vsep 35 | [ pretty _hptResult 36 | , yellow (text "Producers") <$$> indent 4 (pretty _producers) 37 | , pretty _groupedProducers 38 | ] 39 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/EffectTracking/Pretty.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, RecordWildCards #-} 2 | module AbstractInterpretation.EffectTracking.Pretty where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Text.PrettyPrint.ANSI.Leijen 6 | 7 | import Data.Set (Set) 8 | import qualified Data.Set as Set 9 | 10 | import Data.Map (Map) 11 | import qualified Data.Map as Map 12 | 13 | import Data.IntMap (IntMap) 14 | import qualified Data.IntMap as IntMap 15 | 16 | import Data.Vector (Vector) 17 | import qualified Data.Vector as V 18 | 19 | import Grin.Grin (Tag, Name) 20 | import Grin.Pretty as Grin 21 | import qualified AbstractInterpretation.EffectTracking.Result as R 22 | 23 | instance Pretty R.Effects where 24 | pretty (R.Effects es) = prettyBracedList . map dullyellow . map Grin.pretty . Set.toList $ es 25 | 26 | instance Pretty R.ETResult where 27 | pretty R.ETResult{..} = vsep 28 | [ yellow (text "Bindings") <$$> indent 4 (prettyKeyValue $ Map.toList _register) 29 | , yellow (text "Functions") <$$> indent 4 (prettyKeyValue $ Map.toList _function) 30 | ] 31 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/ExtendedSyntax/CreatedBy/Pretty.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | module AbstractInterpretation.ExtendedSyntax.CreatedBy.Pretty where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Text.PrettyPrint.ANSI.Leijen 6 | 7 | import Data.Map (Map) 8 | import qualified Data.Map as Map 9 | 10 | import Grin.ExtendedSyntax.Pretty 11 | import Grin.ExtendedSyntax.Grin (Tag, Name) 12 | 13 | import AbstractInterpretation.ExtendedSyntax.CreatedBy.Result 14 | import AbstractInterpretation.ExtendedSyntax.HeapPointsTo.Pretty 15 | 16 | instance Pretty ProducerSet where 17 | pretty (ProducerSet ps) = prettyBracedList 18 | . map prettySimplePair 19 | . Map.toList $ ps 20 | 21 | instance Pretty ProducerMap where 22 | pretty (ProducerMap pm) = prettyKeyValue $ Map.toList pm 23 | 24 | instance Pretty ProducerGraph where 25 | pretty (ProducerGraph pMap) = pretty pMap 26 | 27 | instance Pretty GroupedProducers where 28 | pretty (All prods) = yellow (text "Producer Groups (all)") 29 | <$$> indent 4 (pretty prods) 30 | pretty (Active prods) = yellow (text "Producer Groups (only for actives)") 31 | <$$> indent 4 (pretty prods) 32 | 33 | instance Pretty CByResult where 34 | pretty CByResult{..} = vsep 35 | [ pretty _hptResult 36 | , yellow (text "Producers") <$$> indent 4 (pretty _producers) 37 | , pretty _groupedProducers 38 | ] 39 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/ExtendedSyntax/EffectTracking/Pretty.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, RecordWildCards #-} 2 | module AbstractInterpretation.ExtendedSyntax.EffectTracking.Pretty where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Text.PrettyPrint.ANSI.Leijen 6 | 7 | import Data.Set (Set) 8 | import qualified Data.Set as Set 9 | 10 | import Data.Map (Map) 11 | import qualified Data.Map as Map 12 | 13 | import Data.IntMap (IntMap) 14 | import qualified Data.IntMap as IntMap 15 | 16 | import Data.Vector (Vector) 17 | import qualified Data.Vector as V 18 | 19 | import Grin.ExtendedSyntax.Grin (Tag, Name) 20 | import Grin.ExtendedSyntax.Pretty as Grin 21 | import qualified AbstractInterpretation.ExtendedSyntax.EffectTracking.Result as R 22 | 23 | instance Pretty R.Effects where 24 | pretty (R.Effects es) = prettyBracedList . map dullyellow . map Grin.pretty . Set.toList $ es 25 | 26 | instance Pretty R.ETResult where 27 | pretty R.ETResult{..} = vsep 28 | [ yellow (text "Bindings") <$$> indent 4 (prettyKeyValue $ Map.toList _register) 29 | , yellow (text "Functions") <$$> indent 4 (prettyKeyValue $ Map.toList _function) 30 | ] 31 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/ExtendedSyntax/ReduceCpp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, RecordWildCards, Strict #-} 2 | module AbstractInterpretation.ExtendedSyntax.ReduceCpp where 3 | 4 | import qualified Data.ByteString.Lazy as LBS 5 | import qualified System.Process 6 | import System.IO.Unsafe 7 | 8 | import AbstractInterpretation.ExtendedSyntax.IR 9 | import AbstractInterpretation.ExtendedSyntax.Reduce (AbstractInterpretationResult) 10 | import AbstractInterpretation.ExtendedSyntax.BinaryResult 11 | import AbstractInterpretation.ExtendedSyntax.BinaryIR 12 | 13 | evalAbstractProgramCpp :: AbstractProgram -> IO AbstractInterpretationResult 14 | evalAbstractProgramCpp prg = do 15 | -- save abstract program to temp file 16 | LBS.writeFile "dataflow_program.dfbin" $ encodeAbstractProgram prg 17 | 18 | -- run external reducer 19 | System.Process.callCommand "df_test dataflow_program.dfbin" 20 | 21 | -- read back result 22 | loadAbstractInterpretationResult "dataflow_program.dfbin.dat" 23 | 24 | evalAbstractProgramCppUnsafe :: AbstractProgram -> AbstractInterpretationResult 25 | evalAbstractProgramCppUnsafe a = unsafePerformIO $ evalAbstractProgramCpp a 26 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/ExtendedSyntax/Sharing/Pretty.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, RecordWildCards #-} 2 | module AbstractInterpretation.ExtendedSyntax.Sharing.Pretty where 3 | 4 | import Text.PrettyPrint.ANSI.Leijen 5 | 6 | import Data.Set (Set) 7 | import Data.Map (Map) 8 | import qualified Data.Set as Set 9 | import qualified Data.Map as Map 10 | 11 | import Data.Vector (Vector) 12 | import qualified Data.Vector as V 13 | 14 | import Grin.ExtendedSyntax.Pretty 15 | import AbstractInterpretation.ExtendedSyntax.HeapPointsTo.Pretty 16 | import AbstractInterpretation.ExtendedSyntax.HeapPointsTo.Result 17 | import AbstractInterpretation.ExtendedSyntax.Sharing.Result 18 | 19 | 20 | instance Pretty SharingResult where 21 | pretty = prettySharingResult 22 | 23 | prettySharingResult :: SharingResult -> Doc 24 | prettySharingResult shResult = vsep 25 | [ yellow (text "Heap (* is shared)") <$$> indent 4 (prettyKeyValue . V.toList . V.imap annotateSharedLoc $ _memory) 26 | , yellow (text "Env") <$$> indent 4 (prettyKeyValue $ Map.toList _register) 27 | , yellow (text "Function") <$$> indent 4 (vsep $ map prettyHPTFunction $ Map.toList _function) 28 | ] where 29 | shLocs = _sharedLocs shResult 30 | HPTResult{..} = _hptResult $ shResult 31 | annotateSharedLoc loc ty 32 | | Set.member loc shLocs = (pretty loc <> text "*", ty) 33 | | otherwise = (pretty loc, ty) 34 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/ExtendedSyntax/Sharing/Result.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving, RecordWildCards #-} 2 | 3 | module AbstractInterpretation.ExtendedSyntax.Sharing.Result where 4 | 5 | import Data.Set (Set) 6 | import Data.Map (Map) 7 | import qualified Data.Set as Set 8 | import qualified Data.Map as Map 9 | 10 | import Lens.Micro.Platform 11 | 12 | import Grin.ExtendedSyntax.Grin (Name, Tag) 13 | import AbstractInterpretation.ExtendedSyntax.IR (AbstractProgram) 14 | import AbstractInterpretation.ExtendedSyntax.Sharing.CodeGen 15 | import AbstractInterpretation.ExtendedSyntax.HeapPointsTo.Result 16 | import qualified AbstractInterpretation.ExtendedSyntax.Reduce as R 17 | 18 | 19 | data SharingResult 20 | = SharingResult 21 | { _hptResult :: HPTResult 22 | , _sharedLocs :: Set Loc 23 | } 24 | deriving (Eq, Show) 25 | 26 | emptySharingResult :: SharingResult 27 | emptySharingResult = SharingResult emptyHPTResult mempty 28 | 29 | concat <$> mapM makeLenses [''SharingResult] 30 | 31 | toSharingResult :: SharingMapping -> R.ComputerState -> SharingResult 32 | toSharingResult SharingMapping{..} comp = SharingResult hptResult sharedLocs where 33 | hptResult = toHPTResult _hptMapping comp 34 | sharedLocs = onlyLocations sty 35 | TypeSet sty _ = convertReg (_hptMapping, comp) _shRegName 36 | 37 | onlyLocations :: Set SimpleType -> Set Loc 38 | onlyLocations stys = Set.fromList [ l | T_Location l <- Set.toList stys ] 39 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/ExtendedSyntax/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, RecordWildCards #-} 2 | module AbstractInterpretation.ExtendedSyntax.Util where 3 | 4 | converge :: (a -> a -> Bool) -> (a -> a) -> a -> a 5 | converge pred f x 6 | | pred x x' = x 7 | | otherwise = converge pred f x' 8 | where x' = f x 9 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/ReduceCpp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, RecordWildCards, Strict #-} 2 | module AbstractInterpretation.ReduceCpp where 3 | 4 | import qualified Data.ByteString.Lazy as LBS 5 | import qualified System.Process 6 | import System.IO.Unsafe 7 | 8 | import AbstractInterpretation.IR 9 | import AbstractInterpretation.Reduce (AbstractInterpretationResult) 10 | import AbstractInterpretation.BinaryResult 11 | import AbstractInterpretation.BinaryIR 12 | 13 | evalAbstractProgramCpp :: AbstractProgram -> IO AbstractInterpretationResult 14 | evalAbstractProgramCpp prg = do 15 | -- save abstract program to temp file 16 | LBS.writeFile "dataflow_program.dfbin" $ encodeAbstractProgram prg 17 | 18 | -- run external reducer 19 | System.Process.callCommand "df_test dataflow_program.dfbin" 20 | 21 | -- read back result 22 | loadAbstractInterpretationResult "dataflow_program.dfbin.dat" 23 | 24 | evalAbstractProgramCppUnsafe :: AbstractProgram -> AbstractInterpretationResult 25 | evalAbstractProgramCppUnsafe a = unsafePerformIO $ evalAbstractProgramCpp a 26 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/Sharing/Pretty.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, RecordWildCards #-} 2 | module AbstractInterpretation.Sharing.Pretty where 3 | 4 | import Text.PrettyPrint.ANSI.Leijen 5 | 6 | import Data.Set (Set) 7 | import Data.Map (Map) 8 | import qualified Data.Set as Set 9 | import qualified Data.Map as Map 10 | 11 | import Data.Vector (Vector) 12 | import qualified Data.Vector as V 13 | 14 | import Grin.Pretty 15 | import AbstractInterpretation.HeapPointsTo.Pretty 16 | import AbstractInterpretation.HeapPointsTo.Result 17 | import AbstractInterpretation.Sharing.Result 18 | 19 | 20 | instance Pretty SharingResult where 21 | pretty = prettySharingResult 22 | 23 | prettySharingResult :: SharingResult -> Doc 24 | prettySharingResult shResult = vsep 25 | [ yellow (text "Heap (* is shared)") <$$> indent 4 (prettyKeyValue . V.toList . V.imap annotateSharedLoc $ _memory) 26 | , yellow (text "Env") <$$> indent 4 (prettyKeyValue $ Map.toList _register) 27 | , yellow (text "Function") <$$> indent 4 (vsep $ map prettyHPTFunction $ Map.toList _function) 28 | ] where 29 | shLocs = _sharedLocs shResult 30 | HPTResult{..} = _hptResult $ shResult 31 | annotateSharedLoc loc ty 32 | | Set.member loc shLocs = (pretty loc <> text "*", ty) 33 | | otherwise = (pretty loc, ty) 34 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/Sharing/Result.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving, RecordWildCards #-} 2 | 3 | module AbstractInterpretation.Sharing.Result where 4 | 5 | import Data.Set (Set) 6 | import Data.Map (Map) 7 | import qualified Data.Set as Set 8 | import qualified Data.Map as Map 9 | 10 | import Lens.Micro.Platform 11 | 12 | import Grin.Grin (Name, Tag) 13 | import AbstractInterpretation.IR (AbstractProgram) 14 | import AbstractInterpretation.Sharing.CodeGen 15 | import AbstractInterpretation.HeapPointsTo.Result 16 | import qualified AbstractInterpretation.Reduce as R 17 | 18 | 19 | data SharingResult 20 | = SharingResult 21 | { _hptResult :: HPTResult 22 | , _sharedLocs :: Set Loc 23 | } 24 | deriving (Eq, Show) 25 | 26 | emptySharingResult :: SharingResult 27 | emptySharingResult = SharingResult emptyHPTResult mempty 28 | 29 | concat <$> mapM makeLenses [''SharingResult] 30 | 31 | toSharingResult :: SharingMapping -> R.ComputerState -> SharingResult 32 | toSharingResult SharingMapping{..} comp = SharingResult hptResult sharedLocs where 33 | hptResult = toHPTResult _hptMapping comp 34 | sharedLocs = onlyLocations sty 35 | TypeSet sty _ = convertReg (_hptMapping, comp) _shRegName 36 | 37 | onlyLocations :: Set SimpleType -> Set Loc 38 | onlyLocations stys = Set.fromList [ l | T_Location l <- Set.toList stys ] 39 | -------------------------------------------------------------------------------- /grin/src/AbstractInterpretation/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, RecordWildCards #-} 2 | module AbstractInterpretation.Util where 3 | 4 | converge :: (a -> a -> Bool) -> (a -> a) -> a -> a 5 | converge pred f x 6 | | pred x x' = x 7 | | otherwise = converge pred f x' 8 | where x' = f x 9 | -------------------------------------------------------------------------------- /grin/src/Grin/ExtendedSyntax/Parse.hs: -------------------------------------------------------------------------------- 1 | module Grin.ExtendedSyntax.Parse 2 | ( module Grin.ExtendedSyntax.Parse.AST 3 | , module Grin.ExtendedSyntax.Parse.TypeEnv 4 | , module Grin.ExtendedSyntax.Parse 5 | ) where 6 | 7 | import Data.Void 8 | import Data.Text 9 | import Text.Megaparsec 10 | 11 | import Grin.ExtendedSyntax.Grin 12 | import Grin.ExtendedSyntax.TypeEnvDefs 13 | 14 | import Grin.ExtendedSyntax.Parse.AST 15 | import Grin.ExtendedSyntax.Parse.TypeEnv 16 | 17 | parseGrinWithTypes :: String -> Text -> Either (ParseErrorBundle Text Void) (TypeEnv, Exp) 18 | parseGrinWithTypes filename content = (,) <$> parseMarkedTypeEnv filename content <*> parseGrin filename content 19 | -------------------------------------------------------------------------------- /grin/src/Grin/ExtendedSyntax/TypeEnvDefs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, DeriveAnyClass, DeriveGeneric #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | module Grin.ExtendedSyntax.TypeEnvDefs where 4 | 5 | import Data.Binary 6 | 7 | import Data.Data 8 | import Data.Map (Map) 9 | import Data.Vector (Vector) 10 | 11 | import qualified Data.Vector as V (fromList, toList) 12 | 13 | import Data.Monoid 14 | 15 | import Control.DeepSeq 16 | import GHC.Generics (Generic) 17 | 18 | import Lens.Micro.Platform 19 | 20 | import Grin.ExtendedSyntax.SyntaxDefs 21 | 22 | -- TODO: put orphan instances into a separate module 23 | instance Binary a => Binary (Vector a) where 24 | get = V.fromList <$> get 25 | put = put . V.toList 26 | 27 | type NodeSet = Map Tag (Vector SimpleType) 28 | 29 | data Type 30 | = T_SimpleType {_simpleType :: SimpleType} 31 | | T_NodeSet {_nodeSet :: NodeSet} 32 | deriving (Generic, Data, NFData, Binary, Eq, Ord, Show) 33 | 34 | data TypeEnv 35 | = TypeEnv 36 | { _location :: Vector NodeSet 37 | , _variable :: Map Name Type 38 | , _function :: Map Name (Type, Vector Type) 39 | } 40 | deriving (Eq, Show) 41 | 42 | concat <$> mapM makeLenses [''TypeEnv, ''Type, ''SimpleType] 43 | 44 | emptyTypeEnv :: TypeEnv 45 | emptyTypeEnv = TypeEnv mempty mempty mempty 46 | -------------------------------------------------------------------------------- /grin/src/Grin/Parse.hs: -------------------------------------------------------------------------------- 1 | module Grin.Parse 2 | ( module Grin.Parse.AST 3 | , module Grin.Parse.TypeEnv 4 | , module Grin.Parse 5 | ) where 6 | 7 | import Data.Void 8 | import Data.Text 9 | import Text.Megaparsec 10 | 11 | import Grin.Grin 12 | import Grin.TypeEnvDefs 13 | 14 | import Grin.Parse.AST 15 | import Grin.Parse.TypeEnv 16 | 17 | parseGrinWithTypes :: String -> Text -> Either (ParseErrorBundle Text Void) (TypeEnv, Exp) 18 | parseGrinWithTypes filename content = (,) <$> parseMarkedTypeEnv filename content <*> parseGrin filename content 19 | -------------------------------------------------------------------------------- /grin/src/Grin/TypeEnvDefs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, DeriveAnyClass, DeriveGeneric #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | module Grin.TypeEnvDefs where 4 | 5 | import Data.Data 6 | import Data.Map (Map) 7 | import Data.Vector (Vector) 8 | 9 | import Data.Monoid 10 | 11 | import Control.DeepSeq 12 | import GHC.Generics (Generic) 13 | 14 | import Lens.Micro.Platform 15 | 16 | import Grin.SyntaxDefs 17 | 18 | type NodeSet = Map Tag (Vector SimpleType) 19 | 20 | data Type 21 | = T_SimpleType {_simpleType :: SimpleType} 22 | | T_NodeSet {_nodeSet :: NodeSet} 23 | 24 | -- dependent type constructions to describe deconstructed nodes 25 | | T_Tag {_tagDomain :: NodeSet} -- tag with it's corresponding node set domain 26 | | T_Item {_tagVariable :: Name -- tag variable name that holds the node tag on which the item type depends 27 | ,_itemIndex :: Int -- item index in the node 28 | } 29 | deriving (Generic, Data, NFData, Eq, Ord, Show) 30 | 31 | data TypeEnv 32 | = TypeEnv 33 | { _location :: Vector NodeSet 34 | , _variable :: Map Name Type 35 | , _function :: Map Name (Type, Vector Type) 36 | } 37 | deriving (Eq, Show) 38 | 39 | concat <$> mapM makeLenses [''TypeEnv, ''Type, ''SimpleType] 40 | 41 | emptyTypeEnv :: TypeEnv 42 | emptyTypeEnv = TypeEnv mempty mempty mempty 43 | -------------------------------------------------------------------------------- /grin/src/Lens/Micro/Extra.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies, RankNTypes #-} 2 | module Lens.Micro.Extra where 3 | 4 | import Lens.Micro.Internal 5 | import Lens.Micro.Platform 6 | import Data.Vector as V 7 | import Data.Functor.Infix ((<$$>)) 8 | import Data.Monoid (Any(..)) 9 | 10 | 11 | type instance Index (Vector a) = Int 12 | type instance IxValue (Vector a) = a 13 | 14 | instance At (Vector a) where 15 | at k = lens (V.!? k) (\v -> maybe v (\a -> v V.// [(k, a)])) 16 | 17 | isn't :: Getting Any s a -> s -> Bool 18 | isn't = not <$$> has 19 | -------------------------------------------------------------------------------- /grin/src/NOTES: -------------------------------------------------------------------------------- 1 | use cofree instead of fix to have an annotated AST 2 | use recursion schemes (ekmett lib) 3 | 4 | reactive compiler = recompile only that part of the ast that are affected 5 | 6 | 7 | fixplate + unbound 8 | solution: 9 | move Fix definition to backpack 10 | 11 | 12 | write down the design so that anyone can catch up and continue on the development. 13 | -------------------------------------------------------------------------------- /grin/src/Pipeline/Eval.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Pipeline.Eval where 3 | 4 | import qualified Data.Text.IO as Text 5 | import Text.Megaparsec 6 | 7 | import Grin.Grin 8 | import Grin.Parse 9 | import Reducer.Base (RTVal, Statistics) 10 | import qualified Reducer.IO 11 | import qualified Reducer.Pure 12 | import qualified Reducer.Interpreter.Definitional 13 | 14 | 15 | 16 | data Reducer 17 | = PureReducer Reducer.Pure.EvalPlugin 18 | | IOReducer 19 | | DefinitionalReducer Reducer.Pure.EvalPlugin 20 | 21 | evalProgram :: Reducer -> Program -> IO (RTVal, Maybe Statistics) 22 | evalProgram reducer program = 23 | case reducer of 24 | PureReducer evalPrimOp 25 | -> Reducer.Pure.reduceFun evalPrimOp program "grinMain" 26 | IOReducer 27 | -> Reducer.IO.reduceFun program "grinMain" 28 | DefinitionalReducer evalPrimOp 29 | -> (\x -> (x,Nothing)) <$> Reducer.Interpreter.Definitional.reduceFun evalPrimOp program "grinMain" 30 | -------------------------------------------------------------------------------- /grin/src/Reducer/Interpreter/Definitional.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications, LambdaCase, EmptyCase #-} 2 | module Reducer.Interpreter.Definitional 3 | ( reduceFun 4 | ) where 5 | 6 | import Control.Monad.IO.Class (MonadIO(..)) 7 | import Reducer.Interpreter.Base (Void, toExprF) 8 | import Reducer.Interpreter.Definitional.Internal 9 | import Reducer.Interpreter.Definitional.Instance 10 | import Reducer.Base (RTVal(..)) 11 | import Reducer.Pure (EvalPlugin(..)) 12 | import Transformations.ExtendedSyntax.Conversion (convertToNew) 13 | import qualified Grin.Syntax as SyntaxV1 (Exp, Name(..)) 14 | 15 | 16 | import qualified Data.Map as Map 17 | 18 | reduceFun :: EvalPlugin -> SyntaxV1.Exp -> SyntaxV1.Name -> IO RTVal 19 | reduceFun (EvalPlugin evalPrimOps) expV1 mainName = do 20 | (Left dval, _) 21 | <- evalDefinitional 22 | (DefinitionalTContext @Void @() @NoHeapInfo) 23 | (\case) 24 | (Map.map convertPrimOp $ Map.mapKeys nameV1toV2 evalPrimOps) 25 | (nameV1toV2 mainName) 26 | (toExprF $ convertToNew expV1) 27 | pure $ dValToRtVal dval 28 | where 29 | convertPrimOp f args = liftIO $ fmap rtValToDVal $ f $ map dValToRtVal args 30 | -------------------------------------------------------------------------------- /grin/src/Reducer/Interpreter/Env.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | module Reducer.Interpreter.Env where 3 | 4 | import Data.List (foldl') 5 | import Data.Maybe (fromMaybe) 6 | import Grin.ExtendedSyntax.Syntax 7 | import Grin.ExtendedSyntax.Pretty 8 | import qualified Data.Map.Strict as Map 9 | 10 | -- * Env 11 | 12 | -- | Environment mapping names to abstract values. 13 | newtype Env v = Env (Map.Map Name v) 14 | deriving (Eq, Show, Ord, Functor) 15 | 16 | empty :: Env v 17 | empty = Env mempty 18 | 19 | lookup :: (Env v) -> Name -> v 20 | lookup (Env m) n = fromMaybe (error $ "Missing:" ++ show n) $ Map.lookup n m 21 | 22 | insert :: Name -> v -> Env v -> Env v 23 | insert n v (Env m) = Env $ Map.insert n v m 24 | 25 | inserts :: [(Name, v)] -> Env v -> Env v 26 | inserts vs (Env m) = Env $ foldl' (\n (k,v) -> Map.insert k v n) m vs 27 | 28 | insertEnv :: Env v -> Env v -> Env v 29 | insertEnv (Env old) (Env new) = Env (Map.unionWith (\_ n -> n) old new) 30 | 31 | -- Explicit instance!! different from default 32 | instance (Semigroup v) => Semigroup (Env v) where 33 | Env m1 <> Env m2 = Env (Map.unionWith (<>) m1 m2) 34 | 35 | instance (Semigroup v) => Monoid (Env v) where 36 | mempty = Env mempty 37 | 38 | instance (Pretty v) => Pretty (Env v) where 39 | pretty (Env m) = prettyKeyValue (Map.toList m) 40 | -------------------------------------------------------------------------------- /grin/src/Reducer/Interpreter/Store.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | module Reducer.Interpreter.Store where 3 | 4 | import Data.Maybe (fromMaybe) 5 | import Grin.ExtendedSyntax.Pretty 6 | import qualified Data.Map.Strict as Map 7 | import qualified Data.Set as Set 8 | 9 | -- * Store 10 | 11 | -- | Store maps addresses to abstract values. 12 | newtype Store a v = Store (Map.Map a v) 13 | deriving (Eq, Ord, Show, Functor, Foldable) 14 | 15 | empty :: (Ord a) => Store a v 16 | empty = Store mempty 17 | 18 | lookup :: (Ord a) => a -> Store a v -> v 19 | lookup a (Store m) = fromMaybe (error "Store; missing") $ Map.lookup a m 20 | 21 | insert :: (Ord a) => a -> v -> Store a v -> Store a v 22 | insert a v (Store m) = Store (Map.insert a v m) 23 | 24 | modify :: (Ord a) => a -> (v -> v) -> Store a v -> Store a v 25 | modify a f (Store m) = Store (Map.adjust f a m) 26 | 27 | size :: Store a v -> Int 28 | size (Store m) = Map.size m 29 | 30 | storeKeys :: Store a v -> Set.Set a 31 | storeKeys (Store m) = Map.keysSet m 32 | 33 | instance (Ord a, Semigroup v) => Semigroup (Store a v) where 34 | (Store ma) <> (Store mb) = Store (Map.unionWith (<>) ma mb) 35 | 36 | instance (Ord a, Monoid v) => Monoid (Store a v) where 37 | mempty = Store mempty 38 | 39 | instance (Pretty a, Pretty v) => Pretty (Store a v) where 40 | pretty (Store m) = prettyKeyValue (Map.toList m) 41 | -------------------------------------------------------------------------------- /grin/src/Reducer/LLVM/InferType.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TupleSections, RecordWildCards, OverloadedStrings, TemplateHaskell #-} 2 | 3 | module Reducer.LLVM.InferType where 4 | 5 | import Text.Printf 6 | 7 | import Data.Map (Map) 8 | import qualified Data.Map as Map 9 | import Data.Vector (Vector) 10 | import qualified Data.Vector as V 11 | 12 | import Control.Monad.State 13 | import Lens.Micro.Platform 14 | 15 | import Reducer.LLVM.Base 16 | import Grin.Grin 17 | import Grin.TypeEnv hiding (typeOfVal) 18 | import Grin.Pretty 19 | 20 | -- TODO: replace this module with a more generic one that could be used by other components also 21 | 22 | -- allows simple type singletons or locations 23 | validateNodeItem :: Type -> CG () 24 | validateNodeItem ts@T_NodeSet{} = error $ printf "LLVM codegen: illegal node item type %s" (show $ pretty ts) 25 | validateNodeItem _ = pure () 26 | 27 | nodeType :: Tag -> [Type] -> CG Type 28 | nodeType tag items = do 29 | mapM_ validateNodeItem items 30 | pure $ T_NodeSet $ Map.singleton tag $ V.fromList $ map _simpleType items 31 | 32 | typeOfVal :: Val -> CG Type 33 | typeOfVal val = do 34 | case val of 35 | ConstTagNode tag args -> mapM typeOfVal args >>= nodeType tag 36 | {- 37 | VarTagNode Name [SimpleVal] -- complete node (variable tag) 38 | ValTag Tag 39 | -} 40 | Unit -> pure $ T_SimpleType T_Unit 41 | Lit lit -> pure $ typeOfLit lit 42 | Var name -> use (envTypeEnv.variable.at name) >>= \case 43 | Nothing -> error $ printf "unknown variable %s" name 44 | Just ty -> pure ty 45 | Undefined ty -> pure ty 46 | _ -> error $ printf "unsupported val %s" (show $ pretty val) 47 | -------------------------------------------------------------------------------- /grin/src/Test/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Test.Util where 3 | 4 | -- TODO: Remove this module 5 | 6 | import System.FilePath 7 | 8 | import Data.Text (Text) 9 | import qualified Data.Text.IO as T (readFile) 10 | 11 | import Grin.Grin 12 | import Grin.Parse 13 | 14 | import Test.Hspec 15 | import Test.Assertions 16 | 17 | cInt :: Tag 18 | cInt = Tag C "Int" 19 | 20 | cBool :: Tag 21 | cBool = Tag C "Bool" 22 | 23 | cWord :: Tag 24 | cWord = Tag C "Word" 25 | 26 | cBoolH :: Tag 27 | cBoolH = Tag C "BoolH" 28 | 29 | cWordH :: Tag 30 | cWordH = Tag C "WordH" 31 | 32 | cOne :: Tag 33 | cOne = Tag C "One" 34 | 35 | cTwo :: Tag 36 | cTwo = Tag C "Two" 37 | 38 | cNode :: Tag 39 | cNode = Tag C "Node" 40 | 41 | cFoo :: Tag 42 | cFoo = Tag C "Foo" 43 | 44 | cBar :: Tag 45 | cBar = Tag C "Bar" 46 | 47 | cNil :: Tag 48 | cNil = Tag C "Nil" 49 | 50 | cCons :: Tag 51 | cCons = Tag C "Cons" 52 | 53 | -- name ~ name of the test case, and also the grin source file 54 | mkBeforeAfterTestCase :: String -> 55 | FilePath -> 56 | FilePath -> 57 | (FilePath, FilePath, FilePath -> Exp -> Spec) 58 | mkBeforeAfterTestCase name beforeDir afterDir = (before, after, specFun) 59 | where before = beforeDir name <.> "grin" 60 | after = afterDir name <.> "grin" 61 | specFun after' transformed = do 62 | expected <- runIO $ T.readFile after' 63 | let expected' = parseProg expected 64 | it name $ transformed `sameAs` expected' 65 | -------------------------------------------------------------------------------- /grin/src/Transformations/BindNormalisation.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | module Transformations.BindNormalisation where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | 6 | import Grin.Grin 7 | 8 | bindNormalisation :: Exp -> Exp 9 | bindNormalisation = hylo alg coalg where 10 | alg :: ExpF Exp -> Exp 11 | alg (SBlockF e) = e 12 | alg e = embed e 13 | 14 | coalg :: Exp -> ExpF Exp 15 | coalg (EBind lhs1 pat1 rhs1) 16 | | EBind lhs2 pat2 rhs2 <- rmBlocks lhs1 17 | = SBlockF $ EBind lhs2 pat2 (EBind (SBlock rhs2) pat1 rhs1) 18 | coalg e = project e 19 | 20 | rmBlocks :: Exp -> Exp 21 | rmBlocks (SBlock e) = rmBlocks e 22 | rmBlocks e = e 23 | -------------------------------------------------------------------------------- /grin/src/Transformations/CountVariableUse.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | module Transformations.CountVariableUse where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Data.Set (Set) 6 | import Data.Map (Map) 7 | import qualified Data.Map as Map 8 | import Data.Monoid 9 | import qualified Data.Foldable 10 | 11 | import Transformations.Util 12 | 13 | import Grin.Grin 14 | 15 | 16 | countVariableUse :: Exp -> Map Name Int 17 | countVariableUse exp = appEndo (cata folder exp) mempty where 18 | folder e = Data.Foldable.fold e `mappend` foldNameUseExpF (\name -> Endo $ Map.unionWith (+) $ Map.singleton name 1) e 19 | 20 | nonlinearVariables :: Exp -> Set Name 21 | nonlinearVariables = Map.keysSet . Map.filter (>1) . countVariableUse 22 | -------------------------------------------------------------------------------- /grin/src/Transformations/ExtendedSyntax/BindNormalisation.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | module Transformations.ExtendedSyntax.BindNormalisation where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | 6 | import Grin.ExtendedSyntax.Grin 7 | 8 | bindNormalisation :: Exp -> Exp 9 | bindNormalisation = hylo alg coalg where 10 | alg :: ExpF Exp -> Exp 11 | alg (SBlockF e) = e 12 | alg e = embed e 13 | 14 | coalg :: Exp -> ExpF Exp 15 | coalg (EBind lhs1 pat1 rhs1) 16 | | EBind lhs2 pat2 rhs2 <- rmBlocks lhs1 17 | = SBlockF $ EBind lhs2 pat2 (EBind (SBlock rhs2) pat1 rhs1) 18 | coalg e = project e 19 | 20 | rmBlocks :: Exp -> Exp 21 | rmBlocks (SBlock e) = rmBlocks e 22 | rmBlocks e = e 23 | -------------------------------------------------------------------------------- /grin/src/Transformations/ExtendedSyntax/CountVariableUse.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | module Transformations.ExtendedSyntax.CountVariableUse where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Data.Set (Set) 6 | import Data.Map (Map) 7 | import qualified Data.Map as Map 8 | import Data.Monoid 9 | import qualified Data.Foldable 10 | 11 | import Transformations.ExtendedSyntax.Util 12 | 13 | import Grin.ExtendedSyntax.Grin 14 | 15 | 16 | countVariableUse :: Exp -> Map Name Int 17 | countVariableUse exp = appEndo (cata folder exp) mempty where 18 | folder e = Data.Foldable.fold e `mappend` foldNameUseExpF (\name -> Endo $ Map.unionWith (+) $ Map.singleton name 1) e 19 | 20 | nonlinearVariables :: Exp -> Set Name 21 | nonlinearVariables = Map.keysSet . Map.filter (>1) . countVariableUse 22 | -------------------------------------------------------------------------------- /grin/src/Transformations/ExtendedSyntax/MangleNames.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards, OverloadedStrings #-} 2 | module Transformations.ExtendedSyntax.MangleNames where 3 | 4 | import Text.Printf 5 | import Data.Functor.Foldable as Foldable 6 | import Data.Map (Map) 7 | import qualified Data.Map as Map 8 | 9 | import Control.Monad 10 | import Control.Monad.State 11 | 12 | import Transformations.ExtendedSyntax.Util 13 | import Transformations.ExtendedSyntax.Names 14 | 15 | import Grin.ExtendedSyntax.Grin 16 | 17 | data Env 18 | = Env 19 | { counter :: Int 20 | , nameMap :: Map Name Name 21 | } 22 | 23 | type M = State Env 24 | 25 | {- NOTE: We need two seperate traversals in order to 26 | first collect all names at definition sites, 27 | then to replace all names at use- and definition sites. 28 | -} 29 | mangleNames :: Exp -> Exp 30 | mangleNames e = evalState (collectNames >=> replaceNames $ e) (Env 0 mempty) where 31 | 32 | -- collects the names from deifinition sites 33 | collectNames :: Exp -> M Exp 34 | collectNames = anaM coalg where 35 | coalg :: Exp -> M (ExpF Exp) 36 | coalg = fmap project . mapNameDefExpM defName 37 | 38 | -- replaces names at use- and deifinition sites 39 | replaceNames :: Exp -> M Exp 40 | replaceNames = cataM alg where 41 | alg :: ExpF Exp -> M Exp 42 | alg = (mapNameUseExpM useName >=> mapNameDefExpM useName) . embed 43 | 44 | defName :: Name -> M Name 45 | defName name = state $ \env@Env{..} -> 46 | let new = "name." <> showTS counter 47 | in (name, env {counter = succ counter, nameMap = Map.insert name new nameMap}) 48 | 49 | useName :: Name -> M Name 50 | useName n = Map.findWithDefault n n <$> gets nameMap 51 | -------------------------------------------------------------------------------- /grin/src/Transformations/ExtendedSyntax/Optimising/EvaluatedCaseElimination.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TupleSections #-} 2 | module Transformations.ExtendedSyntax.Optimising.EvaluatedCaseElimination where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Grin.ExtendedSyntax.Grin 6 | 7 | evaluatedCaseElimination :: Exp -> Exp 8 | evaluatedCaseElimination = ana builder where 9 | builder :: Exp -> ExpF Exp 10 | builder = \case 11 | ECase scrut alts | all (altBodyEQ $ SReturn (Var scrut)) alts -> SReturnF (Var scrut) 12 | exp -> project exp 13 | 14 | altBodyEQ :: Exp -> Alt -> Bool 15 | altBodyEQ exp (Alt _cpat _altName body) = exp == body 16 | 17 | -------------------------------------------------------------------------------- /grin/src/Transformations/ExtendedSyntax/Optimising/TrivialCaseElimination.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TupleSections #-} 2 | module Transformations.ExtendedSyntax.Optimising.TrivialCaseElimination where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Grin.ExtendedSyntax.Grin 6 | import Transformations.ExtendedSyntax.Util 7 | 8 | trivialCaseElimination :: Exp -> Exp 9 | trivialCaseElimination = ana builder where 10 | builder :: Exp -> ExpF Exp 11 | builder = \case 12 | ECase scrut [Alt DefaultPat altName body] -> SBlockF $ EBind (SReturn (Var scrut)) (VarPat altName) body 13 | ECase scrut [Alt cpat altName body] -> SBlockF $ EBind (SReturn (Var scrut)) (cPatToAsPat altName cpat) body 14 | exp -> project exp 15 | -------------------------------------------------------------------------------- /grin/src/Transformations/MangleNames.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards, OverloadedStrings #-} 2 | module Transformations.MangleNames where 3 | 4 | import Text.Printf 5 | import Data.Functor.Foldable as Foldable 6 | import Data.Map (Map) 7 | import qualified Data.Map as Map 8 | 9 | import Control.Monad 10 | import Control.Monad.State 11 | 12 | import Transformations.Util 13 | import Transformations.Names 14 | 15 | import Grin.Grin 16 | 17 | data Env 18 | = Env 19 | { counter :: Int 20 | , nameMap :: Map Name Name 21 | } 22 | 23 | type M = State Env 24 | 25 | {- NOTE: We need two seperate traversals in order to 26 | first collect all names at definition sites, 27 | then to replace all names at use- and definition sites. 28 | -} 29 | mangleNames :: Exp -> Exp 30 | mangleNames e = evalState (collectNames >=> replaceNames $ e) (Env 0 mempty) where 31 | 32 | -- collects the names from deifinition sites 33 | collectNames :: Exp -> M Exp 34 | collectNames = anaM coalg where 35 | coalg :: Exp -> M (ExpF Exp) 36 | coalg = fmap project . mapNameDefExpM defName 37 | 38 | -- replaces names at use- and deifinition sites 39 | replaceNames :: Exp -> M Exp 40 | replaceNames = cataM alg where 41 | alg :: ExpF Exp -> M Exp 42 | alg = (mapNameUseExpM useName >=> mapNameDefExpM useName) . embed 43 | 44 | defName :: Name -> M Name 45 | defName name = state $ \env@Env{..} -> 46 | let new = "name." <> showTS counter 47 | in (name, env {counter = succ counter, nameMap = Map.insert name new nameMap}) 48 | 49 | useName :: Name -> M Name 50 | useName n = Map.findWithDefault n n <$> gets nameMap 51 | -------------------------------------------------------------------------------- /grin/src/Transformations/Optimising/ConstantFolding.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TupleSections, ViewPatterns #-} 2 | module Transformations.Optimising.ConstantFolding where 3 | 4 | import Text.Printf 5 | import Transformations.Util 6 | import Data.Functor.Foldable 7 | 8 | import Data.Map.Strict (Map) 9 | import qualified Data.Map.Strict as Map 10 | 11 | import Grin.Grin 12 | 13 | {- 14 | HINT: 15 | Constant folding is not part of the official grin optimization pipeline because it causes problems with confluency. 16 | However it could be useful for debugging purposes. 17 | 18 | IDEA: fold everything unconditionally 19 | -} 20 | 21 | type Env = (Map Name Name, Map Val Val) 22 | 23 | constantFolding :: Exp -> Exp 24 | constantFolding e = ana builder (mempty, e) where 25 | 26 | builder :: (Env, Exp) -> ExpF (Env, Exp) 27 | builder (env@(nameEnv, valEnv), exp) = let e = substVals valEnv . substVarRefExp nameEnv $ exp in case e of 28 | 29 | EBind (SReturn val) lpat rightExp -> EBindF (env, SReturn $ subst valEnv val) lpat (newEnv, rightExp) where 30 | newEnv = env `mappend` unify env val lpat 31 | 32 | _ -> (env,) <$> project e 33 | 34 | unify :: Env -> Val -> LPat -> Env 35 | unify env@(nameEnv, valEnv) (subst valEnv -> val) lpat = case (lpat, val) of 36 | (ConstTagNode lpatTag lpatArgs, ConstTagNode valTag valArgs) 37 | | lpatTag == valTag -> mconcat $ zipWith (unify env) valArgs lpatArgs 38 | (Var lpatVar, Var valVar) -> (Map.singleton lpatVar valVar, Map.singleton lpat val) -- update val + name env 39 | (Var{}, _) -> (mempty, Map.singleton lpat val) -- update val env 40 | _ -> mempty -- LPat: unit, lit, tag 41 | -------------------------------------------------------------------------------- /grin/src/Transformations/Optimising/EvaluatedCaseElimination.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TupleSections #-} 2 | module Transformations.Optimising.EvaluatedCaseElimination where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Grin.Grin 6 | 7 | evaluatedCaseElimination :: Exp -> Exp 8 | evaluatedCaseElimination = ana builder where 9 | builder :: Exp -> ExpF Exp 10 | builder = \case 11 | ECase val alts | all (altBodyEQ $ SReturn val) alts -> SReturnF val 12 | exp -> project exp 13 | 14 | altBodyEQ :: Exp -> Alt -> Bool 15 | altBodyEQ exp (Alt _cpat body) = exp == body 16 | -------------------------------------------------------------------------------- /grin/src/Transformations/Optimising/NonSharedElimination.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, RecordWildCards #-} 2 | module Transformations.Optimising.NonSharedElimination where 3 | 4 | {- 5 | Remove the updates that update only non-shared locations. 6 | -} 7 | 8 | import Data.Functor.Foldable as Foldable 9 | import Lens.Micro 10 | import Data.Maybe 11 | import qualified Data.Set as Set 12 | 13 | import Grin.Grin 14 | import Grin.TypeEnv 15 | import Transformations.Names (ExpChanges(..)) 16 | import AbstractInterpretation.Sharing.Result 17 | 18 | 19 | 20 | nonSharedElimination :: SharingResult -> TypeEnv -> Exp -> (Exp, ExpChanges) 21 | nonSharedElimination SharingResult{..} te exp = (exp', change) where 22 | 23 | exp' = cata skipUpdate exp 24 | 25 | change = if exp' /= exp then DeletedHeapOperation else NoChange 26 | 27 | -- Remove bind when the parameter points to non-shared locations only. 28 | skipUpdate :: ExpF Exp -> Exp 29 | skipUpdate = \case 30 | EBindF (SUpdate p _) _ rhs 31 | | all notShared . ptrLocations te $ p -> rhs 32 | exp -> embed exp 33 | 34 | notShared :: Loc -> Bool 35 | notShared l = not $ Set.member l _sharedLocs 36 | -------------------------------------------------------------------------------- /grin/src/Transformations/Optimising/SimpleDeadFunctionElimination.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TupleSections, OverloadedStrings #-} 2 | module Transformations.Optimising.SimpleDeadFunctionElimination where 3 | 4 | import Text.Printf 5 | import Data.Map (Map) 6 | import qualified Data.Map as Map 7 | import Data.Set (Set) 8 | import qualified Data.Set as Set 9 | import Data.Functor.Foldable as Foldable 10 | import qualified Data.Foldable 11 | import Grin.Grin 12 | 13 | simpleDeadFunctionElimination :: Program -> Program 14 | simpleDeadFunctionElimination (Program exts defs) = Program liveExts liveDefs where 15 | 16 | liveExts = [ext | ext <- exts, Set.member (eName ext) liveNames] 17 | liveDefs = [def | def@(Def name _ _) <- defs, Set.member name liveSet] 18 | 19 | liveNames = cata collectAll $ Program [] liveDefs -- collect all live names 20 | 21 | defMap :: Map Name Def 22 | defMap = Map.fromList [(name, def) | def@(Def name _ _) <- defs] 23 | 24 | lookupDef :: Name -> Maybe Def 25 | lookupDef name = Map.lookup name defMap 26 | 27 | liveSet :: Set Name 28 | liveSet = fst $ until (\(live, visited) -> live == visited) visit (Set.singleton "grinMain", mempty) 29 | 30 | visit :: (Set Name, Set Name) -> (Set Name, Set Name) 31 | visit (live, visited) = (mappend live seen, mappend visited toVisit) where 32 | toVisit = Set.difference live visited 33 | seen = foldMap (maybe mempty (cata collect) . lookupDef) toVisit 34 | 35 | collect :: ExpF (Set Name) -> Set Name 36 | collect = \case 37 | SAppF name _ | Map.member name defMap -> Set.singleton name 38 | exp -> Data.Foldable.fold exp 39 | 40 | collectAll :: ExpF (Set Name) -> Set Name 41 | collectAll = \case 42 | SAppF name args -> Set.singleton name 43 | exp -> Data.Foldable.fold exp 44 | -------------------------------------------------------------------------------- /grin/src/Transformations/Optimising/TrivialCaseElimination.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TupleSections #-} 2 | module Transformations.Optimising.TrivialCaseElimination where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Grin.Grin 6 | import Transformations.Util 7 | 8 | trivialCaseElimination :: Exp -> Exp 9 | trivialCaseElimination = ana builder where 10 | builder :: Exp -> ExpF Exp 11 | builder = \case 12 | ECase val [Alt DefaultPat body] -> SBlockF body 13 | ECase val [Alt cpat body] -> SBlockF $ EBind (SReturn val) (cpatToLPat cpat) body 14 | exp -> project exp 15 | -------------------------------------------------------------------------------- /grin/src/Transformations/Optimising/UpdateElimination.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TupleSections #-} 2 | module Transformations.Optimising.UpdateElimination where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Grin.Grin 6 | 7 | updateElimination :: Exp -> Exp 8 | updateElimination = ana builder where 9 | builder :: Exp -> ExpF Exp 10 | builder = \case 11 | EBind (SFetch fetchLoc) fetchVal 12 | (EBind (SUpdate updateLoc updateVal) Unit rightExp) 13 | | fetchLoc == updateLoc && 14 | fetchVal == updateVal 15 | -> EBindF (SFetch fetchLoc) fetchVal rightExp 16 | 17 | exp -> project exp 18 | {- 19 | QUESTION: can this be subsumed by CSE which understands fetch/store/update? 20 | ANSWER: yes, CSE subsumes update elimination 21 | 22 | TODO: delete this transformation 23 | -} 24 | -------------------------------------------------------------------------------- /grin/src/Transformations/Simplifying/BindingPatternSimplification.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, OverloadedStrings #-} 2 | 3 | module Transformations.Simplifying.BindingPatternSimplification where 4 | 5 | import Control.Monad 6 | import Data.Functor.Foldable as Foldable 7 | 8 | import Grin.Grin 9 | import Transformations.Util 10 | import Transformations.Names 11 | 12 | import Lens.Micro.Extra 13 | 14 | 15 | newNodeName :: NameM Name 16 | newNodeName = deriveNewName "p" 17 | 18 | -- NOTE: This transformation can invalidate the "no left bind" invariant, 19 | -- so we have to normalize these incorrect bindings after this transformation. 20 | bindingPatternSimplification :: Exp -> (Exp, ExpChanges) 21 | bindingPatternSimplification e = evalNameM e . cataM alg $ e where 22 | alg :: ExpF Exp -> NameM Exp 23 | alg = \case 24 | 25 | -- NOTE: <- pure 26 | -- The above pattern does not need to be simplified. 27 | EBindF lhs@(SReturn Var{}) pat rhs -> 28 | pure $ EBind lhs pat rhs 29 | 30 | -- NOTE: binding to Unit? 31 | EBindF lhs pat rhs | isn't _ValVar pat -> do 32 | newVar <- fmap Var newNodeName 33 | pure $ EBind lhs newVar (EBind (SReturn newVar) pat rhs) 34 | 35 | ECaseF scrut alts | isn't _ValVar scrut -> do 36 | newVar <- fmap Var newNodeName 37 | pure $ SBlock $ EBind (SReturn scrut) newVar (ECase newVar alts) 38 | 39 | expf -> pure . embed $ expf 40 | -------------------------------------------------------------------------------- /grin/src/Transformations/Simplifying/CaseSimplification.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TupleSections #-} 2 | module Transformations.Simplifying.CaseSimplification where 3 | 4 | import Data.List (foldl') 5 | import Data.Map (Map) 6 | import qualified Data.Map as Map 7 | import Data.Vector (Vector) 8 | import qualified Data.Vector as V 9 | 10 | import Data.Functor.Foldable as Foldable 11 | 12 | import Grin.Grin 13 | import Transformations.Util 14 | 15 | caseSimplification :: Exp -> Exp 16 | caseSimplification e = ana builder (mempty, mempty, e) where 17 | builder :: (Map Val Val, Map Name Name, Exp) -> ExpF (Map Val Val, Map Name Name, Exp) 18 | builder (valEnv, nameEnv, exp) = 19 | case exp of 20 | ECase (VarTagNode tagVar vals) alts -> ECaseF (Var $ subst nameEnv tagVar) (map (buildAlt vals) alts) 21 | -- TODO: handle const tag node 22 | e -> (valEnv, nameEnv,) <$> project (substVals valEnv . substVarRefExp nameEnv $ e) 23 | 24 | where 25 | buildAlt vals = \case 26 | Alt (NodePat tag vars) e -> (altValEnv, altNameEnv, Alt (TagPat tag) e) where 27 | (altValEnv, altNameEnv) = foldl' add (valEnv, nameEnv) (zip vars vals) 28 | add (vEnv, nEnv) (name, val) = case val of 29 | Var n -> (vEnv, Map.insert name (subst nEnv n) nEnv) -- name -> name substitution 30 | _ -> (Map.insert (Var name) (subst vEnv val) vEnv, nEnv) -- Val -> Val substitution ; i.e. Var name -> Lit 31 | alt -> (valEnv, nameEnv, alt) 32 | -------------------------------------------------------------------------------- /grin/src/Transformations/Simplifying/ProducerNameIntroduction.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts, OverloadedStrings #-} 2 | 3 | module Transformations.Simplifying.ProducerNameIntroduction where 4 | 5 | import Control.Monad 6 | import Data.Functor.Foldable as Foldable 7 | 8 | import Grin.Grin 9 | import Transformations.Names 10 | 11 | 12 | newNodeName :: NameM Name 13 | newNodeName = deriveNewName "v" 14 | 15 | {- 16 | This transformation can invalidate the "no left bind" invariant, 17 | so we have to normalize these incorrect bindings after this transformation. 18 | 19 | NOTE: Binding from SApp arguments is not necessary, 20 | because the syntax does not allow node values to be present 21 | in function application arguments. 22 | -} 23 | producerNameIntroduction :: Exp -> (Exp, ExpChanges) 24 | producerNameIntroduction e = evalNameM e . cata alg $ e where 25 | alg :: ExpF (NameM Exp) -> NameM Exp 26 | alg e = case e of 27 | SStoreF x@VarTagNode{} -> bindVal SStore x 28 | SStoreF x@ConstTagNode{} -> bindVal SStore x 29 | SStoreF x@Undefined{} -> bindVal SStore x 30 | SUpdateF p x@VarTagNode{} -> bindVal (SUpdate p) x 31 | SUpdateF p x@ConstTagNode{} -> bindVal (SUpdate p) x 32 | SUpdateF p x@Undefined{} -> bindVal (SUpdate p) x 33 | SReturnF x@VarTagNode{} -> bindVal SReturn x 34 | SReturnF x@ConstTagNode{} -> bindVal SReturn x 35 | SReturnF x@Undefined{} -> bindVal SReturn x 36 | expf -> fmap embed . sequence $ expf 37 | 38 | -- binds a Val (usually a node) to a name, then puts it into some context 39 | bindVal :: (Val -> Exp) -> Val -> NameM Exp 40 | bindVal context val = do 41 | nodeVar <- fmap Var newNodeName 42 | return $ SBlock $ EBind (SReturn val) nodeVar (context nodeVar) 43 | -------------------------------------------------------------------------------- /grin/src/Transformations/Simplifying/SplitFetch.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | module Transformations.Simplifying.SplitFetch where 3 | 4 | import Data.Functor.Foldable as Foldable 5 | import Grin.Grin 6 | 7 | splitFetch :: Exp -> Exp 8 | splitFetch = ana builder where 9 | 10 | builder :: Exp -> ExpF Exp 11 | builder = \case 12 | EBind (SFetch name) (ConstTagNode _ args) exp -> project $ newBinds name exp (zip [1..] args) 13 | EBind (SFetch name) (VarTagNode tagvar args) exp -> project $ newBinds name exp (zip [0..] $ Var tagvar : args) 14 | exp -> project exp 15 | 16 | newBinds :: Name -> Exp -> [(Int, LPat)] -> Exp 17 | newBinds name = foldr (\(idx, lpat) exp -> EBind (SFetchI name (Just idx)) lpat exp) 18 | -------------------------------------------------------------------------------- /grin/src/Transformations/UnitPropagation.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TupleSections, RecordWildCards #-} 2 | module Transformations.UnitPropagation where 3 | 4 | import Transformations.Util 5 | import Data.Functor.Foldable 6 | 7 | import Data.Map (Map) 8 | import qualified Data.Map as Map 9 | 10 | import Grin.Grin 11 | import Grin.TypeEnv 12 | 13 | 14 | unitPropagation :: TypeEnv -> Exp -> Exp 15 | unitPropagation TypeEnv{..} e = ana builder e where 16 | 17 | -- Take all the variables, and delete everything besides 18 | -- those that have Unit type. 19 | unitEnv :: Map Val Val 20 | unitEnv = Map.mapKeysMonotonic Var . flip Map.mapMaybe _variable $ 21 | \ty -> if ty == unit_t then Just Unit else Nothing 22 | 23 | -- Replace all occurences of variables with Unit type 24 | -- with the Unit value in all Vals (and only in Vals) in a given expression. 25 | builder :: Exp -> ExpF Exp 26 | builder exp = let e = substVals unitEnv $ exp in case e of 27 | 28 | EBind leftExp lpat rightExp -> EBindF leftExp (substValsVal unitEnv lpat) rightExp 29 | 30 | _ -> project e 31 | -------------------------------------------------------------------------------- /grin/src/node_support.todo: -------------------------------------------------------------------------------- 1 | done - calculate node types (node layout) 2 | done - build llvm typemap for variables 3 | done - in llvm codegen track type of values 4 | done - introduce heap pointer 5 | can be: 6 | (A) global variable, handled with atomic operations 7 | (B) passed as local parameter 8 | decision: (B) 9 | 10 | done - read inline eval 11 | done - read inline apply 12 | done - read update specialisation 13 | done - read node layout calculation 14 | done - read tag assignement 15 | done - risc codegen 16 | done - figure out how to handle the heap and the heap pointer 17 | 18 | - read llvm alias analysis documentation 19 | - read llvm gc features 20 | 21 | - read llvm language reference (multiple times) 22 | 23 | - check bedrock node representation 24 | - check ghc llvm backend node representation 25 | - check jhc node representation 26 | 27 | - study how to achieve discriminative unions in llvm (e.g. node_test_reg3.ll or node_test_reg3.ll.1) 28 | 29 | QUESTION: 30 | would llvm map a <8 x i1> vector to a byte? 31 | can i1 be 1 bit aligned? 32 | 33 | to understand in LLVM: 34 | - meta nodes; optimization and debugging related 35 | 36 | - exception handling 37 | 38 | - atomic operations 39 | 40 | 41 | node representation alternatives: 42 | - (A) mega struct that contains the data payload for all constructors 43 | - (B) call site allocated result on stack that is filled by the callee + attached aliasing information 44 | decision: (A) 45 | -------------------------------------------------------------------------------- /grin/src/todo.micro: -------------------------------------------------------------------------------- 1 | HPT + LLVM codegen 2 | 3 | LLVM types: 4 | misc: 5 | - void 6 | - function 7 | - label 8 | - metadata 9 | 10 | simple: 11 | - int 12 | - float 13 | - vector 14 | - pointer 15 | 16 | aggregate: 17 | - array 18 | - struct 19 | 20 | Node layout: 21 | done - pass in registers 22 | done - store on heap 23 | 24 | HINT: Node in Node is not supported ; only Node pointer in Node but no node value 25 | 26 | TODO: 27 | - collect tag info 28 | - update specialization 29 | done - tag (node type) to LLVM 30 | done - pass heap pointer 31 | done - return node in register 32 | done - store node on heap 33 | 34 | NODE ZOO ; documented llvm examples of: 35 | - node construction 36 | - node return 37 | 38 | STAGE 1: 39 | done - working hpt 40 | done - llvm codegen from lo grin 41 | done - working codegen for sum_simple and sum_opt without any hardcoded values or assumptions 42 | - working simplification transformations, using hpt 43 | 44 | Big tasks for MVP: 45 | - HPT IR LLVM 46 | - read back heap and return value to haskell 47 | - High level GRIN to LLVM (maybe similar to HPT IR LLVM) 48 | -------------------------------------------------------------------------------- /grin/test-data/.gitignore: -------------------------------------------------------------------------------- 1 | experimental/ 2 | -------------------------------------------------------------------------------- /grin/test-data/dead-data-elimination/length.grin: -------------------------------------------------------------------------------- 1 | grinMain = n1 <- pure (CInt 1) 2 | t1 <- store n1 3 | n2 <- pure (CInt 10000) 4 | t2 <- store n2 5 | n3 <- pure (Fupto t1 t2) 6 | t3 <- store n3 7 | n4 <- pure (Flength t3) 8 | t4 <- store n4 9 | n5 <- eval t4 10 | (CInt r') <- pure n5 11 | _prim_int_print r' 12 | 13 | upto m n = n6 <- eval m 14 | (CInt m') <- pure n6 15 | n7 <- eval n 16 | (CInt n') <- pure n7 17 | b' <- _prim_int_gt m' n' 18 | if b' then 19 | n8 <- pure (CNil) 20 | pure n8 21 | else 22 | m1' <- _prim_int_add m' 1 23 | n9 <- pure (CInt m1') 24 | m1 <- store n9 25 | n10 <- pure (Fupto m1 n) 26 | p <- store n10 27 | n11 <- pure (CCons m p) 28 | pure n11 29 | 30 | length l = l2 <- eval l 31 | case l2 of 32 | (CNil) -> n12 <- pure (CInt 0) 33 | pure n12 34 | (CCons x xs) -> n13 <- length xs 35 | (CInt l') <- pure n13 36 | len <- _prim_int_add l' 1 37 | n14 <- pure (CInt len) 38 | pure n14 39 | 40 | eval q = v <- fetch q 41 | case v of 42 | (CInt x'1) -> pure v 43 | (CNil) -> pure v 44 | (CCons y ys) -> pure v 45 | (Fupto a b) -> w <- upto a b 46 | update q w 47 | pure w 48 | (Flength c) -> z <- length c 49 | update q z 50 | pure z -------------------------------------------------------------------------------- /grin/test-data/dead-data-elimination/length2.grin: -------------------------------------------------------------------------------- 1 | grinMain = n1 <- pure (CInt 1) 2 | t1 <- store n1 3 | n2 <- pure (CInt 10000) 4 | t2 <- store n2 5 | n3 <- pure (Fupto t1 t2) 6 | t3 <- store n3 7 | n4 <- pure (Flength t3) 8 | t4 <- store n4 9 | n5 <- eval t4 10 | (CInt r') <- pure n5 11 | _prim_int_print r' 12 | 13 | upto m n = n6 <- eval m 14 | (CInt m') <- pure n6 15 | n7 <- eval n 16 | (CInt n') <- pure n7 17 | b' <- _prim_int_gt m' n' 18 | if b' then 19 | n8 <- pure (CNil) 20 | pure n8 21 | else 22 | m1' <- _prim_int_add m' 1 23 | n9 <- pure (CInt m1') 24 | m1 <- store n9 25 | n10 <- pure (Fupto m1 n) 26 | p <- store n10 27 | n11 <- pure (CCons m p) 28 | pure n11 29 | 30 | length l = l2 <- eval l 31 | case l2 of 32 | (CNil) -> n12 <- pure (CInt 0) 33 | pure n12 34 | (CCons x xs) -> n13 <- length xs 35 | (CInt l') <- pure n13 36 | len <- _prim_int_add l' 1 37 | n14 <- pure (CInt len) 38 | pure n14 39 | 40 | eval q = v <- fetch q 41 | case v of 42 | (CInt x'1) -> pure v 43 | (CNil) -> pure v 44 | (CCons y ys) -> pure v 45 | (Fupto a b) -> w <- upto a b 46 | update q w 47 | pure w 48 | (Flength c) -> z <- length c 49 | update q z 50 | pure z -------------------------------------------------------------------------------- /grin/test-data/dead-data-elimination/pnode.grin.expected: -------------------------------------------------------------------------------- 1 | grinMain = 2 | a0 <- pure (CInt 5) 3 | a1 <- pure (CInt 5) 4 | a2 <- pure (CInt 5) 5 | p0 <- store a0 6 | p1 <- store a1 7 | p2 <- store a2 8 | 9 | foo3 <- pure (P3foo) 10 | pfoo3 <- store foo3 11 | 12 | foo3ap <- pure (Fap pfoo3 p0) 13 | pfoo3ap <- store foo3ap 14 | foo2 <- eval pfoo3ap 15 | pfoo2 <- store foo2 16 | 17 | foo2ap <- pure (Fap pfoo2 p1) 18 | pfoo2ap <- store foo2ap 19 | foo1 <- eval pfoo2ap 20 | pfoo1 <- store foo1 21 | 22 | foo1ap <- pure (Fap pfoo1 p2) 23 | pfoo1ap <- store foo1ap 24 | fooRet <- eval pfoo1ap 25 | 26 | pure fooRet 27 | 28 | 29 | foo x0 y0 z0 = 30 | y0' <- eval y0 31 | pure y0' 32 | 33 | -- apply always gets the function node in whnf 34 | apply pf cur = 35 | case pf of 36 | (P3foo) -> 37 | n0 <- pure (P2foo cur) 38 | pure n0 39 | (P2foo v0) -> 40 | n1 <- pure (P1foo v0 cur) 41 | pure n1 42 | (P1foo v1 v2) -> 43 | n2 <- foo v1 v2 cur 44 | pure n2 45 | 46 | ap f x = 47 | f' <- eval f 48 | apply f' x 49 | 50 | eval p = 51 | v <- fetch p 52 | case v of 53 | (CInt n) -> pure v 54 | 55 | (P3foo) -> pure v 56 | (P2foo v3) -> pure v 57 | (P1foo v4 v5) -> pure v 58 | 59 | (Ffoo.0) -> 60 | b2 <- pure (#undefined :: T_Dead) 61 | b1 <- pure (#undefined :: T_Dead) 62 | b0 <- pure (#undefined :: T_Dead) 63 | w0 <- foo b0 b1 b2 64 | update p w0 65 | pure w0 66 | (Fapply.0) -> 67 | y <- pure (#undefined :: T_Dead) 68 | g <- pure (#undefined :: T_Dead) 69 | w1 <- apply g y 70 | update p w1 71 | pure w1 72 | (Fap h z) -> 73 | w2 <- ap h z 74 | update p w2 75 | pure w2 76 | -------------------------------------------------------------------------------- /grin/test-data/dead-parameter-elimination/pnode.grin.expected: -------------------------------------------------------------------------------- 1 | 2 | grinMain = 3 | a0 <- pure (CInt 5) 4 | a1 <- pure (CInt 5) 5 | a2 <- pure (CInt 5) 6 | p0 <- store a0 7 | p1 <- store a1 8 | p2 <- store a2 9 | foo3 <- pure (P3foo) 10 | pfoo3 <- store foo3 11 | foo3ap <- pure (Fap pfoo3 p0) 12 | pfoo3ap <- store foo3ap 13 | foo2 <- eval $ pfoo3ap 14 | pfoo2 <- store foo2 15 | foo2ap <- pure (Fap pfoo2 p1) 16 | pfoo2ap <- store foo2ap 17 | foo1 <- eval $ pfoo2ap 18 | pfoo1 <- store foo1 19 | foo1ap <- pure (Fap pfoo1 p2) 20 | pfoo1ap <- store foo1ap 21 | fooRet <- eval $ pfoo1ap 22 | pure fooRet 23 | 24 | foo y0 = 25 | z0 <- pure (#undefined :: #ptr) 26 | x0 <- pure (#undefined :: #ptr) 27 | y0' <- eval $ y0 28 | pure y0' 29 | 30 | apply pf cur = 31 | case pf of 32 | (P3foo) -> 33 | n0 <- pure (P2foo cur) 34 | pure n0 35 | (P2foo v0) -> 36 | n1 <- pure (P1foo v0 cur) 37 | pure n1 38 | (P1foo v1 v2) -> 39 | n2 <- foo $ v2 40 | pure n2 41 | 42 | ap f x = 43 | f' <- eval $ f 44 | apply $ f' x 45 | 46 | eval p = 47 | v <- fetch p 48 | case v of 49 | (CInt n) -> 50 | pure v 51 | (P3foo) -> 52 | pure v 53 | (P2foo v3) -> 54 | pure v 55 | (P1foo v4 v5) -> 56 | pure v 57 | (Ffoo b0 b1 b2) -> 58 | w0 <- foo $ b1 59 | update p w0 60 | pure w0 61 | (Fapply g y) -> 62 | w1 <- apply $ g y 63 | update p w1 64 | pure w1 65 | (Fap h z) -> 66 | w2 <- ap $ h z 67 | update p w2 68 | pure w2 69 | -------------------------------------------------------------------------------- /grin/test-data/dead-parameter-elimination/pnode.grin.opts: -------------------------------------------------------------------------------- 1 | outputExtension: "out" 2 | grinOptions: 3 | - "--quiet" 4 | - "--dpe" 5 | - "--save-grin=$$$OUT$$$" 6 | -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c01/01/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- 1 |   2 |    Hello World! 3 |       _prim_string_printidris_write_stridris_write_str1idris_write_str2GrStringidris_write_str2_0Unitv.0grinMain idr_{runMain_0} 4 | r idr_Main.main idr_Main.main0 v.1idr_Main.main1_val_3idr_Main.main1idr_Main.main1_validr_Main.main1_4 5 | idr_MkUnitv.2 idr_{EVAL_0} idr_{EVAL_0}0idr_{EVAL_0}0_valErasedv.3idr_{runMain_0}0_val_5idr_{runMain_0}0idr_{runMain_0}0_validr_{runMain_0}0_6 -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c02/01/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c02/01/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c02/03/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c02/03/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c02/04/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c02/04/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c03/01/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c03/01/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c06/01/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c06/01/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c07/01/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c07/01/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c07/02/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c07/02/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c07/03/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c07/03/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c08/01/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c08/01/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c08/02/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c08/02/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c09/01/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c09/01/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c10/01/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c10/01/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c10/02/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c10/02/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c10/03/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c10/03/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c10/04/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c10/04/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c11/02/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c11/02/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c11/04/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c11/04/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c11/05/004.CopyPropagation.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c11/05/004.CopyPropagation.binary -------------------------------------------------------------------------------- /grin/test-data/idris-grin/c11/09/004.TrivialCaseElimination.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/grin/test-data/idris-grin/c11/09/004.TrivialCaseElimination.binary -------------------------------------------------------------------------------- /grin/test-data/sum-simple/sum_simple_exp.grin: -------------------------------------------------------------------------------- 1 | grinMain = t1 <- store (CInt 1) 2 | t2 <- store (CInt 10000) 3 | t3 <- store (Fupto t1 t2) 4 | t4 <- store (Fsum t3) 5 | (CInt r') <- eval t4 6 | _prim_int_print r' 7 | 8 | upto m n = (CInt m') <- eval m 9 | (CInt n') <- eval n 10 | b' <- _prim_int_gt m' n' 11 | if b' then 12 | pure (CNil) 13 | else 14 | m1' <- _prim_int_add m' 1 15 | m1 <- store (CInt m1') 16 | p <- store (Fupto m1 n) 17 | pure (CCons m p) 18 | 19 | sum l = l2 <- eval l 20 | case l2 of 21 | (CNil) -> pure (CInt 0) 22 | (CCons x xs) -> (CInt x') <- eval x 23 | (CInt s') <- sum xs 24 | ax' <- _prim_int_add x' s' 25 | pure (CInt ax') 26 | 27 | eval q = v <- fetch q 28 | case v of 29 | (CInt x'1) -> pure (CInt x'1) 30 | (CNil) -> pure (CNil) 31 | (CCons y ys) -> pure (CCons y ys) 32 | (Fupto a b) -> w <- upto a b 33 | update q w 34 | pure w 35 | (Fsum c) -> z <- sum c 36 | update q z 37 | pure z 38 | -------------------------------------------------------------------------------- /grin/test-data/sum-simple/sum_simple_exp.grin.expected: -------------------------------------------------------------------------------- 1 | .text 2 | .file "" 3 | .globl grinMain # -- Begin function grinMain 4 | .p2align 4, 0x90 5 | .type grinMain,@function 6 | grinMain: # @grinMain 7 | .cfi_startproc 8 | # %bb.0: # %grinMain.entry 9 | movl $50005000, %edi # imm = 0x2FB0408 10 | jmp _prim_int_print # TAILCALL 11 | .Lfunc_end0: 12 | .size grinMain, .Lfunc_end0-grinMain 13 | .cfi_endproc 14 | # -- End function 15 | .type _heap_ptr_,@object # @_heap_ptr_ 16 | .bss 17 | .globl _heap_ptr_ 18 | .p2align 3 19 | _heap_ptr_: 20 | .quad 0 # 0x0 21 | .size _heap_ptr_, 8 22 | 23 | 24 | .section ".note.GNU-stack","",@progbits 25 | -------------------------------------------------------------------------------- /grin/test-data/sum-simple/sum_simple_exp.grin.opts: -------------------------------------------------------------------------------- 1 | outputExtension: "out.s" 2 | grinOptions: 3 | - "--optimize" 4 | - "--hpt" 5 | - "--quiet" 6 | - "--save-llvm=$$$OUT$$$" 7 | -------------------------------------------------------------------------------- /grin/test-runtime/runtime.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | /* 6 | TODO: Add statistics. 7 | */ 8 | 9 | extern int64_t _heap_ptr_; 10 | int64_t grinMain(); 11 | 12 | void __runtime_error(int64_t c){ 13 | exit(c); 14 | } 15 | 16 | int main() { 17 | int64_t* heap = malloc(100*1024*1024); 18 | _heap_ptr_ = (int64_t)heap; 19 | grinMain(); 20 | free(heap); 21 | return 0; 22 | } 23 | -------------------------------------------------------------------------------- /grin/test/EndToEnd.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Test.Hspec (hspec) 4 | import Test.EndToEnd (endToEnd) 5 | 6 | 7 | main :: IO () 8 | main = hspec $ endToEnd "./test-data/" 9 | -------------------------------------------------------------------------------- /grin/test/ExtendedSyntax/NametableSpec.hs: -------------------------------------------------------------------------------- 1 | module ExtendedSyntax.NametableSpec where 2 | 3 | import Test.Hspec 4 | import Test.QuickCheck 5 | import Test.QuickCheck.Monadic 6 | 7 | import Test.ExtendedSyntax.Old.Test 8 | import Grin.ExtendedSyntax.Nametable 9 | import Grin.ExtendedSyntax.Pretty 10 | import Transformations.ExtendedSyntax.Conversion (convertToNew) 11 | 12 | 13 | runTests :: IO () 14 | runTests = hspec spec 15 | 16 | spec :: Spec 17 | spec = do 18 | describe "Property" $ do 19 | it "restore . convert == id" $ property $ 20 | forAll (convertToNew <$> genProg) $ \p -> 21 | let p' = restore $ convert p 22 | in (PP p') `shouldBe` (PP p) 23 | -------------------------------------------------------------------------------- /grin/test/NametableSpec.hs: -------------------------------------------------------------------------------- 1 | module NametableSpec where 2 | 3 | import Test.Hspec 4 | import Test.QuickCheck 5 | import Test.QuickCheck.Monadic 6 | import Test.Test 7 | import Grin.Nametable 8 | import Grin.Pretty 9 | 10 | 11 | runTests :: IO () 12 | runTests = hspec spec 13 | 14 | spec :: Spec 15 | spec = do 16 | describe "Property" $ do 17 | it "restore . convert == id" $ property $ 18 | forAll genProg $ \p -> 19 | let p' = restore $ convert p 20 | in (PP p') `shouldBe` (PP p) 21 | -------------------------------------------------------------------------------- /grin/test/Spec.hs: -------------------------------------------------------------------------------- 1 | -- file test/Spec.hs 2 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 3 | -------------------------------------------------------------------------------- /grin/test/Test/EndToEndSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving, OverloadedStrings #-} 2 | module Test.EndToEndSpec where 3 | 4 | import Control.Monad.Reader 5 | import Test.Hspec 6 | import Test.EndToEnd 7 | import Test.QuickCheck hiding (Failure) 8 | import Data.ByteString.Char8 9 | import Test.Hspec.Core.Spec hiding (pending) 10 | import Data.Map as Map 11 | 12 | 13 | main :: IO () 14 | main = hspec spec 15 | 16 | spec :: Spec 17 | spec = do 18 | it "Finds failing element in the middle." $ property $ 19 | -- Assumption: Min passes, Mid, Max fails, min < mid, mid <= max 20 | forAll (choose (0,100)) $ \mn -> 21 | forAll (choose (mn+1, mn+101)) $ \mx -> 22 | forAll (choose (mn+1, mx)) $ \md -> do 23 | let res = testBisectM (mn,md,mx) $ bisect "some-dir" "some-result" 24 | show res `shouldBe` (show $ Result "" $ Failure Nothing $ Reason $ "Test failed in pipeline step: " ++ show md) 25 | 26 | newtype TestBisectM a = TBM (Reader (Int, Int, Int) a) 27 | deriving (Functor, Applicative, Monad, MonadReader (Int, Int, Int)) 28 | 29 | testBisectM :: (Int, Int, Int) -> TestBisectM a -> a 30 | testBisectM e (TBM m) = runReader m e 31 | 32 | instance BisectM TestBisectM where 33 | createFileMap _ = asks (\(mn,_,mx) -> Map.fromList [ (n, show n) | n <- [mn..mx] ]) 34 | runTest n _ = asks (\(_,md,_) -> read n < md) 35 | -------------------------------------------------------------------------------- /grin/test/TestSpec.hs: -------------------------------------------------------------------------------- 1 | module TestSpec where 2 | 3 | import Test.ExtendedSyntax.Old.Test 4 | import Test.Hspec 5 | import Test.QuickCheck 6 | import Test.QuickCheck.Monadic 7 | import Control.DeepSeq 8 | import Test.Check 9 | 10 | import Data.List (nub) 11 | import qualified Data.Set as Set 12 | 13 | 14 | runTests :: IO () 15 | runTests = hspec spec 16 | 17 | uniqueValues :: (Eq a) => [a] -> Property 18 | uniqueValues xs = property $ length (nub xs) == length xs 19 | 20 | spec :: Spec 21 | spec = do 22 | it "newNames generate unique names" $ property $ 23 | forAll 24 | (do n <- choose (40, 50) 25 | runGoalUnsafe $ newNames n) 26 | uniqueValues 27 | 28 | it "withGADTs generate unique tags as constructors" $ do 29 | pendingWith "commented out due type error" 30 | {- 31 | property $ forAll 32 | (do n <- abs <$> arbitrary 33 | runGoalUnsafe $ withADTs n getADTs) 34 | (uniqueValues . concatMap tagNames . Set.toList) 35 | -} 36 | 37 | it "genProg does not generate big programs" $ property $ 38 | forAll genProg $ \p -> label (show $ programSize p) $ 39 | monadicIO $ do 40 | () <- pure $ rnf p 41 | pure () 42 | -------------------------------------------------------------------------------- /grin/test/Transformations/ExtendedSyntax/ConversionSpec.hs: -------------------------------------------------------------------------------- 1 | module Transformations.ExtendedSyntax.ConversionSpec where 2 | 3 | import Control.DeepSeq 4 | 5 | import Grin.Grin 6 | import Grin.Syntax (Exp) 7 | import qualified Grin.ExtendedSyntax.Syntax as New (Exp) 8 | import Transformations.ExtendedSyntax.Conversion 9 | 10 | import Test.Hspec 11 | import Test.QuickCheck 12 | import Test.Hspec.QuickCheck 13 | 14 | import Test.Assertions 15 | import Test.ExtendedSyntax.Old.Test (SemanticallyCorrectProgram(..)) 16 | 17 | runTests :: IO () 18 | runTests = hspec spec 19 | 20 | spec :: Spec 21 | spec = describe "Syntax transformation QuickCheck tests" $ do 22 | prop "Old is always convertible to New" $ 23 | convertibleToNew 24 | prop "Old is always convertible to New then back to Old" $ 25 | roundtripConvertibleOld 26 | 27 | -- NOTE: The conversion itself is the proof that it is convertible 28 | -- QUESTION: There must be a better way to do this 29 | -- ANSWER: The conversion function could an Either 30 | convertibleToNew :: SemanticallyCorrectProgram -> Bool 31 | convertibleToNew exp = force (convertToNew $ correctProg exp) `seq` True 32 | 33 | roundtripConvertibleOld :: SemanticallyCorrectProgram -> Bool 34 | roundtripConvertibleOld exp = force (convertToOld $ convertToNew $ correctProg exp) `seq` True where 35 | 36 | convertToOld :: New.Exp -> Exp 37 | convertToOld = convert 38 | -------------------------------------------------------------------------------- /grin/test/Transformations/ExtendedSyntax/Optimising/EvaluatedCaseEliminationSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns #-} 2 | module Transformations.ExtendedSyntax.Optimising.EvaluatedCaseEliminationSpec where 3 | 4 | import Transformations.ExtendedSyntax.Optimising.EvaluatedCaseElimination 5 | 6 | import Test.Hspec 7 | import Grin.ExtendedSyntax.TH 8 | import Test.ExtendedSyntax.New.Test hiding (newVar) 9 | import Test.ExtendedSyntax.Assertions 10 | 11 | 12 | runTests :: IO () 13 | runTests = hspec spec 14 | 15 | spec :: Spec 16 | spec = do 17 | testExprContextE $ \ctx -> do 18 | it "Figure 4.22" $ do 19 | let before = [expr| 20 | case v of 21 | (CLeft l) @ alt1 -> pure v 22 | (CRight r) @ alt2 -> pure v 23 | |] 24 | let after = [expr| 25 | pure v 26 | |] 27 | evaluatedCaseElimination (ctx before) `sameAs` (ctx after) 28 | 29 | it "default case" $ do 30 | let before = [expr| 31 | case v of 32 | (CLeft l) @ alt1 -> pure v 33 | #default @ alt2 -> pure v 34 | |] 35 | let after = [expr| 36 | pure v 37 | |] 38 | evaluatedCaseElimination (ctx before) `sameAs` (ctx after) 39 | -------------------------------------------------------------------------------- /grin/test/Transformations/ExtendedSyntax/Optimising/TrivialCaseEliminationSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns #-} 2 | module Transformations.ExtendedSyntax.Optimising.TrivialCaseEliminationSpec where 3 | 4 | import Transformations.ExtendedSyntax.Optimising.TrivialCaseElimination 5 | 6 | import Test.Hspec 7 | import Grin.ExtendedSyntax.TH 8 | import Test.ExtendedSyntax.New.Test hiding (newVar) 9 | import Test.ExtendedSyntax.Assertions 10 | 11 | 12 | runTests :: IO () 13 | runTests = hspec spec 14 | 15 | spec :: Spec 16 | spec = do 17 | testExprContextE $ \ctx -> do 18 | it "Figure 4.24" $ do 19 | let before = [expr| 20 | case v of 21 | (Ffun a1 a2 a3) @ alt1 -> fun a1 a2 a3 22 | |] 23 | let after = [expr| 24 | do 25 | (Ffun a1 a2 a3) @ alt1 <- pure v 26 | fun a1 a2 a3 27 | |] 28 | trivialCaseElimination (ctx before) `sameAs` (ctx after) 29 | 30 | it "bypass" $ do 31 | let before = [expr| 32 | case v of 33 | (Ffun1 a1 a2 a3) @ alt1 -> fun1 a1 a2 a3 34 | #default @ alt2 -> pure 2 35 | |] 36 | let after = [expr| 37 | case v of 38 | (Ffun1 a1 a2 a3) @ alt1 -> fun1 a1 a2 a3 39 | #default @ alt2 -> pure 2 40 | |] 41 | trivialCaseElimination (ctx before) `sameAs` (ctx after) 42 | 43 | it "default alternative" $ do 44 | let before = [expr| 45 | case v of 46 | #default @ alt1 -> pure 2 47 | |] 48 | let after = [expr| 49 | do 50 | alt1 <- pure v 51 | pure 2 52 | |] 53 | trivialCaseElimination (ctx before) `sameAs` (ctx after) 54 | -------------------------------------------------------------------------------- /grin/test/Transformations/MangleNamesSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, QuasiQuotes #-} 2 | module Transformations.MangleNamesSpec where 3 | 4 | import Transformations.MangleNames 5 | 6 | import Test.Test 7 | import Grin.TH 8 | import Test.Hspec 9 | import Test.Assertions 10 | 11 | 12 | runTests :: IO () 13 | runTests = hspec spec 14 | 15 | spec :: Spec 16 | spec = do 17 | it "simple" $ do 18 | let before = [prog| 19 | f x y = 20 | z <- pure x 21 | w <- pure y 22 | u <- pure (CNode x y z w) 23 | pure u 24 | |] 25 | let after = [prog| 26 | name.0 name.1 name.2 = 27 | name.3 <- pure name.1 28 | name.4 <- pure name.2 29 | name.5 <- pure (CNode name.1 name.2 name.3 name.4) 30 | pure name.5 31 | |] 32 | (mangleNames before) `sameAs` after 33 | 34 | it "case" $ do 35 | let before = [prog| 36 | f x = 37 | n <- pure 5 38 | case x of 39 | (COne a) -> pure a 40 | (CTwo b) -> pure b 41 | #default -> pure n 42 | |] 43 | let after = [prog| 44 | name.0 name.1 = 45 | name.2 <- pure 5 46 | case name.1 of 47 | (COne name.3) -> pure name.3 48 | (CTwo name.4) -> pure name.4 49 | #default -> pure name.2 50 | |] 51 | (mangleNames before) `sameAs` after 52 | 53 | it "mutually_recursive" $ do 54 | let before = [prog| 55 | f x = g x 56 | g y = f y 57 | |] 58 | let after = [prog| 59 | name.0 name.1 = name.2 name.1 60 | name.2 name.3 = name.0 name.3 61 | |] 62 | (mangleNames before) `sameAs` after 63 | -------------------------------------------------------------------------------- /grin/test/Transformations/Optimising/EvaluatedCaseEliminationSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns #-} 2 | module Transformations.Optimising.EvaluatedCaseEliminationSpec where 3 | 4 | import Transformations.Optimising.EvaluatedCaseElimination 5 | 6 | import Test.Hspec 7 | import Grin.TH 8 | import Test.Test hiding (newVar) 9 | import Test.Assertions 10 | 11 | 12 | runTests :: IO () 13 | runTests = hspec spec 14 | 15 | spec :: Spec 16 | spec = do 17 | testExprContextE $ \ctx -> do 18 | it "Figure 4.22" $ do 19 | let before = [expr| 20 | case v of 21 | (CLeft l) -> pure v 22 | (CRight r) -> pure v 23 | |] 24 | let after = [expr| 25 | pure v 26 | |] 27 | evaluatedCaseElimination (ctx before) `sameAs` (ctx after) 28 | 29 | it "default case" $ do 30 | let before = [expr| 31 | case v of 32 | (CLeft l) -> pure v 33 | #default -> pure v 34 | |] 35 | let after = [expr| 36 | pure v 37 | |] 38 | evaluatedCaseElimination (ctx before) `sameAs` (ctx after) 39 | -------------------------------------------------------------------------------- /grin/test/Transformations/Optimising/InliningSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns #-} 2 | module Transformations.Optimising.InliningSpec where 3 | 4 | import Transformations.Optimising.Inlining 5 | import Transformations.Names (ExpChanges(..)) 6 | 7 | import qualified Data.Set as Set 8 | import Test.Hspec 9 | import Grin.TH 10 | import Test.Test hiding (newVar) 11 | import Test.Assertions 12 | import Grin.TypeCheck 13 | 14 | 15 | runTests :: IO () 16 | runTests = hspec spec 17 | 18 | spec :: Spec 19 | spec = do 20 | it "base case" $ do 21 | let before = [prog| 22 | grinMain = 23 | x <- funA 22 24 | y <- funA 55 25 | pure x 26 | 27 | funA i = pure i 28 | |] 29 | let after = [prog| 30 | grinMain = 31 | x <- do 32 | i.0 <- pure 22 33 | pure i.0 34 | y <- do 35 | i.1 <- pure 55 36 | pure i.1 37 | pure x 38 | 39 | funA i = pure i 40 | |] 41 | let inlineSet = Set.fromList ["funA"] 42 | inlining inlineSet (inferTypeEnv before) before `sameAs` (after, NewNames) 43 | 44 | it "no-inline grinMain" $ do 45 | let before = [prog| 46 | grinMain = 47 | x <- pure 22 48 | pure x 49 | |] 50 | let after = [prog| 51 | grinMain = 52 | x <- pure 22 53 | pure x 54 | |] 55 | lateInlining (inferTypeEnv before) before `sameAs` (after, NoChange) 56 | -------------------------------------------------------------------------------- /grin/test/Transformations/Optimising/TrivialCaseEliminationSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns #-} 2 | module Transformations.Optimising.TrivialCaseEliminationSpec where 3 | 4 | import Transformations.Optimising.TrivialCaseElimination 5 | 6 | import Test.Hspec 7 | import Grin.TH 8 | import Test.Test hiding (newVar) 9 | import Test.Assertions 10 | 11 | 12 | runTests :: IO () 13 | runTests = hspec spec 14 | 15 | spec :: Spec 16 | spec = do 17 | testExprContextE $ \ctx -> do 18 | it "Figure 4.24" $ do 19 | let before = [expr| 20 | case v of 21 | (Ffun a1 a2 a3) -> fun a1 a2 a3 22 | |] 23 | let after = [expr| 24 | do 25 | (Ffun a1 a2 a3) <- pure v 26 | fun a1 a2 a3 27 | |] 28 | trivialCaseElimination (ctx before) `sameAs` (ctx after) 29 | 30 | it "bypass" $ do 31 | let before = [expr| 32 | case v of 33 | (Ffun1 a1 a2 a3) -> fun1 a1 a2 a3 34 | #default -> pure 2 35 | |] 36 | let after = [expr| 37 | case v of 38 | (Ffun1 a1 a2 a3) -> fun1 a1 a2 a3 39 | #default -> pure 2 40 | |] 41 | trivialCaseElimination (ctx before) `sameAs` (ctx after) 42 | 43 | it "default alternative" $ do 44 | let before = [expr| 45 | case v of 46 | #default -> pure 2 47 | |] 48 | let after = [expr| 49 | do 50 | pure 2 51 | |] 52 | trivialCaseElimination (ctx before) `sameAs` (ctx after) 53 | -------------------------------------------------------------------------------- /grin/test/Transformations/Optimising/UpdateEliminationSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns #-} 2 | module Transformations.Optimising.UpdateEliminationSpec where 3 | 4 | import Transformations.Optimising.UpdateElimination 5 | 6 | import Test.Hspec 7 | import Grin.TH 8 | import Test.Test hiding (newVar) 9 | import Test.Assertions 10 | 11 | 12 | runTests :: IO () 13 | runTests = hspec spec 14 | 15 | spec :: Spec 16 | spec = do 17 | testExprContextE $ \ctx -> do 18 | it "Figure 4.27" $ do 19 | let before = [expr| 20 | v <- fetch p 21 | update p v 22 | pure 1 23 | |] 24 | let after = [expr| 25 | v <- fetch p 26 | pure 1 27 | |] 28 | updateElimination (ctx before) `sameAs` (ctx after) 29 | -------------------------------------------------------------------------------- /grin/test/Transformations/StaticSingleAssignmentSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, QuasiQuotes #-} 2 | module Transformations.StaticSingleAssignmentSpec where 3 | 4 | import Transformations.StaticSingleAssignment 5 | 6 | import Test.Test 7 | import Grin.TH 8 | import Test.Hspec 9 | import Test.Assertions 10 | 11 | 12 | runTests :: IO () 13 | runTests = hspec spec 14 | 15 | spec :: Spec 16 | spec = do 17 | it "works" $ do 18 | let before = [prog| 19 | fun1 p1 p2 = 20 | p3 <- do 21 | p3 <- do 22 | p3 <- prim_int_add 1 2 23 | prim_int_add p3 2 24 | p3 <- do 25 | p3 <- prim_int_add 1 2 26 | prim_int_add p3 2 27 | prim_int_add p3 3 28 | prim_int_add p3 4 29 | |] 30 | let after = [prog| 31 | fun1 p1 p2 = 32 | p3 <- do 33 | p3_1 <- do 34 | p3_2 <- prim_int_add 1 2 35 | prim_int_add p3_2 2 36 | p3_3 <- do 37 | p3_4 <- prim_int_add 1 2 38 | prim_int_add p3_4 2 39 | prim_int_add p3_3 3 40 | prim_int_add p3 4 41 | |] 42 | (staticSingleAssignment before) `sameAs` after 43 | 44 | it "node" $ do 45 | let before = [prog| 46 | fun1 a = 47 | (CInt i) <- pure a 48 | pure i 49 | fun2 a = 50 | (CInt i) <- pure a 51 | pure i 52 | |] 53 | let after = [prog| 54 | fun1 a = 55 | (CInt i) <- pure a 56 | pure i 57 | fun2 a_1 = 58 | (CInt i_2) <- pure a_1 59 | pure i_2 60 | |] 61 | (staticSingleAssignment before) `sameAs` after 62 | -------------------------------------------------------------------------------- /images/arity-raising.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/arity-raising.png -------------------------------------------------------------------------------- /images/case-copy-propagation.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/case-copy-propagation.png -------------------------------------------------------------------------------- /images/case-hoisting.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/case-hoisting.png -------------------------------------------------------------------------------- /images/case-simplification.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/case-simplification.png -------------------------------------------------------------------------------- /images/common-sub-expression-elimination-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/common-sub-expression-elimination-1.png -------------------------------------------------------------------------------- /images/common-sub-expression-elimination-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/common-sub-expression-elimination-2.png -------------------------------------------------------------------------------- /images/copy-propagation-left.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/copy-propagation-left.png -------------------------------------------------------------------------------- /images/copy-propagation-right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/copy-propagation-right.png -------------------------------------------------------------------------------- /images/evaluated-case-elimination.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/evaluated-case-elimination.png -------------------------------------------------------------------------------- /images/generalised-unboxing.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/generalised-unboxing.png -------------------------------------------------------------------------------- /images/grin-syntax.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/grin-syntax.png -------------------------------------------------------------------------------- /images/late-inlining.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/late-inlining.png -------------------------------------------------------------------------------- /images/register-introduction.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/register-introduction.png -------------------------------------------------------------------------------- /images/right-hoist-fetch.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/right-hoist-fetch.png -------------------------------------------------------------------------------- /images/sparse-case-optimisation.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/sparse-case-optimisation.png -------------------------------------------------------------------------------- /images/split-fetch-operation.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/split-fetch-operation.png -------------------------------------------------------------------------------- /images/trivial-case-elimination.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/trivial-case-elimination.png -------------------------------------------------------------------------------- /images/unboxing-of-function-return-values.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/unboxing-of-function-return-values.png -------------------------------------------------------------------------------- /images/update-elimination.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/update-elimination.png -------------------------------------------------------------------------------- /images/vectorisation.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/vectorisation.png -------------------------------------------------------------------------------- /images/whnf-update-elimination.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/images/whnf-update-elimination.png -------------------------------------------------------------------------------- /nix/haskell.nix: -------------------------------------------------------------------------------- 1 | let 2 | sources = import ./sources.nix {}; 3 | haskellNix = import sources.haskellNix {}; 4 | llvm-overlay = self: super: { 5 | llvm-config = self.llvm_7; 6 | }; 7 | extra-overlays = [ llvm-overlay ]; 8 | pkgs = import 9 | haskellNix.sources.nixpkgs-2009 10 | # These arguments passed to nixpkgs, include some patches and also 11 | # the haskell.nix functionality itself as an overlay. 12 | (haskellNix.nixpkgsArgs // { overlays = haskellNix.nixpkgsArgs.overlays ++ extra-overlays; }); 13 | in 14 | pkgs 15 | -------------------------------------------------------------------------------- /notes/created-by.todo: -------------------------------------------------------------------------------- 1 | created by analysis: 2 | - preconditions: - run after node naming 3 | - run before case simplification (currently run before all simplyfing transformations - except node naming) 4 | - run before any dead code elimination 5 | - producer id <=> id of the register the value was produced into 6 | - maintain a register id -> variable name mapping (so that producer names can be looked up after reduction) 7 | - reinterpret "NodeSet" : map Tags to singleton Vector (Set Int32)s 8 | - each node will have its producer info stored in its first field 9 | - repr: Word32 reg <--> Int32 producer, could this be a problem? 10 | - EBindF: 11 | leftExp was Val: 12 | introduce a new producer with the name of variable inside the binding 13 | (make sure lpat can only be a variable name) IMPORTANT!!! 14 | general case: same 15 | 16 | TESTS: 17 | - write tests for nodeNaming 18 | 19 | questions: 20 | - Does codeGenVal fail after register introduction? (and on ValTags as well) 21 | - define ValTag case: CNodeItem tag 0 _ (the 0th item of a node is its tag, its type is "tag" - does not really matter) 22 | - define VarTag case: - use current number of arguments as arity? 23 | - 24 | - Can case alternatives have differently typed return values? (Lit <-> Node) 25 | - can a tag be applied to different number of arguments? 26 | - completely define Extend interpretation 27 | - We need tag information (arity) during the analysis to define codeGenVal for 28 | -------------------------------------------------------------------------------- /notes/debug_tooling: -------------------------------------------------------------------------------- 1 | idea: 2 | The runtime system collects data on demand. 3 | The user can specify the focus of inspection via a query language. 4 | 5 | The raw data is fed to the UI tool. 6 | e.g. grafana or custom implementation 7 | 8 | debug trap triggers: 9 | - function call 10 | - release of specific resource or node 11 | 12 | debug and profiling queries: 13 | - control flow traces 14 | 15 | visualize: 16 | - hot spots of cfg 17 | - longest reference chain 18 | - longest thunk 19 | - memory usage 20 | - open resources 21 | - longest reference loop 22 | 23 | summary: 24 | collectable data X query language X visualization 25 | many - connection - many 26 | 27 | 28 | prototype: 29 | - visualize grin reference graph, with strict and lazy distinction 30 | 31 | query language? 32 | graphql? 33 | purescript? 34 | gluon? 35 | haskell? 36 | 37 | ideal query language: 38 | typed + inference 39 | code completion (type based) 40 | very simple 41 | 42 | approach: 43 | iterative, agile, free 44 | -------------------------------------------------------------------------------- /notes/dynamic-grin.plan: -------------------------------------------------------------------------------- 1 | GHC/STG: 2 | node layout and arity infromation is DATA (thunk meta-data) 3 | i.e. partial application 4 | 5 | Boq GRIN: 6 | node layout and arity is CODE (case expression in eval/apply function) 7 | 8 | NOTE: 9 | stg data (info table/closure) is a convention for generic node encoding 10 | 11 | new static analysis: 12 | stg DATA -> grin NODE/CODE 13 | generic -> specialized 14 | 15 | if stg DATA does not escapes from local compilation unit then it can be encoded as grin NODE 16 | 17 | GOAL: the analysis must tell if a node value is visible via exported (public) functions 18 | 19 | NOTES: 20 | how to represent node layout as data? 21 | do we need new primops for metadata handling? / can grin naturally encode it? 22 | A) boxed values 23 | with efficient optimisations metadata can be encoded naturally and efficiently 24 | required transformations: 25 | - gibbon style packed representation 26 | - untagging / unboxing 27 | - garbage collector code must be optimised together with the code 28 | 29 | PROBLEM: to support incremental compilation the metadata format must follow a predefined convention 30 | DECISION: NO, would not work 31 | 32 | B) metadata primops 33 | 34 | QUESTION: 35 | should GRIN perform runtime type checking of unknown function arguments? 36 | A) YES ; support dynamic languages ; similar to gradua typing 37 | B) NO ; requires explicit type annotation of unknown function application 38 | -------------------------------------------------------------------------------- /notes/examples.note: -------------------------------------------------------------------------------- 1 | x <- case v of 2 | CCon1 -> do 3 | v1 <- unit (CCon1 0) 4 | unit v1 5 | CCon2 -> do 6 | v2 <- unit (CCon2 0) 7 | unit v2 8 | 9 | t x <- case w of 10 | CCon1 -> do 11 | t1 <- unit CCon1 12 | x1 <- unit 5 13 | y1 <- unit (t1 x1) 14 | unit y1 (producer 1) 15 | CCon2 -> do 16 | t2 <- unit CCon2 17 | x2 <- unit 5 18 | y2 <- unit (t2 x2) 19 | unit y2 (producer 2) 20 | z <- case t of 21 | CCon1 -> ... x ... (x is created by 1) 22 | CCon2 -> ... x ... (x is created by 2) 23 | -------------------------------------------------------------------------------- /notes/future-impact: -------------------------------------------------------------------------------- 1 | mvp grin: 2 | - compiled abstract interpretation 3 | - recursion scheme 4 | - LLVM 5 | 6 | phd grin (Haskell): 7 | - GHC frontend 8 | - optimisations 9 | - tracing GC 10 | 11 | final grin (Haskell): 12 | - llvm types in GHC (i.e. SIMD vector) 13 | - memory layout control in GHC 14 | - ASAP compile time memory management (no GC) 15 | - fast compilation (via parallel transformations and abstract compilation) 16 | - memory debugger 17 | 18 | after final: 19 | - agda frontend 20 | - idris frontend 21 | - chunky recursive data transformations (for cache efficiency) (https://en.wikipedia.org/wiki/CDR_coding) (DPH Vectorisation + NESL / SPMD) 22 | - spmd compilation (kmett @ zurihac 2017) 23 | - fast jit + parallel optimisation / recompilation + runtime data migration 24 | 25 | possible impact: 26 | - applications in performance critical domains: games, graphics, scientific calcualtions 27 | - better score in benchmark game 28 | - performance: haskell quake =?= c quake 29 | 30 | The combination of GRIN, LLVM and ASAP memory management can prove that 31 | high performance computing is feasible in a high level language like Haskell. 32 | 33 | grin requires additional 3 months: 34 | - ghc integration 35 | - llvm hpt / improve hpt framework 36 | - asap memory management 37 | - agda frontend 38 | - idris frontend 39 | 40 | marc 26 - monday 41 | 42 | simulacron: 43 | marc - state sync prototype 44 | april - ddl, clasterisation 45 | may - ??? 46 | 47 | -------------------------------------------------------------------------------- /notes/ideas.data-flow-analysis: -------------------------------------------------------------------------------- 1 | the data flow machine is same as the meta-variable solver in a type checker 2 | 3 | idea for more efficient data-flow execution: 4 | - keep internal structure of unifications 5 | if everything is propagated as a value then it's a sharing loss 6 | 7 | data-flow program should be a normal program 8 | 9 | the input program AST structure definies the meta-variable dependencies, 10 | that means the AST is the dependency tree that re-triggers computations 11 | 12 | 13 | -------------------------------------------------------------------------------- /notes/milestones: -------------------------------------------------------------------------------- 1 | milestone 3: 2 | - add contexts to hpt 3 | - hpt inline support 4 | - adaptive inliner 5 | 6 | milestone 4: 7 | - documentation 8 | - stg frontend 9 | - benchmark ; grin samples 10 | 11 | milestone 5: 12 | - hpt llvm backend 13 | - modular hpt 14 | -------------------------------------------------------------------------------- /notes/node_visualization: -------------------------------------------------------------------------------- 1 | node editor: 2 | 3 | https://github.com/Ni55aN/D3-Node-Editor 4 | https://github.com/jagenjo/litegraph.js 5 | 6 | demo: 7 | 1. place nodes; save to json; parse in haskell 8 | idea: reactive editing (connection between the editor and the compiler) 9 | 10 | 2. visualize compiled lambdacube pipeline 11 | 12 | high performance graph visualization: 13 | Sigma.js 14 | http://js.cytoscape.org/ 15 | 16 | fancy graph visualization: 17 | https://d3js.org/ 18 | https://github.com/wbkd/awesome-d3 19 | 20 | http://visjs.org/ 21 | http://www.chartjs.org/samples/latest/ 22 | http://graphalchemist.github.io/Alchemy/#/ 23 | 24 | purescript: 25 | 26 | https://github.com/pelotom/purescript-d3 27 | 28 | 29 | to choose: 30 | 31 | https://constructive.co/insights/6-best-data-visualization-tools-2016-pt-1/ 32 | https://constructive.co/insights/6-best-interactive-data-visualization-tools-2016-part-2/ 33 | https://www.quora.com/What-is-best-for-graph-rendering-sigma-js-or-d3-js-Why 34 | 35 | current choice: 36 | plotly (based on d3) 37 | d3-node-editor 38 | OR 39 | https://github.com/projectstorm/react-diagrams 40 | 41 | -------------------------------------------------------------------------------- /notes/optimisation-notes: -------------------------------------------------------------------------------- 1 | sum simple does not optimise to sum opt without update elimination (sharing analysis) 2 | this means call by name is better to optimise than call by need? 3 | i.e. an eval without update 4 | 5 | question: 6 | is there a case when can call by need (with sharing analysis) would block further optimisations that was possible with call by name? 7 | 8 | 9 | - new transformation / grin language modification 10 | for better accuracy each case alternative should introduce a new binder for the narrowed scrutinee, 11 | substitute the scritinee variable with the alternative's narrowed scrutinee version 12 | -------------------------------------------------------------------------------- /notes/random-thougths: -------------------------------------------------------------------------------- 1 | higher order IR = first order IR + function cloning 2 | 3 | is STG equal to GRIN + central dispatch function calling per-module eval? 4 | -------------------------------------------------------------------------------- /notes/todo.asap: -------------------------------------------------------------------------------- 1 | GC: 2 | - calculate live variables at call sites (interprocedural LVA) 3 | - generate GC descriptors for call sites 4 | 5 | ASAP: 6 | my idea: 7 | pass variables as abstract values during HPT (beside types) 8 | 9 | analysis 10 | shape, share - forward 11 | access - backward 12 | 13 | 14 | asap thoughts: 15 | - it has no explicit memory operation ; it does not distinguish register and heap values 16 | 17 | caveat: 18 | - does not support concurrent programs 19 | 20 | points-to analysis: 21 | http://www.cs.cornell.edu/courses/cs711/2005fa/papers/andersen-thesis94.pdf 22 | https://github.com/grievejia/andersen 23 | https://www.seas.harvard.edu/courses/cs252/2011sp/slides/Lec06-PointerAnalysis.pdf 24 | http://www.cl.cam.ac.uk/teaching/1718/OptComp/slides.html 25 | lecture 13a 26 | 27 | https://en.wikipedia.org/wiki/Steensgaard%27s_algorithm 28 | http://www.cs.cornell.edu/courses/cs711/2005fa/papers/steensgaard-popl96.pdf 29 | http://research.cs.wisc.edu/wpis/papers/toplas02.pdf 30 | https://www.seas.harvard.edu/courses/cs252/2011sp/slides/Lec09-ShapeAnalysis.pdf 31 | 32 | http://dalila.sip.ucm.es/~manuel/ATP/DataFlowAnalisis.pdf 33 | 34 | The Complexity of Andersen’s Analysis in Practice 35 | 36 | asap terms: 37 | - path 38 | - zone (variable, path) 39 | - type compatibility of paths 40 | each element of path1 and path2 points to the same type (pairwise) 41 | - partial order of paths 42 | p1 <= p2 ====> zone (x, p1) is subset of of zone(x, p2) 43 | - prefix closure of path 44 | - wild path set 45 | Wild(alpha-type) -> path set 46 | explores the whole memory occupied by a value of alpha-type 47 | - path widening 48 | -------------------------------------------------------------------------------- /notes/todo.benchmark: -------------------------------------------------------------------------------- 1 | benchmark tool ; instruction counter 2 | 3 | perf stat -e instructions:u mv 4 | -------------------------------------------------------------------------------- /notes/todo.codegen: -------------------------------------------------------------------------------- 1 | - tail call annotation + annotation pass (force with 'must tail' in llvm) 2 | - explicit heap pointer passing 3 | - do not pass heap pointer where not neccessary (no memory operation) 4 | - rework heap pointer extraction to be tail call compatible 5 | 6 | - rework simplification transformations to be helper passes for the llvm codegen 7 | 8 | - runtime pattern mismatch errors? (optional) 9 | 10 | - pre codegen linter 11 | - report errors with references to the linted AST 12 | - the codegen should support only product types not sum types 13 | 14 | - lower tag values to explicit ints with custom minimal valid bit width ; codegen should not know about tags at all 15 | -------------------------------------------------------------------------------- /notes/todo.contributors: -------------------------------------------------------------------------------- 1 | necessary knowledege: 2 | - project overview ; read the article 3 | - grin semantics ; read the relevant chapter 4 | - recursion schemes ; read some recursion scheme intro 5 | 6 | specialisation: 7 | - grin transformations 8 | - frontends 9 | - code generator ; machine code ; gc ; rts 10 | 11 | preference: 12 | - quality over quantity 13 | - improve the code 14 | - prefer redable but do not be verbose unnecessary 15 | - be elegant 16 | - understand the problem ; find the best tradeoff in the problem domain 17 | - do good engineering 18 | - see the big picture 19 | 20 | - write tests 21 | - optimise for readibility ; care about fellow coders 22 | 23 | micro todo: 24 | - boquist phd chapters 25 | 1 - Background and motivation 26 | 2 - Graph Reduction Intermdiate Notation 27 | 3 - Control Flow Analysis 28 | 4 - Program Transformations 29 | 4.2 - Simplifying transformations 30 | 4.3 - Optimising transformations 31 | 5 - RISC code generator 32 | 6 - Interprocedural register allocation 33 | 7 - RISC optimisation 34 | 8 - Garbage collection support 35 | 9 - Experimental results 36 | 10 - Conclusions 37 | 38 | TODO: write few sentences about each chapters and how it is relevant today 39 | 40 | - recursion schemes 41 | - llvm language reference 42 | - abstract interpretation 43 | - overview video 44 | - asap analysis 45 | -------------------------------------------------------------------------------- /notes/todo.critiques: -------------------------------------------------------------------------------- 1 | - no grin systems had GC implementation 2 | - compile time 3 | - beneficial programs / speedup benchmarks 4 | -------------------------------------------------------------------------------- /notes/todo.gc: -------------------------------------------------------------------------------- 1 | https://github.com/mthom/on-the-fly-gc 2 | https://github.com/dhamidi/simple-gc 3 | https://github.com/stevedekorte/garbagecollector 4 | https://github.com/orangeduck/tgc 5 | https://github.com/EvaGL/llvm-gc 6 | https://github.com/simonask/simongc 7 | https://github.com/kavon/llvm-statepoint-utils 8 | -------------------------------------------------------------------------------- /notes/todo.hpt: -------------------------------------------------------------------------------- 1 | # bidirectional analysis 2 | 3 | reverse data flow arrows for more precision 4 | i.e. lambda patterns and case patterns defines the valid cases that the program could handle 5 | this can constrain the possible values further 6 | 7 | # call by need is an optimisation for call by name 8 | 9 | what if not the update elimination is the optimisation but the update insertion for call by name strategy to avoid redundancy 10 | 11 | # rename eval and apply to builtin name 12 | 13 | i.e. _prim_eval and _prim_apply 14 | -------------------------------------------------------------------------------- /notes/todo.jul-aug-sep: -------------------------------------------------------------------------------- 1 | week - jun 25: 2 | - patreon video 3 | - contributors guide 4 | 5 | goals for haskell exchange: 6 | - ghc frontend 7 | - tracing GC 8 | - benchmarks: compile-time + run-time 9 | - modular and (machine code) compiled HPT / analysis 10 | 11 | TODO: 12 | read the rest of GRIN 13 | - GC 14 | - arity raising 15 | - generalized unboxing 16 | - case copy propagation 17 | -------------------------------------------------------------------------------- /notes/todo.opt-ideas: -------------------------------------------------------------------------------- 1 | deserialization as memcpy due to (well designed) data layout 2 | 3 | GHC primop global analysis and evaluation using data-flow machine 4 | - memory layout optimisation 5 | - removal of indirections 6 | - data representation refinement 7 | - primop fusion 8 | 9 | -------------------------------------------------------------------------------- /notes/todo.pipeline: -------------------------------------------------------------------------------- 1 | frontend: 2 | - finish lambda frontend 3 | - implement stg -> lambda frontend 4 | 5 | test optimising pipeline 6 | - sum simple -> sum opt 7 | - continue: vectorisation as conversion to tagged union 8 | 9 | framework: 10 | - error messages with context ; including internal errors 11 | - robust name handling ; see llvm name handling 12 | - fresh name construction 13 | 14 | backend: 15 | - read back llvm heap to haskell 16 | 17 | question: 18 | should we use Block for left sided Case? 19 | idea: 20 | write grin validator to check: 21 | - case usage on the left side of the bind operator 22 | 23 | experiment: 24 | done - sum simple to sum opt without vectorisation and case simplification 25 | 26 | apr 23 todo: 27 | done - command line args for phd opt stages 28 | from handwritten stage 29 | (A) one step 30 | (B) the longest possible 31 | done - write manual opt stages without vectorisation 32 | 33 | apr 24 todo: 34 | test cases for 35 | done - copy propagation 36 | done - cse 37 | done - trivial case elimination 38 | HINT: 39 | cascading cases 40 | -------------------------------------------------------------------------------- /notes/todo.spmd: -------------------------------------------------------------------------------- 1 | 2015 LLVM Developers’ Meeting: Pierre-Andre Saulais “Creating an SPMD Vectorizer..." 2 | https://www.youtube.com/watch?v=ePu6c4FLc9I 3 | http://llvm.org/devmtg/2015-10/slides/Saulais-CreatingSPMDVectorizerOpenCL.pdf 4 | -------------------------------------------------------------------------------- /notes/todo.sprint: -------------------------------------------------------------------------------- 1 | # unit tests 2 | done - check todo.testing 3 | 4 | # grin validator 5 | work in progress 6 | - linter 7 | done - linted ast pretty printer 8 | 9 | # llvm like name handling 10 | - name datatype 11 | - parser 12 | - pretty 13 | - new name construction 14 | 15 | - new name resolver pass 16 | 17 | - modify transformations to use new unique name construction 18 | - inlining 19 | - generalised unboxing 20 | - arity raising 21 | - case copy propagation 22 | - case hoisting 23 | 24 | # pass manager 25 | 26 | # pipeline composition (algebra composition) 27 | 28 | # module cleanup 29 | - remove redundant modules 30 | - introduce module namespaces 31 | https://jaspervdj.be/posts/2017-12-07-getting-things-done-in-haskell.html 32 | - import cleanup 33 | 34 | # missing features: 35 | - CAF support 36 | done - side effect tracking 37 | - circular data structures 38 | NOTE: the initial value of a circular node is the HOLE with the error message/location 39 | 40 | # GOAL 41 | 42 | working sum simple to sum opt with 43 | done - correct name handling 44 | - simplified llvm codegen 45 | - adjusted simplification transformations 46 | done - resulting `call _prim_int_print 500500` machine code 47 | 48 | ## missing 49 | done - case hoisting + test 50 | done - inlining test 51 | -------------------------------------------------------------------------------- /notes/todo.stg: -------------------------------------------------------------------------------- 1 | https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/StgSynType 2 | https://gist.github.com/jozefg/652f1d7407b7f0266ae9 3 | 4 | option A: 5 | - first order Core AST 6 | - lambda lift STG -> first order Core 7 | - first order Core -> Grin, according boquist phd 8 | 9 | option B: 10 | - STG -> Grin, according boquist phd 11 | - includes lambda lifting 12 | -------------------------------------------------------------------------------- /notes/todo.testing: -------------------------------------------------------------------------------- 1 | case related: 2 | done - evaluated case elimination 3 | done - trivial case elimination 4 | done - sparse case optimisation 5 | andor - case copy propagation 6 | done - case hoisting 7 | 8 | memory related: 9 | andor - generalised unboxing 10 | andor - arity raising 11 | done - update elimination ; marked for deletion 12 | - whnf update elimination ; TODO 13 | 14 | control flow graph related: 15 | - late inlining ; requires name gen support 16 | 17 | done - common sub-expression elimination 18 | done - bind normalisation 19 | done - constant folding ; Q: what is the intended behaviour? ; adjust tests 20 | done - copy propagation ; Q: what is the intended behaviour? ; adjust tests 21 | done - constant propagation ; it is related to costant folding as it does limited constant folding 22 | 23 | dead code related: 24 | done - dead procedure elimination 25 | done - dead variable elimination 26 | done - dead parameter elimination 27 | 28 | NOTE: possible grouping: control flow related / evaluation related 29 | 30 | opt samples 31 | done - pipeline test for complex cases and to check transform interactions 32 | 33 | NEXT: 34 | 35 | simplification passes: 36 | register introduction - requires name gen support 37 | vectorisation 38 | split fetch 39 | right hoist fetch 40 | case simplifiaction 41 | update specialisation 42 | inline calls to eval 43 | inline calls to apply 44 | -------------------------------------------------------------------------------- /notes/whole-program-compilation-challenges: -------------------------------------------------------------------------------- 1 | The whole program AST could contain few million nodes. i.e. lambdacube-quake3 has ~1.1M nodes 2 | 3 | This poses serious challenges for performace requirements. 4 | 5 | Q: 6 | - how far can we get with the current system design? (CPU, ShortText names, pointer tree) 7 | problems: 8 | - memory footprint 9 | - traversal speed 10 | - data-flow analysis speed 11 | possible improvements: 12 | - multithreading 13 | - int names + symbol table 14 | - c interpreter for data-flow machine 15 | - llvm jit for data-flow machine 16 | 17 | Possible system designs: 18 | - data-flow analysis on GPU 19 | - packed AST representation 20 | - optimization passes on CPU with SPMD 21 | - optimization passes on GPU 22 | -------------------------------------------------------------------------------- /papers/.gitignore: -------------------------------------------------------------------------------- 1 | *.toc 2 | *.aux 3 | *.bbl 4 | *.blg 5 | *.log 6 | *.out 7 | *.gz 8 | *.listing 9 | **/_minted-main/ 10 | -------------------------------------------------------------------------------- /papers/MoL-2010-19.text.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/MoL-2010-19.text.pdf -------------------------------------------------------------------------------- /papers/The GRIN Project.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/The GRIN Project.pdf -------------------------------------------------------------------------------- /papers/boquist.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/boquist.pdf -------------------------------------------------------------------------------- /papers/data-layout/Compiling Tree Transforms to Operate on Packed Representations.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/data-layout/Compiling Tree Transforms to Operate on Packed Representations.pdf -------------------------------------------------------------------------------- /papers/eutypes-2019/tex/abstract.tex: -------------------------------------------------------------------------------- 1 | \documentclass[main.tex]{subfiles} 2 | \begin{document} 3 | \begin{abstract} 4 | 5 | GRIN is short for Graph Reduction Intermediate Notation~\cite{boquist-phd}, a modern back end for lazy functional languages. Most of the currently available compilers for such languages share a common flaw: they can only optimize programs on a per-module basis. The GRIN framework allows for interprocedural whole program analysis, enabling optimizing code transformations across functions and modules as well. 6 | 7 | One of the optimizations supported by GRIN is dead data elimination, a special case of dead code elimination~\cite{remi-masters}. Conventional dead code eliminating optimizations usually only remove statements or expressions from programs; however, dead data elimination can transform the underlying data structures themselves. Essentially, it can specialize a certain data structure for a given use-site by removing or transforming unnecessary parts of it. It is a very powerful optimization technique that can significantly decrease memory usage and reduce the number of required heap operations. 8 | 9 | In the context of dependently typed languages, dead data elimination (with the help of other front end side transformations) is capable of erasing unnecessary type indices from dependent data constructors. In this talk, I will outline a general overview of GRIN, elaborate on dead data elimination, and also present some initial results of their applications to dependently typed languages. 10 | 11 | \end{abstract} 12 | \end{document} -------------------------------------------------------------------------------- /papers/eutypes-2019/tex/bibliography.tex: -------------------------------------------------------------------------------- 1 | \documentclass[main.tex]{subfiles} 2 | \begin{document} 3 | \makeatletter 4 | \preto{\@verbatim}{\topsep=0pt \partopsep=0pt } 5 | \makeatother 6 | 7 | \bibliographystyle{IEEEtran} 8 | \bibliography{bib_database} 9 | 10 | \end{document} -------------------------------------------------------------------------------- /papers/eutypes-2019/tex/main.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/eutypes-2019/tex/main.pdf -------------------------------------------------------------------------------- /papers/eutypes-2019/tex/main.tex: -------------------------------------------------------------------------------- 1 | \documentclass[10pt,a4paper,oneside]{article} 2 | 3 | \usepackage{style} 4 | \usepackage{subfiles} 5 | 6 | %TODO: remove vspace from title 7 | \title{\vspace{-2cm}GRIN: Dead data elimination\\ in the context of dependently typed languages} 8 | %\title{Dead Code Elimination for GRIN with Interprocedural Whole-Program Analysis} 9 | \date{\today} 10 | \author{Péter Dávid Podlovics\footnote{The author has been supported by the European Union, co-financed by the European Social Fund (EFOP-3.6.3-VEKOP-16-2017-00002).}, Csaba Hruska} 11 | 12 | \begin{document} 13 | 14 | \maketitle 15 | \subfile{abstract} 16 | 17 | \subfile{bibliography} 18 | 19 | \end{document} -------------------------------------------------------------------------------- /papers/grin-benchmarks.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/grin-benchmarks.tar.gz -------------------------------------------------------------------------------- /papers/memory-management/10.1.1.88.6828.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/memory-management/10.1.1.88.6828.pdf -------------------------------------------------------------------------------- /papers/memory-management/UCAM-CL-TR-908.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/memory-management/UCAM-CL-TR-908.pdf -------------------------------------------------------------------------------- /papers/memory-management/concurrency/Liveness-and-Safety-for-Channel-Based-Programming.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/memory-management/concurrency/Liveness-and-Safety-for-Channel-Based-Programming.pdf -------------------------------------------------------------------------------- /papers/memory-management/concurrency/Safety-and-Liveness-in-Concurrent-Pointer-Programs.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/memory-management/concurrency/Safety-and-Liveness-in-Concurrent-Pointer-Programs.pdf -------------------------------------------------------------------------------- /papers/memory-management/hraRevised.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/memory-management/hraRevised.pdf -------------------------------------------------------------------------------- /papers/tracing-jit-haskell-schilling.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/papers/tracing-jit-haskell-schilling.pdf -------------------------------------------------------------------------------- /playground/hpt/000.sum_simple_ghc.dfbin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/playground/hpt/000.sum_simple_ghc.dfbin -------------------------------------------------------------------------------- /playground/hpt/IR_test.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include "IR.h" 3 | 4 | int main(int argc, char **argv) { 5 | for (int i = 1 ; i < argc ; i++) { 6 | printf("loading: %s\n", argv[i]); 7 | eval_abstract_program(argv[i]); 8 | } 9 | 10 | return 0; 11 | } -------------------------------------------------------------------------------- /playground/hpt/c: -------------------------------------------------------------------------------- 1 | set -x -e 2 | 3 | g++ -O3 -c -std=c++11 IR_load.cpp 4 | g++ -O3 -c -std=c++11 IR_reduce.cpp 5 | g++ -O3 -c -std=c++11 IR_save_result.cpp 6 | 7 | g++ -O3 -std=c++11 IR_load.cpp IR_reduce.cpp IR_save_result.cpp IR_test.cpp -o df_test 8 | -------------------------------------------------------------------------------- /playground/sum/sum.hs: -------------------------------------------------------------------------------- 1 | module SumSimpleBasic where 2 | 3 | data List a 4 | = Nil 5 | | Cons a (List a) 6 | 7 | hs_sum_pure :: IO () 8 | hs_sum_pure = print $ sum $ upto 1 100000 9 | where 10 | upto :: Int -> Int -> List Int 11 | upto m n = if m > n 12 | then Nil 13 | else Cons m $ upto (m+1) n 14 | 15 | sum :: List Int -> Int 16 | sum l = case l of 17 | Nil -> 0 18 | Cons n ns -> n + sum ns 19 | -------------------------------------------------------------------------------- /sample/tsumupto.lambdabin.grin.binary: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/grin/483112f170afdc07833aad86da4e44d0d05c6b68/sample/tsumupto.lambdabin.grin.binary -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | let 2 | sources = import ./nix/sources.nix {}; 3 | nixpkgs = import sources.nixpkgs {}; 4 | pkgs = import ./default.nix; 5 | in 6 | pkgs.shellFor { 7 | buildInputs = with nixpkgs.haskellPackages; [ 8 | hlint 9 | ghcid 10 | ]; 11 | 12 | GRIN_CC = "${nixpkgs.clang_7}/bin/clang"; 13 | GRIN_OPT = "${nixpkgs.llvm_7}/bin/opt"; 14 | GRIN_LLC = "${nixpkgs.llvm_7}/bin/llc"; 15 | } 16 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-14.16 2 | 3 | # due to functor-infix 4 | allow-newer: true 5 | 6 | packages: 7 | - 'grin' 8 | 9 | extra-deps: 10 | - monad-gen-0.3.0.1 11 | - functor-infix-0.0.5 12 | - QuickCheck-GenT-0.2.0 13 | - set-extra-1.4.1 14 | - llvm-hs-pretty-0.6.1.0 15 | - system-posix-redirect-1.1.0.1 16 | - github: yatima-inc/llvm-hs 17 | commit: 868e23a13942703255979369defdb49ac57b6866 18 | branch: llvm-7 19 | subdirs: 20 | - llvm-hs 21 | - llvm-hs-pure 22 | 23 | flags: 24 | llvm-hs: 25 | shared-llvm: true 26 | grin: 27 | with-llvm-hs: true 28 | 29 | build: 30 | test-arguments: 31 | additional-args: 32 | - "--seed=11010" 33 | --------------------------------------------------------------------------------