├── ghc-grin-benchmark ├── lib │ ├── mylib.c │ ├── Hello.hs │ ├── LICENSE │ └── grin-test-lib.cabal ├── app │ ├── Util.hs │ ├── main_c_lib.c │ ├── Main.hs │ ├── LICENSE │ └── grin-test-app.cabal ├── basic │ ├── basic00.hs │ ├── clib.c │ ├── basic01.hs │ ├── basic02.hs │ ├── basic03.hs │ ├── basic06.hs │ ├── basic05.hs │ ├── basic04.hs │ ├── LICENSE │ └── basic.cabal ├── boquist-grin-bench │ ├── results │ │ ├── errl.ax │ │ ├── errl.gx │ │ ├── errl.axr │ │ ├── errl.bother │ │ ├── errl.gxr │ │ ├── errl.counts_all │ │ ├── errl.a8 │ │ ├── errl.comp_hgc │ │ ├── errl.stats_hgc │ │ ├── errl.comp_hbc │ │ ├── errl.evals │ │ ├── errl.time_all2.lips │ │ ├── errl.time_all2.zoot │ │ ├── errl.size_hgc │ │ ├── errl.a2 │ │ ├── errl.a4 │ │ ├── errl.a5 │ │ ├── errl.gcse1 │ │ └── errl.run_hgc │ ├── imaginary │ │ ├── tak │ │ │ ├── hgc.out │ │ │ ├── Changes │ │ │ ├── tak.stdout │ │ │ ├── Jmakefile │ │ │ ├── Makefile │ │ │ ├── Main.hs │ │ │ └── tak.hs │ │ └── exp3_8 │ │ │ ├── exp3_8.stdout │ │ │ ├── hgc.out │ │ │ ├── Jmakefile │ │ │ ├── Makefile │ │ │ ├── exp3_8.hs │ │ │ └── Main.hs │ ├── other │ │ ├── puzzle │ │ │ ├── hgc.out │ │ │ ├── Makefile │ │ │ └── prel.hs │ │ ├── nfib │ │ │ ├── hgc.out │ │ │ ├── Makefile │ │ │ └── nfib.hs │ │ ├── queens │ │ │ ├── hgc.out │ │ │ ├── Makefile │ │ │ ├── queens.hs │ │ │ └── prel.hs │ │ ├── sieve │ │ │ ├── hgc.out │ │ │ ├── Makefile │ │ │ ├── prel.hs │ │ │ └── sieve.hs │ │ ├── tsumupto │ │ │ ├── hgc.out │ │ │ ├── Makefile │ │ │ └── tsumupto.hs │ │ └── words │ │ │ ├── hgc.out │ │ │ ├── Makefile │ │ │ └── prel.hs │ ├── spectral │ │ ├── sorting │ │ │ ├── hgc.out │ │ │ ├── Changes │ │ │ ├── Makefile │ │ │ ├── Jmakefile │ │ │ ├── Main.hs │ │ │ └── prel.hs │ │ ├── hartel │ │ │ ├── event │ │ │ │ ├── event.stdout │ │ │ │ ├── hgc.out │ │ │ │ ├── Jmakefile │ │ │ │ ├── Makefile │ │ │ │ ├── Changes │ │ │ │ └── prel.hs │ │ │ ├── typecheck │ │ │ │ ├── hgc.out │ │ │ │ ├── typecheck.stdout │ │ │ │ ├── Jmakefile │ │ │ │ ├── Makefile │ │ │ │ ├── Changes │ │ │ │ └── prel.hs │ │ │ └── ida │ │ │ │ ├── Jmakefile │ │ │ │ ├── Changes │ │ │ │ ├── Makefile │ │ │ │ ├── hgc.out │ │ │ │ ├── ida.stdout │ │ │ │ └── prel.hs │ │ ├── boyer2 │ │ │ ├── boyer2.stdout │ │ │ ├── hgc.out │ │ │ ├── prel.hs │ │ │ ├── Changes │ │ │ ├── README │ │ │ ├── Jmakefile │ │ │ ├── Makefile │ │ │ ├── Checker.hs │ │ │ └── Rewritefns.hs │ │ ├── clausify │ │ │ ├── Jmakefile │ │ │ ├── hgc.out │ │ │ ├── clausify.stdout │ │ │ ├── Makefile │ │ │ ├── Changes │ │ │ └── prel.hs │ │ ├── cichelli │ │ │ ├── hgc.out │ │ │ ├── Changes │ │ │ ├── Makefile │ │ │ ├── cichelli.stdout │ │ │ ├── key.hs │ │ │ ├── Main.hs │ │ │ ├── Jmakefile │ │ │ ├── prel.hs │ │ │ └── Key.lhs │ │ └── awards │ │ │ ├── Jmakefile │ │ │ ├── Changes │ │ │ ├── Makefile │ │ │ ├── hgc.out │ │ │ ├── awards.stdout │ │ │ ├── prel.hs │ │ │ └── Main.hs │ ├── README │ └── LICENSE ├── delete-stack-work.sh ├── c.build ├── boq-custom │ ├── clib.c │ ├── nfib.hs │ ├── tsumupto.hs │ ├── RTS.hs │ ├── tak.hs │ ├── info │ ├── sieve.hs │ ├── exp3_8.hs │ ├── queens.hs │ └── LICENSE ├── stgbin-ls.sh ├── sum-list │ ├── tsumupto1.hs │ ├── tsumupto2.hs │ ├── sum.hs │ ├── sum-list.cabal │ └── LICENSE ├── prof │ ├── event.prof │ ├── ida.prof │ ├── nfib.prof │ ├── sieve.prof │ ├── tak.prof │ ├── words.prof │ ├── awards.prof │ ├── boyer2.prof │ ├── exp3_8.prof │ ├── puzzle.prof │ ├── queens.prof │ ├── sorting.prof │ ├── cichelli.prof │ ├── clausify.prof │ ├── tsumupto.prof │ └── typecheck.prof ├── lambda-clean.sh ├── stgbin-clean.sh ├── c.clean ├── bench.sh ├── stack.yaml.boq-bench ├── stack.yaml.unordered-containers ├── stack.yaml.smallest ├── stack.yaml.idris-master ├── stack.yaml.pandoc-master ├── stack.yaml └── stack.yaml.save ├── sample ├── InitialReachable.facts ├── tsumupto.lambdabin ├── tsumupto.2.lambdabin ├── FunctionType.facts ├── FunctionTypeReturnType.facts ├── FunctionTypeParameterType.facts ├── tsumupto.hs └── IsTypeVariable.facts ├── external-stg ├── GHC │ └── Prelude.hs ├── data-con-from-type ├── external-stg.cabal ├── LICENSE └── stg-type-query-experiment ├── stgbin-watch.sh ├── external-stg-util ├── Setup.hs ├── src │ └── Stg │ │ └── Util.hs ├── external-stg-util.cabal ├── LICENSE └── app │ └── Main.hs ├── ghc-primop-gen ├── primops.txt.pp ├── primops-info └── ghc-primop-gen.cabal ├── patched-lambda-to-ghc-stg ├── mini-ghc-grin │ ├── src │ │ ├── Stg │ │ │ ├── ToStg.hs │ │ │ ├── Util.hs │ │ │ ├── Reconstruct.hs │ │ │ ├── DeadFunctionElimination.hs │ │ │ ├── ext-stg-liveness.dl │ │ │ └── DeadFunctionElimination │ │ │ │ └── StripModule.hs │ │ ├── StgLoopback.hs │ │ └── Lambda │ │ │ ├── Name.hs │ │ │ ├── ToStg.hs │ │ │ ├── Syntax.hs │ │ │ └── GHCSymbols.hs │ ├── app │ │ ├── showGHCStg.hs │ │ └── genObj.hs │ ├── LICENSE │ └── mini-ghc-grin.cabal ├── c.clean ├── c.repl ├── c.build ├── c.install └── stack.yaml ├── lambda-grin ├── test │ ├── Spec.hs │ ├── circular.lam │ ├── c │ ├── hof.lam │ ├── c-opt │ ├── ParserSpec.hs │ ├── bug01-letS.lam │ ├── sum.lam │ ├── sum3.lam │ ├── sum2.lam │ ├── lambda-cg-bug01.grin │ └── 001.from-lambda.grin ├── souffle-datalog │ ├── PrimOp-CCS.dl │ ├── main.dl │ ├── PrimOp-Bytecode.dl │ ├── PointsTo.dl │ ├── PrimOp-StablePtr.dl │ ├── PrimOp-Concurrency.dl │ ├── PrimOp-Compact.dl │ ├── PrimOp-Parallelism.dl │ └── Check.dl ├── src │ └── Lambda │ │ ├── live_def_analysis.dl │ │ ├── ControlFlowAnalysisM.hs │ │ ├── Name.hs │ │ └── TH.hs ├── LICENSE └── app │ └── LambdaGrinCLI.hs ├── .github └── FUNDING.yml ├── lambdabin-clean.sh ├── boq-grin-ghc-inst-count.png ├── Ideas.md ├── stgbin-ls.sh ├── stgbin-clean.sh ├── info ├── stack.yaml ├── cmm-info ├── lto-stg ├── ghc-primop-lib └── ghc-primop-lib.cabal ├── stg-to-grin ├── lambda-stg-loopback ├── GHC-IR.md ├── ghc-grin ├── LICENSE ├── src │ └── Lambda │ │ └── GHCSymbols.hs └── ghc-grin.cabal ├── roadmap.ghc-grin └── README.md /ghc-grin-benchmark/lib/mylib.c: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /sample/InitialReachable.facts: -------------------------------------------------------------------------------- 1 | ::Main.main 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/app/Util.hs: -------------------------------------------------------------------------------- 1 | module Util where 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/basic/basic00.hs: -------------------------------------------------------------------------------- 1 | main = pure () -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.ax: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.gx: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /external-stg/GHC/Prelude.hs: -------------------------------------------------------------------------------- 1 | module GHC.Prelude where 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.axr: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.bother: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.gxr: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/tak/hgc.out: -------------------------------------------------------------------------------- 1 | 9 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/puzzle/hgc.out: -------------------------------------------------------------------------------- 1 | 128 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/exp3_8/exp3_8.stdout: -------------------------------------------------------------------------------- 1 | 6561 -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/exp3_8/hgc.out: -------------------------------------------------------------------------------- 1 | 6561 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/tak/Changes: -------------------------------------------------------------------------------- 1 | - xprint. 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/tak/tak.stdout: -------------------------------------------------------------------------------- 1 | "9\n" 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/nfib/hgc.out: -------------------------------------------------------------------------------- 1 | 29860703 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/queens/hgc.out: -------------------------------------------------------------------------------- 1 | 14200 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/sieve/hgc.out: -------------------------------------------------------------------------------- 1 | 121013308 2 | -------------------------------------------------------------------------------- /stgbin-watch.sh: -------------------------------------------------------------------------------- 1 | set -e -x 2 | 3 | watch "find . -name '*_stgbin' | wc -l" -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/tsumupto/hgc.out: -------------------------------------------------------------------------------- 1 | -2004260032 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/sorting/hgc.out: -------------------------------------------------------------------------------- 1 | 3849600 2 | -------------------------------------------------------------------------------- /external-stg-util/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /ghc-primop-gen/primops.txt.pp: -------------------------------------------------------------------------------- 1 | ../ghc-8.11.0.20200215-src/compiler/prelude/primops.txt.pp -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/event/event.stdout: -------------------------------------------------------------------------------- 1 | HHxLLHHLLHHLH 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/event/hgc.out: -------------------------------------------------------------------------------- 1 | HHxLLHHLLHHLH 2 | 3 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/src/Stg/ToStg.hs: -------------------------------------------------------------------------------- 1 | ../../../../external-stg/Stg/ToStg.hs -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/boyer2/boyer2.stdout: -------------------------------------------------------------------------------- 1 | The term is a tautology 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/boyer2/hgc.out: -------------------------------------------------------------------------------- 1 | The term is a tautology 2 | 3 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/typecheck/hgc.out: -------------------------------------------------------------------------------- 1 | 2904400/47800 2 | 3 | -------------------------------------------------------------------------------- /lambda-grin/test/Spec.hs: -------------------------------------------------------------------------------- 1 | -- file test/Spec.hs 2 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 3 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/src/StgLoopback.hs: -------------------------------------------------------------------------------- 1 | ../../../ghc-grin/src/StgLoopback.hs -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | patreon: csaba_hruska 4 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/tak/Jmakefile: -------------------------------------------------------------------------------- 1 | NoFibOneModuleCompileAndRun(tak,) 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/typecheck/typecheck.stdout: -------------------------------------------------------------------------------- 1 | 8713200/143400 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/delete-stack-work.sh: -------------------------------------------------------------------------------- 1 | set -x -e 2 | rm -r `find . -name '.stack-work' -type d` 3 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/c.clean: -------------------------------------------------------------------------------- 1 | set -x -e 2 | 3 | stack --stack-root `pwd`/.stack-root clean 4 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/src/Lambda/Name.hs: -------------------------------------------------------------------------------- 1 | ../../../../lambda-grin/src/Lambda/Name.hs -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/src/Lambda/ToStg.hs: -------------------------------------------------------------------------------- 1 | ../../../../ghc-grin/src/Lambda/ToStg.hs -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/src/Stg/Util.hs: -------------------------------------------------------------------------------- 1 | ../../../../external-stg-util/src/Stg/Util.hs -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/exp3_8/Jmakefile: -------------------------------------------------------------------------------- 1 | NoFibOneModuleCompileAndRun(exp3_8,) 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/clausify/Jmakefile: -------------------------------------------------------------------------------- 1 | NoFibOneModuleCompileAndRun(clausify,) 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/ida/Jmakefile: -------------------------------------------------------------------------------- 1 | NoFibOneModuleCompileAndRun(ida,) 2 | -------------------------------------------------------------------------------- /lambdabin-clean.sh: -------------------------------------------------------------------------------- 1 | set -e -x 2 | 3 | find . -name '*.lambdabin' 4 | find . -name '*.lambdabin' -delete 5 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/c.repl: -------------------------------------------------------------------------------- 1 | set -x -e 2 | 3 | stack --stack-root `pwd`/.stack-root -- ghci 4 | 5 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/src/Lambda/Syntax.hs: -------------------------------------------------------------------------------- 1 | ../../../../lambda-grin/src/Lambda/Syntax.hs -------------------------------------------------------------------------------- /sample/tsumupto.lambdabin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/ghc-grin/HEAD/sample/tsumupto.lambdabin -------------------------------------------------------------------------------- /boq-grin-ghc-inst-count.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/ghc-grin/HEAD/boq-grin-ghc-inst-count.png -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/event/Jmakefile: -------------------------------------------------------------------------------- 1 | NoFibOneModuleCompileAndRun(event,) 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/c.build: -------------------------------------------------------------------------------- 1 | reset 2 | 3 | set -x -e 4 | 5 | time stack --stack-root `pwd`/.stack-root build 6 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/src/Lambda/GHCSymbols.hs: -------------------------------------------------------------------------------- 1 | ../../../../ghc-grin/src/Lambda/GHCSymbols.hs -------------------------------------------------------------------------------- /sample/tsumupto.2.lambdabin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grin-compiler/ghc-grin/HEAD/sample/tsumupto.2.lambdabin -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/cichelli/hgc.out: -------------------------------------------------------------------------------- 1 | YesIts 16948 a5 i8 l8 c7 b8 y10 k3 t1 e1 j0 n0 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/typecheck/Jmakefile: -------------------------------------------------------------------------------- 1 | NoFibOneModuleCompileAndRun(typecheck,) 2 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/src/Stg/Reconstruct.hs: -------------------------------------------------------------------------------- 1 | ../../../../external-stg-util/src/Stg/Reconstruct.hs -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/awards/Jmakefile: -------------------------------------------------------------------------------- 1 | NoFibOneModuleCompileAndRun(awards,-o1 awards.stdout) 2 | -------------------------------------------------------------------------------- /lambda-grin/test/circular.lam: -------------------------------------------------------------------------------- 1 | ones_global = 2 | let box1 = (Int 1) 3 | letrec ones = (Cons box1 ones) 4 | ones 5 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/c.build: -------------------------------------------------------------------------------- 1 | reset 2 | 3 | set -x -e 4 | 5 | time stack --stack-root `pwd`/.stack-root build 6 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/c.install: -------------------------------------------------------------------------------- 1 | reset 2 | 3 | set -x -e 4 | 5 | time stack --stack-root `pwd`/.stack-root install 6 | -------------------------------------------------------------------------------- /sample/FunctionType.facts: -------------------------------------------------------------------------------- 1 | tf.0 1 2 | tf.1 2 3 | tf.4 1 4 | tf.6 1 5 | tf.11 1 6 | tf.100 1 7 | tf.107 1 8 | tf.115 1 9 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/basic/clib.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | void _prim_int_print(int i) { 4 | printf("%d\n", i); 5 | } 6 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boq-custom/clib.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | void _prim_int_print(int i) { 4 | printf("%d\n", i); 5 | } 6 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/cichelli/Changes: -------------------------------------------------------------------------------- 1 | - unlit. all in one file. 2 | - no Show. 3 | - add hbcc prelude. 4 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/boyer2/prel.hs: -------------------------------------------------------------------------------- 1 | {-# INLINE error #-} 2 | error :: String -> a 3 | error s = _error s 4 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/clausify/hgc.out: -------------------------------------------------------------------------------- 1 | a <= 2 | a <= 3 | a <= 4 | a <= 5 | a <= 6 | a <= 7 | a <= 8 | 9 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/clausify/clausify.stdout: -------------------------------------------------------------------------------- 1 | a <= 2 | a <= 3 | a <= 4 | a <= 5 | a <= 6 | a <= 7 | a <= 8 | -------------------------------------------------------------------------------- /lambda-grin/test/c: -------------------------------------------------------------------------------- 1 | reset 2 | rm 002.sum.grin 3 | stack exec -- lambda-grin sum3.lam -o sum.grin 4 | 5 | stack exec -- grin 002.sum.grin 6 | -------------------------------------------------------------------------------- /sample/FunctionTypeReturnType.facts: -------------------------------------------------------------------------------- 1 | tf.0 t.2 2 | tf.1 t.5 3 | tf.4 t.15 4 | tf.6 t.21 5 | tf.11 t.32 6 | tf.100 b.4 7 | tf.107 t.366 8 | tf.115 t.406 9 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/app/main_c_lib.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | void print_int64(int64_t i) { 5 | printf("int64_t: %ld\n", i); 6 | } 7 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/words/hgc.out: -------------------------------------------------------------------------------- 1 | 3276 96 4716 0 6300 0 696 5064 5196 84 480 1836 672 4188 348 0 0 11004 6072 6900 744 336 0 0 0 0 2 | -------------------------------------------------------------------------------- /Ideas.md: -------------------------------------------------------------------------------- 1 | # Ideas 2 | 3 | ## Research Ideas 4 | 5 | - create a external core compatible pretty printer for core-dump AST ; feed the whole program external core to HRC 6 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/sorting/Changes: -------------------------------------------------------------------------------- 1 | - all in one file. 2 | - new main (run all algorithms, sum results). 3 | - add hbcc prelude. 4 | - exhaustive patterns. 5 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/basic/basic01.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | foreign import ccall "_prim_int_print" prim_int_print :: Int -> IO () 4 | 5 | main = prim_int_print 1 6 | -------------------------------------------------------------------------------- /sample/FunctionTypeParameterType.facts: -------------------------------------------------------------------------------- 1 | tf.0 0 t.0 2 | tf.1 0 b.0 3 | tf.1 1 t.3 4 | tf.4 0 t.13 5 | tf.6 0 t.19 6 | tf.11 0 t.30 7 | tf.100 0 a.22 8 | tf.107 0 t.364 9 | tf.115 0 t.404 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/basic/basic02.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | foreign import ccall "_prim_int_print" prim_int_print :: Int -> IO () 4 | 5 | main = prim_int_print (1 + 2) 6 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/awards/Changes: -------------------------------------------------------------------------------- 1 | - copy sorting module from hbc. 2 | - copy List((\\)) from hbc. 3 | - add hbcc prelude. 4 | - exhaustive patterns. 5 | - eliminate Ord. 6 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/ida/Changes: -------------------------------------------------------------------------------- 1 | - no ../Fast2haskell. 2 | - remove all unused. 3 | - remove miraseq. 4 | - add hbcc prelude. 5 | - xprint. 6 | - add upto (no Enum). 7 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/basic/basic03.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | foreign import ccall "_prim_int_print" prim_int_print :: Int -> IO () 4 | 5 | main = prim_int_print $ sum [1..10] 6 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/basic/basic06.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | foreign import ccall "_prim_int_print" prim_int_print :: Int -> IO () 4 | 5 | main = prim_int_print $ length [1..10] 6 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/boyer2/Changes: -------------------------------------------------------------------------------- 1 | - all in one file. 2 | - no Show. 3 | - no Eq Lisplist, add String equality and ordering. 4 | - exhaustive patterns. 5 | - add hbcc prelude. 6 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/nfib/Makefile: -------------------------------------------------------------------------------- 1 | PROG=nfib 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H90M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H5M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/tak/Makefile: -------------------------------------------------------------------------------- 1 | PROG=tak 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H90M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H5M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/queens/Makefile: -------------------------------------------------------------------------------- 1 | PROG=queens 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H90M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H60M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/sieve/Makefile: -------------------------------------------------------------------------------- 1 | PROG=sieve 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H90M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H40M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/words/Makefile: -------------------------------------------------------------------------------- 1 | PROG=words 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H150M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H60M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/exp3_8/Makefile: -------------------------------------------------------------------------------- 1 | PROG=exp3_8 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H90M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H60M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/puzzle/Makefile: -------------------------------------------------------------------------------- 1 | PROG=puzzle 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H150M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H60M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/tsumupto/Makefile: -------------------------------------------------------------------------------- 1 | PROG=tsumupto 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H90M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H5M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/awards/Makefile: -------------------------------------------------------------------------------- 1 | PROG=awards 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H150M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H5M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /stgbin-ls.sh: -------------------------------------------------------------------------------- 1 | set -e -x 2 | 3 | find . -name '*.corebin' 4 | find . -name '*_stgbin' 5 | find . -name '*.lambda' 6 | find . -name '*.lambdabin' 7 | find . -name 'whole_program.out' 8 | find . -name 'whole_program.grin' 9 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/cichelli/Makefile: -------------------------------------------------------------------------------- 1 | PROG=cichelli 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H150M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H10M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/ida/Makefile: -------------------------------------------------------------------------------- 1 | PROG=ida 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H150M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H30M 9 | 10 | include ../../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/sorting/Makefile: -------------------------------------------------------------------------------- 1 | PROG=sorting 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H150M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H60M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/event/Makefile: -------------------------------------------------------------------------------- 1 | PROG=event 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H150M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H80M 9 | 10 | include ../../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/typecheck/Makefile: -------------------------------------------------------------------------------- 1 | PROG=typecheck 2 | HBCCFLAGS= 3 | HGC1=-dall 4 | HGC2=-H250M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H20M 9 | 10 | include ../../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/clausify/Makefile: -------------------------------------------------------------------------------- 1 | PROG=clausify 2 | HBCCFLAGS=-fno-listy-trans 3 | HGC1=-dall 4 | HGC2=-H150M 5 | HGC3= 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H20M 9 | 10 | include ../../hgc.mk 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/stgbin-ls.sh: -------------------------------------------------------------------------------- 1 | set -e -x 2 | 3 | find . -name '*.corebin' 4 | find . -name '*_stgbin' 5 | find . -name '*.lambda' 6 | find . -name '*.lambdabin' 7 | find . -name 'whole_program.out' 8 | find . -name 'whole_program.grin' 9 | -------------------------------------------------------------------------------- /lambda-grin/test/hof.lam: -------------------------------------------------------------------------------- 1 | grinMain = 2 | let box0 = (Int 0) 3 | quad quad inc box0 4 | 5 | quad g = twice twice g 6 | 7 | twice f x = 8 | let y = f x 9 | f y 10 | 11 | inc n = 12 | let box1 = (Int 1) 13 | int_add n box1 14 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/awards/hgc.out: -------------------------------------------------------------------------------- 1 | SimonGold74 19 34 21 Gold102 35 27 40 HansGold70 45 17 8 Bronze52 23 19 10 PhilGold70 1 35 34 Silver60 18 21 21 Bronze55 20 19 16 KevinGold72 9 54 9 Gold72 17 41 14 Bronze59 23 18 18 2 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/typecheck/Changes: -------------------------------------------------------------------------------- 1 | - no ../Fast2haskell. 2 | - remove all unused. 3 | - remove miraseq. 4 | - add hbcc prelude. 5 | - xprint. 6 | - add upto (no Enum). 7 | - specialise string equality (no Eq). 8 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/cichelli/cichelli.stdout: -------------------------------------------------------------------------------- 1 | YesIts 113994 [('w', 16), ('r', 17), ('o', 11), ('m', 17), ('l', 11), ('x', 2), ('n', 11), ('i', 4), ('f', 10), ('h', 3), ('g', 0), ('t', 5), ('d', 0), ('a', 0), ('s', 2), ('c', 0), ('e', 1)] -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/event/Changes: -------------------------------------------------------------------------------- 1 | - no ../Fast2haskell. 2 | - remove all unused. 3 | - remove miraseq. 4 | - add hbcc prelude. 5 | - exhaustive pattern matching (fnandfun, f_threestate_cmp). 6 | - add pair, upto (no Enum). 7 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/boyer2/README: -------------------------------------------------------------------------------- 1 | The interesting bit in this directory is ``Checker.hs''. As of GHC 0.14, 2 | the simplifier explodes tautologyp into 700+K of threaded C code, with 3 | 2000+ separate INTFUN's. To see this, compile with -O. 4 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/cichelli/key.hs: -------------------------------------------------------------------------------- 1 | keys :: [String] 2 | keys = ["case","class","data","default","deriving","else","hiding", "if","import","in","infix","infixl","instance","interface","let","module","of","renaming","then","to","type","where"] 3 | -------------------------------------------------------------------------------- /stgbin-clean.sh: -------------------------------------------------------------------------------- 1 | set -e -x 2 | 3 | find . -name '*.corebin' -delete 4 | find . -name '*_stgbin' -delete 5 | find . -name '*.lambda' -delete 6 | find . -name '*.lambdabin' -delete 7 | find . -name 'whole_program.out' -delete 8 | find . -name 'whole_program.grin' -delete 9 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/basic/basic05.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | foreign import ccall "_prim_int_print" prim_int_print :: Int -> IO () 4 | 5 | a :: [Int] 6 | a = [1..1000] 7 | 8 | b :: Int 9 | b = sum a 10 | 11 | main = prim_int_print b 12 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/sum-list/tsumupto1.hs: -------------------------------------------------------------------------------- 1 | 2 | main = print (xsum 0 (upto 1 10000000)) 3 | 4 | upto :: Int -> Int -> [Int] 5 | upto m n = if m > n then [] else m : upto (m+1) n 6 | 7 | xsum :: Int -> [Int] -> Int 8 | xsum n [] = n 9 | xsum n (x:xs) = xsum (n+x) xs 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/ida/hgc.out: -------------------------------------------------------------------------------- 1 | (4,4)((4,3)-(1,4))((3,4)-(2,4))((1,4)-(3,3))((1,1)-(1,2))((1,2)-(1,3))((2,1)-(3,1))((1,3)-(2,3))((2,4)-(2,2))((2,3)-(2,1))((2,2)-(4,2))((3,1)-(3,2))((3,2)-(4,3))((4,1)-(4,1))((3,3)-(3,4))((4,2)-(4,4)) 2 | 30 3163 3 | 4 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/ida/ida.stdout: -------------------------------------------------------------------------------- 1 | (2,4)((2,3)-(2,4))((1,4)-(2,3))((3,4)-(4,4))((4,1)-(4,1))((1,1)-(1,2))((3,1)-(3,1))((2,1)-(2,1))((1,2)-(2,2))((4,2)-(4,2))((4,4)-(3,2))((4,3)-(3,4))((3,2)-(4,3))((3,3)-(3,3))((2,2)-(1,4))((1,3)-(1,3)) 2 | 28 18919 3 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/event.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:31 2018 2 | 3 | 4 | Performance counter stats for 'event': 5 | 6 | 189,201,446 instructions:u 7 | 8 | 0.033875564 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/ida.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:31 2018 2 | 3 | 4 | Performance counter stats for 'ida': 5 | 6 | 46,048,007 instructions:u 7 | 8 | 0.011837482 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/nfib.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:27 2018 2 | 3 | 4 | Performance counter stats for 'nfib': 5 | 6 | 418,611,499 instructions:u 7 | 8 | 0.070567769 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/sieve.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:28 2018 2 | 3 | 4 | Performance counter stats for 'sieve': 5 | 6 | 2,145,090,643 instructions:u 7 | 8 | 0.381738994 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/tak.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:30 2018 2 | 3 | 4 | Performance counter stats for 'tak': 5 | 6 | 34,224,008 instructions:u 7 | 8 | 0.014651462 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/words.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:29 2018 2 | 3 | 4 | Performance counter stats for 'words': 5 | 6 | 778,303,407 instructions:u 7 | 8 | 0.108151235 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/awards.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:30 2018 2 | 3 | 4 | Performance counter stats for 'awards': 5 | 6 | 910,374 instructions:u 7 | 8 | 0.001385816 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/boyer2.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:32 2018 2 | 3 | 4 | Performance counter stats for 'boyer2': 5 | 6 | 22,381,096 instructions:u 7 | 8 | 0.009316196 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/exp3_8.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:30 2018 2 | 3 | 4 | Performance counter stats for 'exp3_8': 5 | 6 | 932,101,983 instructions:u 7 | 8 | 0.143487261 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/puzzle.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:29 2018 2 | 3 | 4 | Performance counter stats for 'puzzle': 5 | 6 | 2,445,680,585 instructions:u 7 | 8 | 0.367861036 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/queens.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:28 2018 2 | 3 | 4 | Performance counter stats for 'queens': 5 | 6 | 2,698,993,104 instructions:u 7 | 8 | 0.339819094 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/sorting.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:30 2018 2 | 3 | 4 | Performance counter stats for 'sorting': 5 | 6 | 725,877,617 instructions:u 7 | 8 | 0.094917805 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/lambda-clean.sh: -------------------------------------------------------------------------------- 1 | set -e -x 2 | 3 | cd .. 4 | ./lambdabin-clean.sh 5 | cd ghc-grin-benchmark 6 | 7 | find . -name '*.lambda' -delete 8 | find . -name '*.lambdabin' -delete 9 | find . -name 'whole_program.out' -delete 10 | find . -name 'whole_program.grin' -delete 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/cichelli.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:31 2018 2 | 3 | 4 | Performance counter stats for 'cichelli': 5 | 6 | 35,763,569 instructions:u 7 | 8 | 0.011397708 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/clausify.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:31 2018 2 | 3 | 4 | Performance counter stats for 'clausify': 5 | 6 | 117,333,727 instructions:u 7 | 8 | 0.020498941 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/tsumupto.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:27 2018 2 | 3 | 4 | Performance counter stats for 'tsumupto': 5 | 6 | 675,963,833 instructions:u 7 | 8 | 0.074550057 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/prof/typecheck.prof: -------------------------------------------------------------------------------- 1 | # started on Wed Aug 1 10:26:32 2018 2 | 3 | 4 | Performance counter stats for 'typecheck': 5 | 6 | 243,724,421 instructions:u 7 | 8 | 0.052985578 seconds time elapsed 9 | 10 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boq-custom/nfib.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | import RTS 4 | 5 | main = print_int (nfib 35) 6 | 7 | nfib :: Int -> Int 8 | nfib n = if n <= 1 then 9 | 1 10 | else 11 | 1 + nfib (n-1) + nfib (n-2) 12 | 13 | -- 32 -> 7049155 14 | -- 35 -> 29860703 15 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/tak/Main.hs: -------------------------------------------------------------------------------- 1 | -- code of unknown provenance (partain 95/01/25) 2 | 3 | tak :: Int -> Int -> Int -> Int 4 | 5 | tak x y z = if not(y < x) then z 6 | else tak (tak (x-1) y z) 7 | (tak (y-1) z x) 8 | (tak (z-1) x y) 9 | 10 | main = print (shows (tak 24 16 8) "\n") 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boq-custom/tsumupto.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | import RTS 4 | 5 | main = print_int (xsum 0 (upto 1 10000000)) 6 | 7 | upto :: Int -> Int -> [Int] 8 | upto m n = if m > n then [] else m : upto (m+1) n 9 | 10 | xsum :: Int -> [Int] -> Int 11 | xsum n [] = n 12 | xsum n (x:xs) = xsum (n+x) xs 13 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/sorting/Jmakefile: -------------------------------------------------------------------------------- 1 | SRCS_HS=Main.hs Sort.hs 2 | OBJS_O= Main.o Sort.o 3 | 4 | NoFibMultiModuleCompileAndRun(sorting,-i Sort.hs -o1 sorting.stdout) 5 | 6 | NoFibHaskellCompile(sorting,Main,hs) 7 | NoFibHaskellCompile(sorting,Sort,hs) 8 | 9 | NoFibDependTarget(sorting, $(SRCS_HS)) 10 | -------------------------------------------------------------------------------- /info: -------------------------------------------------------------------------------- 1 | https://github.com/commercialhaskell/stack/issues/3768 2 | 3 | https://ghc.haskell.org/trac/ghc/wiki/Building/Using 4 | https://ghc.haskell.org/trac/ghc/wiki/Building/Architecture/Idiom/Stages 5 | https://ghc.haskell.org/trac/ghc/wiki/Debugging/InstallingPackagesInplace 6 | 7 | https://hackage.haskell.org/package/ghc-dump-core 8 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boq-custom/RTS.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | module RTS where 4 | 5 | foreign import ccall "_prim_int_print" prim_int_print :: Int -> IO () 6 | 7 | print_int :: Int -> IO () 8 | print_int = prim_int_print 9 | 10 | print_int_list :: [Int] -> IO () 11 | print_int_list = mapM_ print_int 12 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/sum-list/tsumupto2.hs: -------------------------------------------------------------------------------- 1 | data IntList 2 | = Nil 3 | | Cons Int IntList 4 | 5 | main = print (xsum 0 (upto 1 10000000)) 6 | 7 | upto :: Int -> Int -> IntList 8 | upto m n = if m > n then Nil else Cons m (upto (m+1) n) 9 | 10 | xsum :: Int -> IntList -> Int 11 | xsum n Nil = n 12 | xsum n (Cons x xs) = xsum (n+x) xs 13 | -------------------------------------------------------------------------------- /sample/tsumupto.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | #ifdef __HBCC__ 4 | #define print xprint 5 | #endif 6 | 7 | main = print (xsum 0 (upto 1 10000000)) 8 | 9 | upto :: Int -> Int -> [Int] 10 | upto m n = if m > n then [] else m : upto (m+1) n 11 | 12 | xsum :: Int -> [Int] -> Int 13 | xsum n [] = n 14 | xsum n (x:xs) = xsum (n+x) xs 15 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/cichelli/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prog (prog) 4 | 5 | --#ifdef PAR 6 | --main input = prog input 7 | --#else 8 | -- partain: doesn't actually look at input; 9 | -- real input is wired into Key.lhs 10 | 11 | main = do 12 | str <- getContents 13 | putStr (prog str) 14 | --#endif 15 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/nfib/nfib.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | #ifdef __HBCC__ 4 | #define print xprint 5 | #endif 6 | 7 | main = print (nfib 35) 8 | 9 | nfib :: Int -> Int 10 | nfib n = if n <= 1 then 11 | 1 12 | else 13 | 1 + nfib (n-1) + nfib (n-2) 14 | 15 | -- 32 -> 7049155 16 | -- 35 -> 29860703 17 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/sieve/prel.hs: -------------------------------------------------------------------------------- 1 | --{-# SPECIALIZE sum :: [Int] -> Int #-} 2 | --sum :: (Num a) => [a] -> a 3 | -- hbcc bug! 4 | {-# INLINE sum #-} 5 | sum :: [Int] -> Int 6 | sum l = sum' l 0 7 | where sum' :: [Int] -> Int -> Int 8 | sum' [] a = a 9 | sum' (x:xs) a = sum' xs (a+x) 10 | 11 | #define print xprint 12 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boq-custom/tak.hs: -------------------------------------------------------------------------------- 1 | -- code of unknown provenance (partain 95/01/25) 2 | module Main(main) where 3 | 4 | import RTS 5 | 6 | tak :: Int -> Int -> Int -> Int 7 | 8 | tak x y z = if not(y < x) then z 9 | else tak (tak (x-1) y z) 10 | (tak (y-1) z x) 11 | (tak (z-1) x y) 12 | 13 | main = print (tak 24 16 8) 14 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/stgbin-clean.sh: -------------------------------------------------------------------------------- 1 | set -e -x 2 | 3 | #cd .. 4 | #./lambdabin-clean.sh 5 | #cd ghc-grin-benchmark 6 | 7 | find . -name '*.corebin' -delete 8 | find . -name '*_stgbin' -delete 9 | find . -name '*.lambda' -delete 10 | find . -name '*.lambdabin' -delete 11 | find . -name 'whole_program.out' -delete 12 | find . -name 'whole_program.grin' -delete 13 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | --import Hello 3 | import Data.Word 4 | 5 | foreign import ccall "print_int64" print_int64 :: Word64 -> IO () 6 | 7 | {-# NOINLINE test #-} 8 | test :: Int -> IO () 9 | test x = do 10 | print_int64 $ fromIntegral x 11 | 12 | main = do 13 | putStrLn "hello!" --f 14 | test 1 15 | test 2 16 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/tsumupto/tsumupto.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | #ifdef __HBCC__ 4 | #define print xprint 5 | #endif 6 | 7 | main = print (xsum 0 (upto 1 10000000)) 8 | 9 | upto :: Int -> Int -> [Int] 10 | upto m n = if m > n then [] else m : upto (m+1) n 11 | 12 | xsum :: Int -> [Int] -> Int 13 | xsum n [] = n 14 | xsum n (x:xs) = xsum (n+x) xs 15 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/c.clean: -------------------------------------------------------------------------------- 1 | #reset 2 | 3 | set -x -e 4 | 5 | #GRINGHCPATH=/home/csaba/haskell/grin-compiler/ghc-grin/ghc-8.11.0.20200215-src/_build/stage1/bin 6 | 7 | #rm -fr .stack-root/setup-exe-cache 8 | #rm -fr .stack-root/setup-exe-src 9 | 10 | stack --stack-root `pwd`/.stack-root clean 11 | 12 | #rm -fr .stack-work 13 | 14 | #time stack --stack-root `pwd`/.stack-root build 15 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/bench.sh: -------------------------------------------------------------------------------- 1 | 2 | mkdir prof 3 | set -e 4 | reset 5 | echo "GRIN Boquist benchmark set" 6 | 7 | for prog in nfib tsumupto sieve queens words puzzle tak exp3_8 awards sorting cichelli event clausify ida typecheck boyer2 8 | do 9 | stackl exec -- perf stat -e instructions:u -o prof/${prog}.prof $prog 10 | #stackl exec -- perf stat -d -d -d -o prof/${prog}.prof $prog 11 | done 12 | -------------------------------------------------------------------------------- /external-stg/data-con-from-type: -------------------------------------------------------------------------------- 1 | -- | Attempts to tease a type apart into a type constructor and the application 2 | -- of a number of arguments to that constructor 3 | splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type]) 4 | 5 | -- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no 6 | -- constructors could be found 7 | tyConDataCons :: TyCon -> [DataCon] 8 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/tak/tak.hs: -------------------------------------------------------------------------------- 1 | -- code of unknown provenance (partain 95/01/25) 2 | module Main(main) where 3 | 4 | #ifdef __HBCC__ 5 | #define print xprint 6 | #endif 7 | 8 | tak :: Int -> Int -> Int -> Int 9 | 10 | tak x y z = if not(y < x) then z 11 | else tak (tak (x-1) y z) 12 | (tak (y-1) z x) 13 | (tak (z-1) x y) 14 | 15 | main = print (tak 24 16 8) 16 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/clausify/Changes: -------------------------------------------------------------------------------- 1 | - remove Ix. 2 | - add type signature to tautclause. 3 | - add type signature to insert (hbcc bug). 4 | - inRange -> inrange (no Ord). 5 | - exhaustive patterns (conjunct, disin, negin, clause', split'). 6 | - Prelude repeat (no letrec). 7 | - Prelude take, elem (specialize, hbcc bug). 8 | - Hand specialise insert (eliminates last Ord/Eq stuff). 9 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/sum-list/sum.hs: -------------------------------------------------------------------------------- 1 | import Prelude hiding (sum) 2 | 3 | data List a 4 | = Nil 5 | | Cons a (List a) 6 | 7 | main = print $ sum $ upto 1 100000 8 | 9 | upto :: Int -> Int -> List Int 10 | upto m n = if m > n 11 | then Nil 12 | else Cons m $ upto (m+1) n 13 | 14 | sum :: List Int -> Int 15 | sum l = case l of 16 | Nil -> 0 17 | Cons n ns -> n + sum ns 18 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/awards/awards.stdout: -------------------------------------------------------------------------------- 1 | [("Simon", [("Gold", (74, [19, 34, 21])), ("Gold", (102, [35, 27, 40]))]), ("Hans", [("Gold", (70, [45, 17, 8])), ("Bronze", (52, [23, 19, 10]))]), ("Phil", [("Gold", (70, [1, 35, 34])), ("Silver", (60, [18, 21, 21])), ("Bronze", (55, [20, 19, 16]))]), ("Kevin", [("Gold", (72, [9, 54, 9])), ("Gold", (72, [17, 41, 14])), ("Bronze", (59, [23, 18, 18]))])] 2 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-15.0 2 | 3 | # due to functor-infix 4 | allow-newer: true 5 | 6 | packages: 7 | # - 'ghc-primop-lib' 8 | # - 'ghc-primop-gen' 9 | - 'external-stg' 10 | - 'external-stg-util' 11 | # - 'ghc-grin' 12 | # - 'lambda-grin' 13 | 14 | build: 15 | test-arguments: 16 | additional-args: 17 | - "--seed=11010" 18 | 19 | ghc-options: 20 | external-stg: -DEXT_STG_FOR_NON_PATCHED_GHC 21 | -------------------------------------------------------------------------------- /cmm-info: -------------------------------------------------------------------------------- 1 | https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/cmm-type 2 | https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/cmm-syntax 3 | https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/cmm 4 | 5 | Stack Traces in Haskell 6 | ARASH ROUHANI 7 | https://www.arashrouhani.com/papers/master-thesis.pdf 8 | 9 | Low Level Virtual Machine for Glasgow Haskell Compiler 10 | David Terei 11 | https://llvm.org/pubs/2009-10-TereiThesis.pdf 12 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/stack.yaml.boq-bench: -------------------------------------------------------------------------------- 1 | resolver: lts-15.6 2 | 3 | allow-newer: true 4 | 5 | extra-path: 6 | - /home/csaba/haskell/ghc-gitlab/ghc-8.11.0.20200222-src-git-fromSTG-Quickest/ghc-8.11.0.20200222-src/_build/stage1/bin 7 | 8 | packages: 9 | - 'boquist-grin-bench' 10 | 11 | 12 | # Turn on system GHC 13 | system-ghc: true 14 | skip-ghc-check: true 15 | 16 | dump-logs: all 17 | 18 | build: 19 | keep-tmp-files: true 20 | cabal-verbose: true 21 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/basic/basic04.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | foreign import ccall "_prim_int_print" prim_int_print :: Int -> IO () 4 | 5 | data IntList 6 | = Nil 7 | | Cons Int IntList 8 | 9 | main = prim_int_print (xsum 0 (upto 1 10)) 10 | 11 | upto :: Int -> Int -> IntList 12 | upto m n = if m > n then Nil else Cons m (upto (m+1) n) 13 | 14 | xsum :: Int -> IntList -> Int 15 | xsum n Nil = n 16 | xsum n (Cons x xs) = xsum (n+x) xs 17 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/stack.yaml.unordered-containers: -------------------------------------------------------------------------------- 1 | resolver: lts-15.6 2 | 3 | allow-newer: true 4 | 5 | packages: 6 | - 'unordered-containers-0.2.10.0' 7 | 8 | extra-path: 9 | - /home/csaba/haskell/ghc-gitlab/ghc-8.11.0.20200222-src-git-fromSTG-Quickest/ghc-8.11.0.20200222-src/_build/stage1/bin 10 | 11 | # Turn on system GHC 12 | system-ghc: true 13 | skip-ghc-check: true 14 | 15 | dump-logs: all 16 | 17 | build: 18 | keep-tmp-files: true 19 | cabal-verbose: true 20 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/lib/Hello.hs: -------------------------------------------------------------------------------- 1 | module Hello where 2 | 3 | --import Data.Map 4 | import Control.Monad.State 5 | 6 | f :: String 7 | f = evalState (pure "hello") () 8 | 9 | data MyIntList 10 | = IntListCons Int 11 | | IntListNil 12 | 13 | procMyIntList :: MyIntList -> Maybe Int 14 | procMyIntList (IntListCons i) = Just i 15 | procMyIntList IntListNil = Nothing 16 | 17 | myId :: MyIntList -> MyIntList 18 | myId (IntListCons _) = IntListNil 19 | myId IntListNil = IntListCons 0 20 | 21 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/boyer2/Jmakefile: -------------------------------------------------------------------------------- 1 | SRCS_HS=Checker.hs Lisplikefns.hs Rewritefns.hs Rulebasetext.hs Main.hs 2 | OBJS_O= Checker.o Lisplikefns.o Rewritefns.o Rulebasetext.o Main.o 3 | 4 | NoFibMultiModuleCompileAndRun(boyer2,-o1 boyer2.stdout) 5 | 6 | NoFibHaskellCompile(boyer2,Checker,hs) 7 | NoFibHaskellCompile(boyer2,Lisplikefns,hs) 8 | NoFibHaskellCompile(boyer2,Rewritefns,hs) 9 | NoFibHaskellCompile(boyer2,Rulebasetext,hs) 10 | NoFibHaskellCompile(boyer2,Main,hs) 11 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/cichelli/Jmakefile: -------------------------------------------------------------------------------- 1 | SRCS_HS=Main.hs Prog.hs Aux.hs Key.lhs Interval.hs 2 | OBJS_O= Main.o Prog.o Aux.o Key.o Interval.o 3 | 4 | NoFibMultiModuleCompileAndRun(cichelli,-o1 cichelli.stdout) 5 | 6 | NoFibHaskellCompile(cichelli,Main,hs) 7 | NoFibHaskellCompile(cichelli,Prog,hs) 8 | NoFibHaskellCompile(cichelli,Aux,hs) 9 | NoFibHaskellCompile(cichelli,Key,lhs) 10 | NoFibHaskellCompile(cichelli,Interval,hs) 11 | 12 | NoFibDependTarget(cichelli, $(SRCS_HS)) 13 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/stack.yaml.smallest: -------------------------------------------------------------------------------- 1 | resolver: lts-15.6 2 | 3 | allow-newer: true 4 | 5 | packages: 6 | - 'app' 7 | - 'lib' 8 | 9 | extra-path: 10 | - /home/csaba/haskell/grin-compiler/ghc-extstg-whole-program-compiler/_build/stage1/bin 11 | 12 | # Turn on system GHC 13 | system-ghc: true 14 | skip-ghc-check: true 15 | 16 | dump-logs: all 17 | 18 | build: 19 | keep-tmp-files: true 20 | cabal-verbose: true 21 | 22 | apply-ghc-options: everything 23 | ghc-options: 24 | "$everything": -split-sections -O0 25 | -------------------------------------------------------------------------------- /lto-stg: -------------------------------------------------------------------------------- 1 | pipeline: 2 | - generate facts per module ; append to file 3 | - run simple DFE ; read back the result (per module?) 4 | - generate code per module 5 | 6 | - compiler app: 7 | - compiles a single stg module 8 | - leaves out dead top level bindings and TyCons 9 | 10 | - driver app: 11 | - collects facts from stg modules 12 | - executes DFE DL 13 | - runs multiple compiler apps 14 | - links the whole app 15 | 16 | #1 Stage: no DFE 17 | - compile modules 18 | - link to app 19 | 20 | #2 Stage 21 | - -------------------------------------------------------------------------------- /lambda-grin/test/c-opt: -------------------------------------------------------------------------------- 1 | reset 2 | rm 002.sum.grin 3 | stack exec -- lambda-grin sum2.lam -o sum.grin 4 | 5 | #stack exec -- grin 004.sum.grin \ 6 | # --dpe -t --sco -t -p --print-hpt-result --print-hpt-code --llvm --save-grin run.grin 7 | 8 | # compiles to constant 9 | #stack exec -- grin 002.sum-tweaked.grin 10 | 11 | # fix: should compile to constant 12 | #stack exec -- grin 002.sum-tweaked2.grin 13 | stack exec -- grin 002.sum.grin 14 | 15 | # requires better hpt ; srutinee tracking in case alternatives 16 | #stack exec -- grin 002.sum-require-precise-hpt.grin 17 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/sum-list/sum-list.cabal: -------------------------------------------------------------------------------- 1 | name: sum-list 2 | version: 0.1.0.0 3 | 4 | license: BSD3 5 | license-file: LICENSE 6 | category: Development 7 | build-type: Simple 8 | cabal-version: >=1.10 9 | 10 | --executable sum 11 | -- build-depends: base 12 | -- main-is: sum.hs 13 | 14 | --executable tsumupto1 15 | -- build-depends: base 16 | -- main-is: tsumupto1.hs 17 | 18 | executable tsumupto2 19 | build-depends: base 20 | main-is: tsumupto2.hs 21 | ghc-options: -O2 22 | -------------------------------------------------------------------------------- /ghc-primop-lib/ghc-primop-lib.cabal: -------------------------------------------------------------------------------- 1 | name: ghc-primop-lib 2 | version: 0.1.0.0 3 | -- synopsis: 4 | -- description: 5 | license: BSD3 6 | author: Csaba Hruska 7 | maintainer: csaba.hruska@gmail.com 8 | -- copyright: 9 | -- category: 10 | build-type: Simple 11 | cabal-version: >=1.10 12 | 13 | library 14 | exposed-modules: GHCPrimOpEval, GHCPrimOp 15 | -- other-modules: 16 | -- other-extensions: 17 | build-depends: base >=4.12 && <4.13 18 | -- hs-source-dirs: 19 | default-language: Haskell2010 20 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boq-custom/info: -------------------------------------------------------------------------------- 1 | int print: 2 | exp3_8 3 | tak 4 | nfib 5 | puzzle 6 | queens 7 | sieve 8 | tsumupto 9 | sorting 10 | 11 | print int list: 12 | words 13 | 14 | TODO: 15 | 16 | print String: 17 | boyer2 18 | clausify 19 | event 20 | ida 21 | typecheck 22 | 23 | print list of (String, Int): 24 | awards 25 | 26 | print (String,Int,[],Char): 27 | cichelli 28 | 29 | PRIMOP support 30 | 31 | primop OK: 32 | queens 33 | exp3 34 | tsumupto 35 | nfib 36 | 37 | many primops: 38 | puzzle 39 | tak 40 | words 41 | sorting 42 | sieve 43 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boq-custom/sieve.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | import RTS 4 | 5 | main = print_int (sum (sieve (upto 2 50000))) 6 | 7 | upto :: Int -> Int -> [Int] 8 | upto m n = if m > n then [] else m : upto (m+1) n 9 | 10 | xfilter :: Int -> [Int] -> [Int] 11 | xfilter y l = case l of 12 | [] -> [] 13 | (x:xs) -> if x `rem` y == 0 14 | then xfilter y xs 15 | else x : xfilter y xs 16 | sieve :: [Int] -> [Int] 17 | sieve l = case l of 18 | [] -> [] 19 | (x:xs) -> x : sieve (xfilter x xs) 20 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/sieve/sieve.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | -- hbcc prelude: 4 | #ifdef __HBCC__ 5 | #include "prel.hs" 6 | #endif 7 | 8 | main = print (sum (sieve (upto 2 50000))) 9 | 10 | upto :: Int -> Int -> [Int] 11 | upto m n = if m > n then [] else m : upto (m+1) n 12 | 13 | xfilter :: Int -> [Int] -> [Int] 14 | xfilter y l = case l of 15 | [] -> [] 16 | (x:xs) -> if x `rem` y == 0 17 | then xfilter y xs 18 | else x : xfilter y xs 19 | sieve :: [Int] -> [Int] 20 | sieve l = case l of 21 | [] -> [] 22 | (x:xs) -> x : sieve (xfilter x xs) 23 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.counts_all: -------------------------------------------------------------------------------- 1 | 343,401,150 724,103,969 1,464,935,563 2 | 70,003,567 919,528,731 1,287,756,238 3 | 445,471,996 2,739,402,544 1,346,790,492 4 | 1,351,158,429 7,837,488,116 6,270,156,262 5 | 215,496,559 1,276,432,886 782,473,011 6 | 1,692,269,593 4,198,491,460 4,253,475,269 7 | 36,155,800 58,649,124 150,474,057 8 | 267,097,385 708,485,203 575,164,670 9 | 195,862 614,995 1,048,362 10 | 16,353,000 63,840,403 47,462,579 11 | 13,412,809 37,399,209 36,382,598 12 | 289,375,168 1,308,814,805 1,785,522,597 13 | 111,195,338 174,846,366 259,989,602 14 | 73,519,679 248,087,123 173,689,714 15 | 26,579,902 112,109,335 1,599,434,352 16 | 161,367,525 331,543,306 475,869,269 17 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/sorting/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Sort 4 | 5 | main = do 6 | cs <- getContents 7 | putStr (mangle "quickSort" cs) 8 | 9 | mangle :: String{-opt-} -> String{-input to sort-} -> String{-output-} 10 | mangle opt inpt 11 | = (unlines . sort . lines) inpt 12 | where 13 | sort = case opt of 14 | "heapSort" -> heapSort 15 | "insertSort" -> insertSort 16 | "mergeSort" -> mergeSort 17 | "quickSort" -> quickSort 18 | "quickSort2" -> quickSort2 19 | "quickerSort" -> quickerSort 20 | "treeSort" -> treeSort 21 | "treeSort2" -> treeSort2 22 | _ -> error ("unrecognized opt: "++opt++"\n") 23 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boq-custom/exp3_8.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | import RTS 4 | 5 | infix 8 ^^^ 6 | 7 | data Nat = Z | S Nat -- deriving (Eq,Ord,Show{-was:Text-}) 8 | 9 | --instance Num Nat where 10 | add :: Nat -> Nat -> Nat 11 | add Z y = y 12 | add (S x) y = S (x `add` y) 13 | 14 | mul :: Nat -> Nat -> Nat 15 | mul x Z = Z 16 | mul x (S y) = (x `mul` y) `add` x 17 | 18 | toNat :: Int -> Nat 19 | toNat x = if x < 1 then Z else S (toNat (x-1)) 20 | 21 | -- partain:sig 22 | int :: Nat -> Int 23 | int Z = 0 24 | int (S x) = 1 + int x 25 | 26 | 27 | (^^^) :: Nat -> Nat -> Nat 28 | x ^^^ Z = S Z 29 | x ^^^ S y = x `mul` (x ^^^ y) 30 | 31 | main = print_int (int (toNat 3 ^^^ toNat 8)) 32 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/boyer2/Makefile: -------------------------------------------------------------------------------- 1 | PROG=boyer2 2 | HBCCFLAGS=-fno-listy-trans 3 | HGC1=-dall 4 | HGC2=-H150M 5 | HGC3=-fstrings 6 | HBCFLAGS= 7 | GHCFLAGS= 8 | RUNFLAGS=-H10M 9 | 10 | include ../../hgc.mk 11 | 12 | # XXX: the C preprocessor breaks Haskell multiline strings! 13 | 14 | # Add hbcc Prelude manually: 15 | boyer2.s: boyer2.hs 16 | cat boyer2.hs prel.hs | sed 's/putStr/xprint/' > boyer2_hgc.hs 17 | $(hgc) -H30M $(HBCCFLAGS) $(XHBCC) boyer2_hgc.hs 18 | $(hgc) -A1M $(HGC1) $(HGC2) $(HGC3) $(XHGC) boyer2_hgc.sx 19 | mv boyer2_hgc.s boyer2.s 20 | 21 | # Remove "-cpp" from default rules: 22 | boyer2.hbc: boyer2.hs 23 | $(hbc) -o $@ $(HBCFLAGS) $(XHBC) $< 24 | 25 | boyer2.ghc: boyer2.hs 26 | $(ghc) -o $@ $(GHCFLAGS) $(XGHC) $< 27 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/exp3_8/exp3_8.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | infix 8 ^^^ 4 | 5 | #ifdef __HBCC__ 6 | #define print xprint 7 | #endif 8 | 9 | data Nat = Z | S Nat -- deriving (Eq,Ord,Show{-was:Text-}) 10 | 11 | --instance Num Nat where 12 | add :: Nat -> Nat -> Nat 13 | add Z y = y 14 | add (S x) y = S (x `add` y) 15 | 16 | mul :: Nat -> Nat -> Nat 17 | mul x Z = Z 18 | mul x (S y) = (x `mul` y) `add` x 19 | 20 | toNat :: Int -> Nat 21 | toNat x = if x < 1 then Z else S (toNat (x-1)) 22 | 23 | -- partain:sig 24 | int :: Nat -> Int 25 | int Z = 0 26 | int (S x) = 1 + int x 27 | 28 | 29 | (^^^) :: Nat -> Nat -> Nat 30 | x ^^^ Z = S Z 31 | x ^^^ S y = x `mul` (x ^^^ y) 32 | 33 | main = print (int (toNat 3 ^^^ toNat 8)) 34 | -------------------------------------------------------------------------------- /lambda-grin/souffle-datalog/PrimOp-CCS.dl: -------------------------------------------------------------------------------- 1 | /* 2 | HINT: is interpreted -/+ 3 | 4 | primop pure 5 | - "getCCSOf#" :: %a -> {"State#" %s} -> {"GHC.Prim.Unit#" T_Addr} 6 | - "getCurrentCCS#" :: %a -> {"State#" %s} -> {"GHC.Prim.Unit#" T_Addr} 7 | + "clearCCS#" :: ({"State#" %s} -> {"GHC.Prim.Unit#" %a}) -> {"State#" %s} -> {"GHC.Prim.Unit#" %a} 8 | */ 9 | 10 | // "clearCCS#" :: ({"State#" %s} -> {"GHC.Prim.Unit#" %a}) -> {"State#" %s} -> {"GHC.Prim.Unit#" %a} 11 | USED("PrimOp-CCS-01") 12 | Called(r, op), 13 | CallPNode1("clearCCS#-wrapped", r, v0, v1_state) :- 14 | op = "clearCCS#", 15 | REACHABLE(r) 16 | Call(r, op, _), 17 | // pass argument to the wrapped function 18 | CallArgument(r, 0, v0), 19 | CallArgument(r, 1, v1_state). 20 | // CHECKED 21 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boq-custom/queens.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | import RTS 4 | 5 | main = print_int (solve 12) 6 | 7 | solve :: Int -> Int 8 | solve nq = length (generate nq nq) 9 | 10 | generate :: Int -> Int -> [[Int]] 11 | generate nq 0 = [[]] 12 | generate nq n = concatMap (add_one nq) (generate nq (n-1)) 13 | 14 | add_one :: Int -> [Int] -> [[Int]] 15 | add_one nq xs = filter ok (map (:xs) (upto 1 nq)) 16 | 17 | ok :: [Int] -> Bool 18 | ok [] = True 19 | ok (x:xs) = safe x 1 xs 20 | 21 | safe :: Int -> Int -> [Int] -> Bool 22 | safe x d [] = True 23 | safe x d (y:ys) = (x /= y) && (x /= y+d) && (x /= y-d) && safe x (d+1) ys 24 | 25 | upto :: Int -> Int -> [Int] 26 | upto m n = if m > n then 27 | [] 28 | else 29 | m : upto (m+1) n 30 | -------------------------------------------------------------------------------- /stg-to-grin: -------------------------------------------------------------------------------- 1 | approaches: 2 | 3 | # via lambda 4 | 5 | lambda lifting 6 | compile closures to lambda pairs 7 | generate eval / apply for every function 8 | 9 | ## untyped 10 | - syntax directed unboxed primitive values 11 | result: insufficient information, because primitive types are called as code pointers 12 | 13 | - boxed primitive values 14 | result: it works, but leads to inefficient code 15 | 16 | ## typed 17 | - type directed unboxed primitive values 18 | 19 | # direct stg to grin 20 | 21 | possible tricks: 22 | - generate top level closures from closures + P nodes with the bound variables 23 | 24 | Question: 25 | - how to extract information if a value is a primitive type or a boxed value? 26 | 27 | TODO: 28 | done - use resultIsLevPoly 29 | done - export PrimRep for binders to stg-dump 30 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/sorting/prel.hs: -------------------------------------------------------------------------------- 1 | {-# INLINE foldr #-} 2 | foldr :: (a -> b -> b) -> b -> [a] -> b 3 | foldr f = foldr' 4 | where foldr' z [] = z 5 | foldr' z (x:xs) = f x (foldr' z xs) 6 | 7 | --{-# SPECIALIZE sum :: [Int] -> Int #-} 8 | --sum :: (Num a) => [a] -> a 9 | -- hbcc bug! 10 | {-# INLINE sum #-} 11 | sum :: [Int] -> Int 12 | sum l = sum' l 0 13 | where sum' :: [Int] -> Int -> Int 14 | sum' [] a = a 15 | sum' (x:xs) a = sum' xs (a+x) 16 | 17 | {-# INLINE (++) #-} 18 | (++) :: [a] -> [a] -> [a] 19 | (++) = app 20 | where app [] ys = ys 21 | app (x:xs) ys = x : (app xs ys) 22 | 23 | {-# INLINE reverse #-} 24 | reverse :: [a] -> [a] 25 | reverse l = rev l [] 26 | where rev [] a = a 27 | rev (x:xs) a = rev xs (x:a) 28 | 29 | #define print xprint 30 | -------------------------------------------------------------------------------- /ghc-primop-gen/primops-info: -------------------------------------------------------------------------------- 1 | section "Char#" 2 | section "Int#" 3 | section "Word#" 4 | section "Narrowings" 5 | section "Double#" 6 | section "Float#" 7 | section "Arrays" 8 | section "Small Arrays" 9 | section "Byte Arrays" 10 | section "Arrays of arrays" 11 | section "Addr#" 12 | section "Mutable variables" 13 | section "Exceptions" 14 | section "STM-accessible Mutable Variables" 15 | section "Synchronized Mutable Variables" 16 | section "Delay/wait operations" 17 | section "Concurrency primitives" 18 | section "Weak pointers" 19 | section "Stable pointers and names" 20 | section "Compact normal form" 21 | section "Unsafe pointer equality" 22 | section "Parallelism" 23 | section "Tag to enum stuff" 24 | section "Bytecode operations" 25 | section "Misc" 26 | section "Etc" 27 | section "Safe coercions" 28 | section "SIMD Vectors" 29 | section "Prefetch" 30 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-15.0 2 | 3 | allow-newer: true 4 | 5 | packages: 6 | - 'mini-ghc-grin' 7 | 8 | # use custom ext-stg whole program compiler GHC 9 | compiler: ghc-8.11.0.20200524-ext-stg 10 | system-ghc: true 11 | extra-path: 12 | #- /home/csaba/haskell/ghc-gitlab/gitlab-ghc-fresh-may21/ghc/_build/stage1/bin 13 | - /home/csaba/haskell/grin-compiler/ghc-whole-program-compiler/_build/stage1/bin 14 | #- /home/csaba/haskell/grin-compiler/ghc-extstg-whole-program-compiler/_build/stage1/bin 15 | 16 | #dump-logs: all 17 | #build: 18 | # keep-tmp-files: true 19 | # cabal-verbose: true 20 | 21 | ghc-options: 22 | #mini-ghc-grin: -DEXT_STG_FOR_NON_PATCHED_GHC 23 | "$everything": -fno-stgbin -fno-stgapp 24 | 25 | extra-deps: 26 | - async-pool-0.9.1@sha256:4015140f896c3f1652b06a679b0ade2717d05557970c283ea2c372a71be2a6a1,1605 27 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/queens/queens.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | -- hbcc prelude: 4 | #ifdef __HBCC__ 5 | #include "prel.hs" 6 | #endif 7 | 8 | main = print (solve 12) 9 | 10 | solve :: Int -> Int 11 | solve nq = length (generate nq nq) 12 | 13 | generate :: Int -> Int -> [[Int]] 14 | generate nq 0 = [[]] 15 | generate nq n = concatMap (add_one nq) (generate nq (n-1)) 16 | 17 | add_one :: Int -> [Int] -> [[Int]] 18 | add_one nq xs = filter ok (map (:xs) (upto 1 nq)) 19 | 20 | ok :: [Int] -> Bool 21 | ok [] = True 22 | ok (x:xs) = safe x 1 xs 23 | 24 | safe :: Int -> Int -> [Int] -> Bool 25 | safe x d [] = True 26 | safe x d (y:ys) = (x /= y) && (x /= y+d) && (x /= y-d) && safe x (d+1) ys 27 | 28 | upto :: Int -> Int -> [Int] 29 | upto m n = if m > n then 30 | [] 31 | else 32 | m : upto (m+1) n 33 | -------------------------------------------------------------------------------- /external-stg-util/src/Stg/Util.hs: -------------------------------------------------------------------------------- 1 | module Stg.Util 2 | ( -- * Convenient IO 3 | readStgbin, readStgbin', 4 | readStgbinInfo, readStgbinStubs 5 | ) where 6 | 7 | import Prelude hiding (readFile) 8 | 9 | import qualified Data.ByteString.Lazy as BSL 10 | import Data.Binary 11 | import Data.Binary.Get 12 | 13 | import Stg.Syntax 14 | import Stg.Reconstruct 15 | 16 | readStgbin' :: FilePath -> IO SModule 17 | readStgbin' fname = decode <$> BSL.readFile fname 18 | 19 | readStgbin :: FilePath -> IO Module 20 | readStgbin fname = reconModule <$> readStgbin' fname 21 | 22 | readStgbinInfo :: FilePath -> IO (Name, UnitId, ModuleName, ForeignStubs, Bool, [(UnitId, [ModuleName])]) 23 | readStgbinInfo fname = decode <$> BSL.readFile fname 24 | 25 | readStgbinStubs :: FilePath -> IO (Name, UnitId, ModuleName, ForeignStubs) 26 | readStgbinStubs fname = decode <$> BSL.readFile fname 27 | -------------------------------------------------------------------------------- /lambda-stg-loopback: -------------------------------------------------------------------------------- 1 | stgin -> lambda -> lambda2 -> ghc/stg -> ghc codegen 2 | 3 | requirements: 4 | - data con information must be preservered: tag, names, type rep 5 | 6 | TODO: 7 | extend lambda to store this info OR use these info from stgbin directly 8 | 9 | NOTE: 10 | data con names are globally unique 11 | 12 | I have to understand how codegen works for data cons. 13 | All the relevant information needs to be reconstructed and passed to stg/cmm codegen. 14 | 15 | TODO: 16 | top string literals 17 | - it is static data 18 | - it is not callable code 19 | - does not generate PNodes 20 | 21 | data defintions 22 | - data constructior defintion order specifies the tag value 23 | - some primpos relies on this convention 24 | 25 | data cons 26 | - always called saturated 27 | - returns data constructor pointer 28 | - does not generate PNodes 29 | 30 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/app/showGHCStg.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | module Main where 3 | 4 | import Control.Monad 5 | import Control.Monad.IO.Class 6 | 7 | import System.Environment 8 | 9 | import Stg.Util 10 | import Stg.ToStg 11 | 12 | import qualified GHC.Stg.Syntax as GHC 13 | import qualified GHC.Utils.Outputable as GHC 14 | import qualified GHC.Driver.Session as GHC 15 | 16 | import GHC.Paths ( libdir ) 17 | import GHC 18 | 19 | showSDoc :: GHC.SDoc -> String 20 | showSDoc = GHC.showSDoc GHC.unsafeGlobalDynFlags 21 | 22 | main :: IO () 23 | main = runGhc (Just libdir) . liftIO $ do 24 | 25 | stgbins <- getArgs 26 | forM_ stgbins $ \stgbinName -> do 27 | putStrLn $ "reading " ++ stgbinName 28 | extStgModule <- readStgbin stgbinName 29 | let StgModule{..} = toStg extStgModule 30 | putStrLn . showSDoc $ GHC.pprStgTopBindings stgTopBindings 31 | -------------------------------------------------------------------------------- /lambda-grin/souffle-datalog/main.dl: -------------------------------------------------------------------------------- 1 | #define LOG_USED 2 | #define REACHABLE_ONLY 3 | 4 | #ifdef REACHABLE_ONLY 5 | # define REACHABLE(x) Reachable(x), 6 | #else 7 | # define REACHABLE(x) 8 | #endif 9 | 10 | #ifdef LOG_USED 11 | # define USED(x) Used(x), 12 | #else 13 | # define USED(x) 14 | #endif 15 | 16 | #include "AST.dl" 17 | #include "CBy.dl" 18 | #include "CFA.dl" 19 | #include "Check.dl" 20 | #include "LVA.dl" 21 | #include "PointsTo.dl" 22 | #include "PrimOp-Addr.dl" 23 | #include "PrimOp-Arrays.dl" 24 | #include "PrimOp-ByteArray.dl" 25 | #include "PrimOp-Bytecode.dl" 26 | #include "PrimOp-CCS.dl" 27 | #include "PrimOp-Compact.dl" 28 | #include "PrimOp-Concurrency.dl" 29 | #include "PrimOp-Exception.dl" 30 | #include "PrimOp-MutVar.dl" 31 | #include "PrimOp-MVar.dl" 32 | #include "PrimOp-Parallelism.dl" 33 | #include "PrimOp-STM.dl" 34 | #include "PrimOp-StablePtr.dl" 35 | #include "PrimOp-WeakPtr.dl" 36 | -------------------------------------------------------------------------------- /lambda-grin/souffle-datalog/PrimOp-Bytecode.dl: -------------------------------------------------------------------------------- 1 | /* 2 | primop pure 3 | "addrToAny#" :: T_Addr -> {"GHC.Prim.Unit#" %a} 4 | "anyToAddr#" :: %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" T_Addr} 5 | "mkApUpd0#" :: {"BCO#"} -> {"GHC.Prim.Unit#" %a} 6 | 7 | primop effectful 8 | "newBCO#" :: {"ByteArray#"} -> {"ByteArray#"} -> {"Array#" %a} -> T_Int64 -> {"ByteArray#"} -> {"State#" %s} -> {"GHC.Prim.Unit#" {"BCO#"}} 9 | 10 | primop pure 11 | "unpackClosure#" :: %a -> {"GHC.Prim.(#,,#)" T_Addr {"ByteArray#"} {"Array#" %b}} 12 | "getApStackVal#" :: %a -> T_Int64 -> {"GHC.Prim.(#,#)" T_Int64 %b} 13 | */ 14 | 15 | // Future work 16 | 17 | Error(r, "Unsupported (reachable) bytecode related primop") :- 18 | ( op = "addrToAny#" 19 | ; op = "anyToAddr#" 20 | ; op = "mkApUpd0#" 21 | ; op = "newBCO#" 22 | ; op = "unpackClosure#" 23 | ; op = "getApStackVal#" 24 | ), 25 | Call(r, op, _), 26 | HasInst(f, r), 27 | ReachableCode(f). 28 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/stack.yaml.idris-master: -------------------------------------------------------------------------------- 1 | resolver: lts-15.6 2 | 3 | allow-newer: true 4 | 5 | packages: 6 | 7 | - 'Idris-dev-master' 8 | - 'regex-base-0.94.0.0' 9 | - 'unordered-containers-0.2.10.0' 10 | 11 | flags: 12 | idris: 13 | FFI: true 14 | GMP: true 15 | 16 | extra-deps: 17 | - primitive-0.7.0.1 18 | - cheapskate-0.1.1.2@sha256:b8ae3cbb826610ea45e6840b7fde0af2c2ea6690cb311edfe9683f61c0a50d96,3072 19 | - base-noprelude-4.13.0.0@sha256:3cccbfda38e1422ca5cc436d58858ba51ff9114d2ed87915a6569be11e4e5a90,6842 20 | - jira-wiki-markup-1.3.0 21 | 22 | # use custom ext-stg whole program compiler GHC 23 | compiler: ghc-8.11.0.20200524-ext-stg 24 | system-ghc: true 25 | extra-path: 26 | - /home/csaba/haskell/ghc-gitlab/gitlab-ghc-fresh-may21/ghc/_build/stage1/bin 27 | 28 | #dump-logs: all 29 | #build: 30 | # keep-tmp-files: true 31 | # cabal-verbose: true 32 | 33 | apply-ghc-options: everything 34 | ghc-options: 35 | "$everything": -split-sections -O0 36 | -------------------------------------------------------------------------------- /lambda-grin/src/Lambda/live_def_analysis.dl: -------------------------------------------------------------------------------- 1 | .symbol_type Name 2 | 3 | // input fatcs 4 | .decl ConGroup(group:Name, con:Name) 5 | .input ConGroup 6 | 7 | .decl ConReference(def:Name, con:Name) 8 | .input ConReference 9 | 10 | .decl DefReference(def:Name, ref:Name) 11 | .input DefReference 12 | 13 | .decl LiveSource(name:Name) 14 | .input LiveSource 15 | 16 | // output fatcs 17 | .decl LiveDefName(name:Name) 18 | .output LiveDefName 19 | 20 | .decl LiveGroupName(group:Name) 21 | .output LiveGroupName 22 | 23 | // internal fatcs 24 | .decl LiveConName(con:Name) 25 | 26 | // calculate live defs 27 | LiveDefName(n) :- 28 | LiveSource(n). 29 | 30 | LiveDefName(ref) :- 31 | DefReference(n, ref), 32 | LiveDefName(n). 33 | 34 | // calculate live cons 35 | LiveConName(n) :- 36 | LiveSource(n). 37 | 38 | LiveConName(con) :- 39 | ConReference(def, con), 40 | LiveDefName(def). 41 | 42 | // calculate live con groups 43 | LiveGroupName(group) :- 44 | ConGroup(group, con), 45 | LiveConName(con). 46 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/stack.yaml.pandoc-master: -------------------------------------------------------------------------------- 1 | resolver: lts-15.6 2 | 3 | allow-newer: true 4 | 5 | # use custom ext-stg whole program compiler GHC 6 | compiler: ghc-8.11.0.20200524-ext-stg 7 | system-ghc: true 8 | extra-path: 9 | - /home/csaba/haskell/ghc-gitlab/gitlab-ghc-fresh-may21/ghc/_build/stage1/bin 10 | 11 | packages: 12 | 13 | - 'memory-0.15.0' 14 | - 'hxt-9.3.1.18' 15 | - 'HTTP-4000.3.14' 16 | - 'hxt-regex-xmlschema-9.2.0.3' 17 | - 'basement-0.0.11' 18 | - 'pandoc-master' 19 | - 'regex-base-0.94.0.0' 20 | - 'unordered-containers-0.2.10.0' 21 | 22 | extra-deps: 23 | - primitive-0.7.0.1 24 | - cheapskate-0.1.1.2@sha256:b8ae3cbb826610ea45e6840b7fde0af2c2ea6690cb311edfe9683f61c0a50d96,3072 25 | - base-noprelude-4.13.0.0@sha256:3cccbfda38e1422ca5cc436d58858ba51ff9114d2ed87915a6569be11e4e5a90,6842 26 | - jira-wiki-markup-1.3.0 27 | 28 | #dump-logs: all 29 | #build: 30 | # keep-tmp-files: true 31 | # cabal-verbose: true 32 | 33 | apply-ghc-options: everything 34 | ghc-options: 35 | "$everything": -split-sections -O0 36 | -------------------------------------------------------------------------------- /external-stg/external-stg.cabal: -------------------------------------------------------------------------------- 1 | name: external-stg 2 | version: 0.1.0.0 3 | synopsis: A library to dump GHC's STG representation. 4 | 5 | license: BSD3 6 | license-file: LICENSE 7 | author: Csaba Hruska 8 | maintainer: csaba.hruska@gmail.com 9 | copyright: (c) 2018 Csaba Hruska 10 | category: Development 11 | build-type: Simple 12 | tested-with: GHC==8.6.2 13 | cabal-version: >=1.10 14 | 15 | library 16 | other-modules: GHC.Prelude 17 | exposed-modules: 18 | -- Stg.UnariseType 19 | -- Stg.Convert 20 | Stg.Syntax 21 | ghc-options: -Wall -DEXT_STG_PACKAGE 22 | other-extensions: GeneralizedNewtypeDeriving 23 | build-depends: base, 24 | bytestring, 25 | filepath, 26 | binary, 27 | containers, 28 | transformers, 29 | ghc 30 | default-language: Haskell2010 31 | -------------------------------------------------------------------------------- /lambda-grin/souffle-datalog/PointsTo.dl: -------------------------------------------------------------------------------- 1 | // propagates inferred properties 2 | 3 | .decl PointsTo(src:Variable, dst:Variable) 4 | .output PointsTo 5 | 6 | USED("PointsTo-01") 7 | NodeOrigin(src, value) :- 8 | PointsTo(src, dst), 9 | NodeOrigin(dst, value). 10 | // CHECKED 11 | 12 | USED("PointsTo-02") 13 | ExternalOrigin(src, value, tn) :- 14 | PointsTo(src, dst), 15 | ExternalOrigin(dst, value, tn). 16 | // CHECKED 17 | 18 | USED("PointsTo-03") 19 | PNode(src, pap_f, pap_ar, pap_rem) :- 20 | PointsTo(src, dst), 21 | PNode(dst, pap_f, pap_ar, pap_rem). 22 | // CHECKED 23 | 24 | USED("PointsTo-04") 25 | PNodeArgument(src, pap_f, pap_i, pap_value) :- 26 | PointsTo(src, dst), 27 | PNodeArgument(dst, pap_f, pap_i, pap_value). 28 | // CHECKED 29 | 30 | // handling of external sub structure result & external sub structure pattern match 31 | 32 | .decl TypeVarPointsTo(result:Variable, ty_var:Variable, dst:Variable) 33 | .output TypeVarPointsTo 34 | 35 | USED("PointsTo-05") 36 | PointsTo(src, dst) :- 37 | ExternalOrigin(src, r, t), 38 | TypeVarPointsTo(r, t, dst). 39 | // CHECKED 40 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/queens/prel.hs: -------------------------------------------------------------------------------- 1 | {-# INLINE map #-} 2 | map :: (a -> b) -> [a] -> [b] 3 | map f = map' 4 | where map' [] = [] 5 | map' (x:xs) = f x : map' xs 6 | 7 | {-# INLINE concatMap #-} 8 | concatMap :: (a -> [b]) -> [a] -> [b] 9 | concatMap f = concatMap' 10 | where concatMap' [] = [] 11 | concatMap' (x:xs) = f x ++ concatMap' xs 12 | 13 | -- list concatenation (right-associative) 14 | {-# INLINE (++) #-} 15 | (++) :: [a] -> [a] -> [a] 16 | (++) = app 17 | where app [] ys = ys 18 | app (x:xs) ys = x : (app xs ys) 19 | 20 | {-# INLINE filter #-} 21 | filter :: (a -> Bool) -> [a] -> [a] 22 | filter f = filter' 23 | where filter' [] = [] 24 | filter' (x:xs) = if f x then 25 | x : filter' xs 26 | else 27 | filter' xs 28 | 29 | {-# INLINE length #-} 30 | length :: [a] -> Int 31 | length l = len l 0 32 | where len :: [a]->Int->Int 33 | len [] a = a 34 | len (_:xs) a = len xs (a+1) 35 | 36 | #define print xprint 37 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-15.6 2 | 3 | allow-newer: true 4 | 5 | # use custom ext-stg whole program compiler GHC 6 | compiler: ghc-8.11.0.20200524-ext-stg 7 | system-ghc: true 8 | extra-path: 9 | - /home/csaba/haskell/ghc-gitlab/gitlab-ghc-fresh-may21/ghc/_build/stage1/bin 10 | 11 | packages: 12 | 13 | - 'Agda-2.6.1' 14 | 15 | - 'unordered-containers-0.2.10.0' 16 | - 'alex-3.2.5' 17 | - 'regex-base-0.94.0.0' 18 | 19 | extra-deps: 20 | - primitive-0.7.0.1 21 | - data-hash-0.2.0.1@sha256:0277d99cb8b535ecc375c59e55f1c91faab966d9167a946ef18445dd468ba727,1135 22 | - equivalence-0.3.5@sha256:aedbd070b7ab5e58dd1678cd85607bc33cb9ff62331c1fa098ca45063b3072db,1626 23 | - geniplate-mirror-0.7.7@sha256:6a698c1bcec25f4866999001c4de30049d4f8f00ec83f8930cda2f767489c637,1106 24 | - STMonadTrans-0.4.4@sha256:437eec4fdf5f56e9cd4360e08ed7f8f9f5f02ff3f1d634a14dbc71e890035387,1946 25 | 26 | flags: 27 | transformers-compat: 28 | five-three: true 29 | 30 | #dump-logs: all 31 | #build: 32 | # keep-tmp-files: true 33 | # cabal-verbose: true 34 | 35 | apply-ghc-options: everything 36 | ghc-options: 37 | "$everything": -split-sections -O0 38 | -------------------------------------------------------------------------------- /lambda-grin/test/ParserSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, QuasiQuotes, OverloadedStrings #-} 2 | module ParserSpec where 3 | 4 | import qualified Data.Text as Text 5 | import Test.Hspec 6 | import Test.QuickCheck 7 | 8 | import Lambda.TH 9 | import Lambda.Pretty 10 | import Lambda.Parse 11 | import Lambda.Syntax 12 | import Grin.Pretty (PP(..)) 13 | 14 | runTests :: IO () 15 | runTests = hspec spec 16 | 17 | spec :: Spec 18 | spec = do 19 | describe "simple" $ do 20 | it "case" $ do 21 | let before = [prog| 22 | test p = 23 | letS 24 | x = case p of 25 | _ @ alt.1 -> 26 | letS 27 | r = #T_Int64 1 28 | r 29 | x 30 | |] 31 | let after = Program [] [] 32 | [ Def "test" ["p"] 33 | ( LetS 34 | [ ("x", Case "p" 35 | [ Alt "alt.1" DefaultPat 36 | ( LetS [("r", Lit (LInt64 1)) ] (Var "r")) 37 | ] 38 | ) 39 | ] (Var "x") 40 | ) 41 | ] 42 | (PP before) `shouldBe` (PP after) 43 | -------------------------------------------------------------------------------- /sample/IsTypeVariable.facts: -------------------------------------------------------------------------------- 1 | a.0 2 | a.0 3 | b.0 4 | a.0 5 | a.1 6 | a.1 7 | a.2 8 | a.2 9 | s.0 10 | o.0 11 | b.1 12 | b.2 13 | a.3 14 | a.4 15 | a.4 16 | s.1 17 | s.1 18 | a.5 19 | a.5 20 | s.2 21 | a.6 22 | a.6 23 | s.2 24 | a.7 25 | a.8 26 | s.3 27 | a.8 28 | s.3 29 | s.4 30 | a.9 31 | a.9 32 | s.4 33 | s.5 34 | a.10 35 | a.10 36 | s.5 37 | s.6 38 | s.6 39 | s.7 40 | s.8 41 | s.9 42 | o.1 43 | s.10 44 | s.11 45 | s.12 46 | s.12 47 | s.13 48 | s.14 49 | s.15 50 | s.16 51 | s.17 52 | s.18 53 | s.19 54 | s.20 55 | a.11 56 | s.21 57 | a.11 58 | s.21 59 | a.12 60 | a.12 61 | a.13 62 | a.14 63 | a.14 64 | s.22 65 | a.15 66 | s.22 67 | s.23 68 | a.16 69 | a.16 70 | s.23 71 | a.17 72 | s.24 73 | a.17 74 | s.24 75 | a.18 76 | s.25 77 | a.19 78 | b.3 79 | o.2 80 | b.3 81 | a.20 82 | s.26 83 | a.20 84 | s.26 85 | s.27 86 | a.21 87 | c.0 88 | s.28 89 | a.22 90 | a.22 91 | b.4 92 | s.28 93 | s.29 94 | a.23 95 | a.23 96 | s.29 97 | s.30 98 | s.30 99 | b.5 100 | o.3 101 | b.5 102 | c.1 103 | b.6 104 | b.7 105 | a.24 106 | s.31 107 | a.25 108 | s.31 109 | a.25 110 | s.32 111 | s.33 112 | a.26 113 | s.34 114 | a.27 115 | a.27 116 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.a8: -------------------------------------------------------------------------------- 1 | SUBDIR ======> spectral/sorting, OUT=a81 2 | START: 02:35:21 3 | STOP: 02:38:08 4 | SUBDIR ======> spectral/cichelli, OUT=a81 5 | START: 02:38:09 6 | gmake: *** [cichelli.s] Error 1 7 | *************** spectral/cichelli FAIL *************** 8 | SUBDIR ======> spectral/boyer2, OUT=a81 9 | START: 02:39:12 10 | STOP: 02:45:34 11 | SUBDIR ======> spectral/sorting, OUT=a82 12 | START: 02:45:34 13 | gmake: *** [sorting.s] Error 1 14 | *************** spectral/sorting FAIL *************** 15 | SUBDIR ======> spectral/cichelli, OUT=a82 16 | START: 02:47:24 17 | gmake: *** [cichelli.s] Error 1 18 | *************** spectral/cichelli FAIL *************** 19 | SUBDIR ======> spectral/boyer2, OUT=a82 20 | START: 02:48:31 21 | STOP: 02:54:57 22 | SUBDIR ======> spectral/sorting, OUT=a83 23 | START: 02:54:57 24 | gmake: *** [sorting.s] Error 1 25 | *************** spectral/sorting FAIL *************** 26 | SUBDIR ======> spectral/cichelli, OUT=a83 27 | START: 03:06:52 28 | gmake: *** [cichelli.s] Error 1 29 | *************** spectral/cichelli FAIL *************** 30 | SUBDIR ======> spectral/boyer2, OUT=a83 31 | START: 03:08:03 32 | gmake: *** [boyer2.s] Error 1 33 | *************** spectral/boyer2 FAIL *************** 34 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.comp_hgc: -------------------------------------------------------------------------------- 1 | SUBDIR ======> other/nfib 2 | START: 23:33:37 3 | STOP: 23:33:40 4 | SUBDIR ======> other/tsumupto 5 | START: 23:33:41 6 | STOP: 23:33:42 7 | SUBDIR ======> other/sieve 8 | START: 23:33:42 9 | STOP: 23:33:44 10 | SUBDIR ======> other/queens 11 | START: 23:33:44 12 | STOP: 23:33:48 13 | SUBDIR ======> other/words 14 | START: 23:33:48 15 | STOP: 23:34:39 16 | SUBDIR ======> other/puzzle 17 | START: 23:34:39 18 | STOP: 23:36:12 19 | SUBDIR ======> imaginary/tak 20 | START: 23:36:12 21 | STOP: 23:36:13 22 | SUBDIR ======> imaginary/exp3_8 23 | START: 23:36:14 24 | STOP: 23:36:16 25 | SUBDIR ======> spectral/awards 26 | START: 23:36:16 27 | STOP: 23:36:50 28 | SUBDIR ======> spectral/sorting 29 | START: 23:36:50 30 | STOP: 23:39:13 31 | SUBDIR ======> spectral/cichelli 32 | START: 23:39:13 33 | STOP: 23:40:39 34 | SUBDIR ======> spectral/hartel/event 35 | START: 23:40:39 36 | STOP: 23:44:28 37 | SUBDIR ======> spectral/clausify 38 | START: 23:44:28 39 | STOP: 23:47:08 40 | SUBDIR ======> spectral/hartel/ida 41 | START: 23:47:09 42 | STOP: 23:50:35 43 | SUBDIR ======> spectral/hartel/typecheck 44 | START: 23:50:35 45 | STOP: 00:07:14 46 | SUBDIR ======> spectral/boyer2 47 | START: 00:07:14 48 | STOP: 00:12:50 49 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.stats_hgc: -------------------------------------------------------------------------------- 1 | SUBDIR ======> other/nfib 2 | START: 20:25:03 3 | STOP: 20:25:12 4 | SUBDIR ======> other/tsumupto 5 | START: 20:25:12 6 | STOP: 20:25:22 7 | SUBDIR ======> other/sieve 8 | START: 20:25:22 9 | STOP: 20:25:29 10 | SUBDIR ======> other/queens 11 | START: 20:25:29 12 | STOP: 20:25:41 13 | SUBDIR ======> other/words 14 | START: 20:25:42 15 | STOP: 20:27:15 16 | SUBDIR ======> other/puzzle 17 | START: 20:27:15 18 | STOP: 20:29:24 19 | SUBDIR ======> imaginary/tak 20 | START: 20:29:24 21 | STOP: 20:29:29 22 | SUBDIR ======> imaginary/exp3_8 23 | START: 20:29:29 24 | STOP: 20:29:40 25 | SUBDIR ======> spectral/awards 26 | START: 20:29:40 27 | STOP: 20:30:44 28 | SUBDIR ======> spectral/sorting 29 | START: 20:30:44 30 | STOP: 20:34:09 31 | SUBDIR ======> spectral/cichelli 32 | START: 20:34:10 33 | STOP: 20:36:22 34 | SUBDIR ======> spectral/hartel/event 35 | START: 20:36:22 36 | STOP: 20:41:08 37 | SUBDIR ======> spectral/clausify 38 | START: 20:41:09 39 | STOP: 20:44:49 40 | SUBDIR ======> spectral/hartel/ida 41 | START: 20:44:50 42 | STOP: 20:49:14 43 | SUBDIR ======> spectral/boyer2 44 | START: 20:49:14 45 | STOP: 20:58:49 46 | SUBDIR ======> spectral/hartel/typecheck 47 | START: 20:58:50 48 | STOP: 21:17:26 49 | -------------------------------------------------------------------------------- /ghc-primop-gen/ghc-primop-gen.cabal: -------------------------------------------------------------------------------- 1 | Name: ghc-primop-gen 2 | Version: 0.1 3 | Copyright: XXX 4 | License: BSD3 5 | -- XXX License-File: LICENSE 6 | Author: XXX 7 | Maintainer: XXX 8 | Synopsis: Generates various files implementing GHC's primitive operations. 9 | Description: 10 | This utility reads a textual description of GHC's primitive operations 11 | (@primops.txt.pp@) and produces a number of outputs. These include, 12 | . 13 | * the @GHC.Prim@ module included in the @ghc-prim@ package. 14 | * the @GHC.PrimopWrappers@ module included in the @ghc-prim@ package. 15 | * an LaTeX document describing the primitive operations. 16 | Category: Development 17 | build-type: Simple 18 | cabal-version: >=1.10 19 | 20 | library 21 | hs-source-dirs: . genprimopcode 22 | 23 | exposed-modules: Lexer 24 | Parser 25 | ParserM 26 | Syntax 27 | Gen 28 | ghc-options: -Wall 29 | build-depends: base, 30 | array, 31 | containers, 32 | mtl, 33 | ansi-wl-pprint, 34 | pretty-show, 35 | lambda-grin 36 | 37 | default-language: Haskell2010 38 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/puzzle/prel.hs: -------------------------------------------------------------------------------- 1 | {-# INLINE error #-} 2 | error :: String -> a 3 | error s = _error s 4 | 5 | {-# INLINE length #-} 6 | length :: [a] -> Int 7 | length l = len l 0 8 | where len :: [a]->Int->Int 9 | len [] a = a 10 | len (_:xs) a = len xs (a+1) 11 | 12 | {-# INLINE filter #-} 13 | filter :: (a -> Bool) -> [a] -> [a] 14 | filter f = filter' 15 | where filter' [] = [] 16 | filter' (x:xs) = if f x then 17 | x : filter' xs 18 | else 19 | filter' xs 20 | 21 | {-# INLINE foldr #-} 22 | foldr :: (a -> b -> b) -> b -> [a] -> b 23 | foldr f = foldr' 24 | where foldr' z [] = z 25 | foldr' z (x:xs) = f x (foldr' z xs) 26 | 27 | {-# INLINE (++) #-} 28 | (++) :: [a] -> [a] -> [a] 29 | (++) = app 30 | where app [] ys = ys 31 | app (x:xs) ys = x : (app xs ys) 32 | 33 | {-# INLINE all #-} 34 | all :: (a -> Bool) -> [a] -> Bool 35 | all p = all' 36 | where all' [] = True 37 | all' (x:xs) = p x && all' xs 38 | 39 | {-# INLINE map #-} 40 | map :: (a -> b) -> [a] -> [b] 41 | map f = map' 42 | where map' [] = [] 43 | map' (x:xs) = f x : map' xs 44 | 45 | #define print xprint 46 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/typecheck/prel.hs: -------------------------------------------------------------------------------- 1 | {-# INLINE error #-}; 2 | error :: String -> a; 3 | error s = _error s; 4 | 5 | {-# INLINE chr, ord #-}; 6 | ord :: Char -> Int; 7 | chr :: Int -> Char; 8 | ord c = Int# (ord# c); 9 | chr (Int# i) = chr# i; 10 | fromEnum n = ord n; 11 | 12 | {-# INLINE head #-}; 13 | head :: [a] -> a; 14 | head (x:_) = x; 15 | head [] = error "head"; 16 | 17 | {-# INLINE tail #-}; 18 | tail :: [a] -> [a]; 19 | tail (_:xs) = xs; 20 | tail [] = error "tail"; 21 | 22 | {-# INLINE map #-}; 23 | map :: (a -> b) -> [a] -> [b]; 24 | map f = map' 25 | where { map' [] = []; 26 | map' (x:xs) = f x : map' xs}; 27 | 28 | {-# INLINE (++) #-}; 29 | (++) :: [a] -> [a] -> [a]; 30 | (++) = app 31 | where { 32 | app [] ys = ys; 33 | app (x:xs) ys = x : (app xs ys); 34 | }; 35 | 36 | {-# INLINE foldr #-}; 37 | foldr :: (a -> b -> b) -> b -> [a] -> b; 38 | foldr f = foldr' 39 | where { foldr' z [] = z; 40 | foldr' z (x:xs) = f x (foldr' z xs)}; 41 | 42 | {-# INLINE concat #-}; 43 | concat :: [[a]] -> [a]; 44 | concat = conc 45 | where { 46 | conc [] = []; 47 | conc ([]:xss) = conc xss; 48 | conc (xs:xss) = xs ++ conc xss}; 49 | 50 | #define putStr xprint 51 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/README: -------------------------------------------------------------------------------- 1 | Files: 2 | 3 | - comp.sh: benchmarking infrastructure, in the form of shell functions. 4 | - hgc.mk: common Makefile stuff, needs GNU make. 5 | - imaginary/*: nofib benchmark programs, one program per directory. 6 | - spectra/*: nofib benchmark programs, one program per directory. 7 | - other/*: other benchmark programs, one program per directory. 8 | - results/*: raw results for all experiments in the thesis (see comp.sh). 9 | 10 | Some notes: 11 | 12 | - Only those nofib programs used in the thesis are included. 13 | - Most subdirectories contains a file "prel.hs". It contains the Haskell 14 | Prelude functions used by that particular program, and is used by 15 | the GRIN compiler (via CPP). 16 | - Each nofib program has been put in a single source file. The program 17 | in subdirectory foo is called foo.hs. The original source files are left 18 | unchanged (usually called Main.hs, etc.). 19 | - Most nofib subdirectories contains a file "Changes" describing the 20 | changes that has been done to the program, e.g. added Prelude 21 | functions, removed overloading, pattern matching made exhaustive, etc. 22 | - Do not expect the stuff defined in comp.sh/hgc.mk to be immediately runnable. 23 | It contains a lot of details that are specific to my setup. 24 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/event/prel.hs: -------------------------------------------------------------------------------- 1 | {-# INLINE (++) #-}; 2 | (++) :: [a] -> [a] -> [a]; 3 | (++) = app 4 | where { 5 | app [] ys = ys; 6 | app (x:xs) ys = x : (app xs ys)}; 7 | 8 | {-# INLINE length #-}; 9 | length :: [a] -> Int; 10 | length l = len l 0 11 | where { 12 | len :: [a]->Int->Int; 13 | len [] a = a; 14 | len (_:xs) a = len xs (a+1)}; 15 | 16 | {-# INLINE error #-}; 17 | error :: String -> a; 18 | error s = _error s; 19 | 20 | {-# INLINE (!!) #-}; 21 | (!!) :: [a] -> Int -> a; 22 | (!!) = listInd 23 | where { 24 | listInd (x:_) 0 = x; 25 | listInd (_:xs) n = listInd xs (n-1); 26 | listInd [] _ = error "listInd"}; 27 | 28 | {-# INLINE map #-}; 29 | map :: (a -> b) -> [a] -> [b]; 30 | map f = map' 31 | where { map' [] = []; 32 | map' (x:xs) = f x : map' xs}; 33 | 34 | {-# INLINE foldl #-}; 35 | foldl :: (a -> b -> a) -> a -> [b] -> a; 36 | foldl f = loop 37 | where { 38 | loop z [] = z; 39 | loop z (x:xs) = loop (f z x) xs}; 40 | 41 | {-# INLINE concat #-}; 42 | concat :: [[a]] -> [a]; 43 | concat = conc 44 | where { 45 | conc [] = []; 46 | conc ([]:xss) = conc xss; -- for better stack behaviour! 47 | conc (xs:xss) = xs ++ conc xss}; 48 | 49 | #define putStr xprint 50 | -------------------------------------------------------------------------------- /lambda-grin/test/bug01-letS.lam: -------------------------------------------------------------------------------- 1 | upto m n = 2 | let cmp = rts_int_gt m n 3 | case cmp of 4 | (True) -> (Nil) 5 | (False) -> let box1 = (Int 1) 6 | letS succ = rts_int_add m box1 7 | let tail = upto succ n 8 | (Cons m tail) 9 | 10 | sum l = 11 | case l of 12 | (Nil) -> (Int 0) 13 | (Cons n ns) -> let s = sum ns 14 | rts_int_add n s 15 | 16 | grinMain = 17 | let box1 = (Int 1) 18 | box2 = (Int 10) 19 | l = upto box1 box2 20 | s = sum l 21 | rts_int_print s 22 | 23 | -- rts 24 | 25 | rts_int_gt p0$ p1$ = 26 | case p0$ of 27 | (Int i0$) -> 28 | case p1$ of 29 | (Int i1$) -> 30 | letS b0$ = _prim_int_gt i0$ i1$ 31 | case b0$ of 32 | #False -> (False) 33 | #True -> (True) 34 | 35 | rts_int_print p2$ = 36 | case p2$ of 37 | (Int i2$) -> 38 | letS u0$ = _prim_int_print i2$ 39 | (Unit) 40 | 41 | rts_int_add p3$ p4$ = 42 | case p3$ of 43 | (Int i3$) -> 44 | case p4$ of 45 | (Int i4$) -> 46 | letS i5$ = _prim_int_add i3$ i4$ 47 | (Int i5$) 48 | 49 | {- 50 | TODO: 51 | rethink builtin/primitive operations ; int_gt, int_add, int_print 52 | they should generate valid grin code 53 | -} 54 | -------------------------------------------------------------------------------- /lambda-grin/test/sum.lam: -------------------------------------------------------------------------------- 1 | upto m n = 2 | let cmp = rts_int_gt m n 3 | case cmp of 4 | (True) -> (Nil) 5 | (False) -> let box1 = (Int 1) 6 | let succ = rts_int_add m box1 7 | let tail = upto succ n 8 | (Cons m tail) 9 | 10 | sum l1 = 11 | case l1 of 12 | (Nil) -> (Int 0) 13 | (Cons n1 ns) -> let s1 = sum ns 14 | rts_int_add n1 s1 15 | 16 | grinMain = 17 | let box2 = (Int 1) 18 | box3 = (Int 10) 19 | l2 = upto box2 box3 20 | s2 = sum l2 21 | rts_int_print s2 22 | 23 | -- rts 24 | 25 | rts_int_gt p0$ p1$ = 26 | case p0$ of 27 | (Int i0$) -> 28 | case p1$ of 29 | (Int i1$) -> 30 | letS b0$ = _prim_int_gt i0$ i1$ 31 | case b0$ of 32 | #False -> (False) 33 | #True -> (True) 34 | 35 | rts_int_print p2$ = 36 | case p2$ of 37 | (Int i2$) -> 38 | letS u0$ = _prim_int_print i2$ 39 | (Unit) 40 | 41 | rts_int_add p3$ p4$ = 42 | case p3$ of 43 | (Int i3$) -> 44 | case p4$ of 45 | (Int i4$) -> 46 | letS i5$ = _prim_int_add i3$ i4$ 47 | (Int i5$) 48 | 49 | {- 50 | TODO: 51 | rethink builtin/primitive operations ; int_gt, int_add, int_print 52 | they should generate valid grin code 53 | -} 54 | -------------------------------------------------------------------------------- /lambda-grin/test/sum3.lam: -------------------------------------------------------------------------------- 1 | upto m n = 2 | let cmp = rts_int_gt m n 3 | case cmp of 4 | (True) -> (Nil) 5 | (False) -> let box1 = (Int 1) 6 | letS succ = rts_int_add m box1 7 | let tail = upto succ n 8 | (Cons m tail) 9 | 10 | sum l1 = 11 | case l1 of 12 | (Nil) -> (Int 0) 13 | (Cons n1 ns) -> let s1 = sum ns 14 | rts_int_add n1 s1 15 | 16 | grinMain = 17 | let box2 = (Int 1) 18 | box3 = (Int 10) 19 | l2 = upto box2 box3 20 | s2 = sum l2 21 | rts_int_print s2 22 | 23 | -- rts 24 | 25 | rts_int_gt p0$ p1$ = 26 | case p0$ of 27 | (Int i0$) -> 28 | case p1$ of 29 | (Int i1$) -> 30 | letS b0$ = _prim_int_gt i0$ i1$ 31 | case b0$ of 32 | #False -> (False) 33 | #True -> (True) 34 | 35 | rts_int_print p2$ = 36 | case p2$ of 37 | (Int i2$) -> 38 | letS u0$ = _prim_int_print i2$ 39 | (Unit) 40 | 41 | rts_int_add p3$ p4$ = 42 | case p3$ of 43 | (Int i3$) -> 44 | case p4$ of 45 | (Int i4$) -> 46 | letS i5$ = _prim_int_add i3$ i4$ 47 | (Int i5$) 48 | 49 | {- 50 | TODO: 51 | rethink builtin/primitive operations ; int_gt, int_add, int_print 52 | they should generate valid grin code 53 | -} 54 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/src/Stg/DeadFunctionElimination.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards, LambdaCase, TupleSections, OverloadedStrings #-} 2 | module Stg.DeadFunctionElimination where 3 | 4 | import Data.Maybe 5 | import Data.Set (Set) 6 | import qualified Data.Set as Set 7 | import Data.Map (Map) 8 | import qualified Data.Map as Map 9 | import qualified Data.ByteString.Char8 as BS8 10 | import Control.Monad 11 | 12 | import System.IO 13 | import System.FilePath 14 | import System.Directory 15 | 16 | import Stg.Syntax 17 | 18 | 19 | {- 20 | collect top level names defs <---> top-level/external names references 21 | 22 | to collect: 23 | - top-name => [referred top level name] 24 | - top-name => [referred type con] 25 | - top-name => [referred data con] 26 | 27 | TODO: 28 | done - datalog analysis 29 | 30 | done - save facts for an stgbin 31 | done - use globally unique names (program global) 32 | done - export live fun sources i.e. foreign exported top level names 33 | 34 | PIPELINE: 35 | - generate facts for stgbin if it does not exists [cached] 36 | - feed facts to datalog 37 | Q: use haskell souffle or not? 38 | A: try haskell souffle, use it! 39 | - write result file for each stgbin 40 | done - use liveness result in the concurrent code generator 41 | -} 42 | 43 | -------------------------------------------------------------------------------- /GHC-IR.md: -------------------------------------------------------------------------------- 1 | # GHC IR (Core, PrimOps, etc.) 2 | 3 | http://bgamari.github.io/posts/2015-01-19-understanding-ghc-core.html 4 | https://purelyfunctional.org/slides/writing_fast_haskell.pdf 5 | 6 | ## Coercions 7 | 8 | https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/Coercions 9 | https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/FC 10 | 11 | 12 | ## RTS 13 | 14 | https://www.microsoft.com/en-us/research/wp-content/uploads/1998/01/new-rts.pdf 15 | 16 | ## Demand Analysis 17 | 18 | https://www.fpcomplete.com/blog/2017/09/all-about-strictness 19 | http://fixpt.de/blog/2017-12-04-strictness-analysis-part-1.html 20 | http://fixpt.de/blog/2018-12-30-strictness-analysis-part-2.html 21 | 22 | https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/demand 23 | https://www.microsoft.com/en-us/research/wp-content/uploads/2017/03/demand-jfp-draft.pdf 24 | 25 | ## Cmm 26 | [[ny-haskell] Who Ya Gonna Call? Getting Dirty with Cmm, the GHC backend, and writing new PrimOps with Carter Schonwald (video)](https://vimeo.com/69025829) 27 | https://takenobu-hs.github.io/downloads/haskell_ghc_illustrated.pdf 28 | https://en.wikipedia.org/wiki/C--#References 29 | https://www.cs.tufts.edu/~nr/c--/extern/man2.pdf 30 | http://www.scs.stanford.edu/11au-cs240h/notes/ghc.html 31 | https://llvm.org/pubs/2009-10-TereiThesis.pdf 32 | 33 | -------------------------------------------------------------------------------- /lambda-grin/test/sum2.lam: -------------------------------------------------------------------------------- 1 | upto m n = 2 | let cmp = rts_int_gt m n 3 | case cmp of 4 | (True) -> (Nil) 5 | (False) -> let box1 = (Int 1) 6 | let succ = rts_int_add m box1 7 | let tail = upto succ n 8 | (Cons m tail) 9 | 10 | sum a1 l1 = 11 | case l1 of 12 | (Nil) -> a1 13 | (Cons n1 ns) -> let a2 = rts_int_add n1 a1 14 | sum a2 ns 15 | 16 | grinMain = 17 | let box2 = (Int 1) 18 | box3 = (Int 10) 19 | box4 = (Int 0) 20 | l2 = upto box2 box3 21 | s2 = sum box4 l2 22 | rts_int_print s2 23 | 24 | -- rts 25 | 26 | rts_int_gt p0$ p1$ = 27 | case p0$ of 28 | (Int i0$) -> 29 | case p1$ of 30 | (Int i1$) -> 31 | letS b0$ = _prim_int_gt i0$ i1$ 32 | case b0$ of 33 | #False -> (False) 34 | #True -> (True) 35 | 36 | rts_int_print p2$ = 37 | case p2$ of 38 | (Int i2$) -> 39 | letS u0$ = _prim_int_print i2$ 40 | (Unit) 41 | 42 | rts_int_add p3$ p4$ = 43 | case p3$ of 44 | (Int i3$) -> 45 | case p4$ of 46 | (Int i4$) -> 47 | letS i5$ = _prim_int_add i3$ i4$ 48 | (Int i5$) 49 | 50 | {- 51 | TODO: 52 | rethink builtin/primitive operations ; int_gt, int_add, int_print 53 | they should generate valid grin code 54 | -} 55 | -------------------------------------------------------------------------------- /external-stg-util/external-stg-util.cabal: -------------------------------------------------------------------------------- 1 | name: external-stg-util 2 | version: 0.1.0.0 3 | synopsis: Handy tools for working with @external-stg@ dumps. 4 | --description: 5 | license: BSD3 6 | license-file: LICENSE 7 | author: Csaba Hruska 8 | maintainer: csaba.hruska@gmail.com 9 | copyright: (c) 2020 Csaba Hruska 10 | category: Development 11 | build-type: Simple 12 | cabal-version: >=1.10 13 | 14 | library 15 | exposed-modules: Stg.Util 16 | Stg.Pretty 17 | Stg.Reconstruct 18 | hs-source-dirs: src 19 | build-depends: base < 5.0, 20 | external-stg, 21 | bytestring, 22 | unordered-containers, 23 | hashable, 24 | ansi-wl-pprint, 25 | binary 26 | default-language: Haskell2010 27 | 28 | executable ext-stg 29 | hs-source-dirs: app 30 | main-is: Main.hs 31 | build-depends: base < 5.0, 32 | external-stg, 33 | external-stg-util, 34 | ansi-wl-pprint, 35 | bytestring, 36 | optparse-applicative 37 | default-language: Haskell2010 38 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/src/Stg/ext-stg-liveness.dl: -------------------------------------------------------------------------------- 1 | .symbol_type Name 2 | 3 | // input fatcs 4 | .decl TyCon(tycon:Name, datacon:Name) 5 | .input TyCon 6 | 7 | .decl TyConReference(fun:Name, tycon:Name) 8 | .input TyConReference 9 | 10 | .decl DataConReference(fun:Name, datacon:Name) 11 | .input DataConReference 12 | 13 | .decl FunReference(fun:Name, funref:Name) 14 | .input FunReference 15 | 16 | .decl LiveSource(fun:Name) 17 | .input LiveSource 18 | 19 | // output fatcs 20 | .decl LiveFunName(fun:Name) 21 | .output LiveFunName 22 | 23 | .decl LiveTyConName(tycon:Name) 24 | .output LiveTyConName 25 | 26 | .decl LiveDataConName(datacon:Name) 27 | .output LiveDataConName 28 | 29 | // calculate live functions 30 | LiveFunName(fun) :- 31 | LiveSource(fun). 32 | 33 | LiveFunName(ref) :- 34 | LiveFunName(fun), 35 | FunReference(fun, ref). 36 | 37 | // calculate live data cons 38 | LiveDataConName(fun) :- 39 | LiveSource(fun). 40 | 41 | LiveDataConName(datacon) :- 42 | LiveFunName(fun), 43 | DataConReference(fun, datacon). 44 | 45 | // calculate live type cons 46 | LiveTyConName(tycon) :- 47 | LiveDataConName(datacon), 48 | TyCon(tycon, datacon). 49 | 50 | LiveTyConName(tycon) :- 51 | LiveFunName(fun), 52 | TyConReference(fun, tycon). 53 | 54 | 55 | 56 | // temp hack: keep all datacons live 57 | LiveDataConName(datacon) :- 58 | TyCon(_, datacon). 59 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/awards/prel.hs: -------------------------------------------------------------------------------- 1 | {-# INLINE error #-} 2 | error :: String -> a 3 | error s = _error s 4 | 5 | {-# INLINE map #-} 6 | map :: (a -> b) -> [a] -> [b] 7 | map f = map' 8 | where map' [] = [] 9 | map' (x:xs) = f x : map' xs 10 | 11 | {-# INLINE filter #-} 12 | filter :: (a -> Bool) -> [a] -> [a] 13 | filter f = filter' 14 | where filter' [] = [] 15 | filter' (x:xs) = if f x then 16 | x : filter' xs 17 | else 18 | filter' xs 19 | 20 | {-# INLINE (++) #-} 21 | (++) :: [a] -> [a] -> [a] 22 | (++) = app 23 | where app [] ys = ys 24 | app (x:xs) ys = x : (app xs ys) 25 | 26 | {-# INLINE head #-} 27 | head :: [a] -> a 28 | head (x:_) = x 29 | head [] = error "head" 30 | 31 | {-# INLINE null #-} 32 | null :: [a] -> Bool 33 | null [] = True 34 | null (_:_) = False 35 | 36 | {-# INLINE reverse #-} 37 | reverse :: [a] -> [a] 38 | reverse l = rev l [] 39 | where rev [] a = a 40 | rev (x:xs) a = rev xs (x:a) 41 | 42 | --{-# SPECIALIZE sum :: [Int] -> Int #-} 43 | --sum :: (Num a) => [a] -> a 44 | -- hbcc bug! 45 | {-# INLINE sum #-} 46 | sum :: [Int] -> Int 47 | sum l = sum' l 0 48 | where sum' :: [Int] -> Int -> Int 49 | sum' [] a = a 50 | sum' (x:xs) a = sum' xs (a+x) 51 | 52 | #define print xprint 53 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/hartel/ida/prel.hs: -------------------------------------------------------------------------------- 1 | {-# INLINE error #-}; 2 | error :: String -> a; 3 | error s = _error s; 4 | 5 | {-# INLINE head #-}; 6 | head :: [a] -> a; 7 | head (x:_) = x; 8 | head [] = error "head"; 9 | 10 | {-# INLINE tail #-}; 11 | tail :: [a] -> [a]; 12 | tail (_:xs) = xs; 13 | tail [] = error "tail"; 14 | 15 | {-# INLINE null #-}; 16 | null :: [a] -> Bool; 17 | null [] = True; 18 | null (_:_) = False; 19 | 20 | {-# INLINE length #-}; 21 | length :: [a] -> Int; 22 | length l = len l 0 23 | where { len :: [a]->Int->Int; 24 | len [] a = a; 25 | len (_:xs) a = len xs (a+1)}; 26 | 27 | {-# INLINE map #-}; 28 | map :: (a -> b) -> [a] -> [b]; 29 | map f = map' 30 | where { map' [] = []; 31 | map' (x:xs) = f x : map' xs}; 32 | 33 | {-# INLINE foldl #-}; 34 | foldl :: (a -> b -> a) -> a -> [b] -> a; 35 | foldl f = loop 36 | where { 37 | loop z [] = z; 38 | loop z (x:xs) = loop (f z x) xs}; 39 | 40 | {-# INLINE concat #-}; 41 | concat :: [[a]] -> [a]; 42 | concat = conc 43 | where { 44 | conc [] = []; 45 | conc ([]:xss) = conc xss; -- for better stack behaviour! 46 | conc (xs:xss) = xs ++ conc xss}; 47 | 48 | 49 | {-# INLINE (++) #-}; 50 | (++) :: [a] -> [a] -> [a]; 51 | (++) = app 52 | where { 53 | app [] ys = ys; 54 | app (x:xs) ys = x : (app xs ys);}; 55 | 56 | #define putStr xprint 57 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.comp_hbc: -------------------------------------------------------------------------------- 1 | SUBDIR ======> other/nfib 2 | hbc -static -O -msparc8 -cpp -o nfib.hbc nfib.hs 3 | SUBDIR ======> other/tsumupto 4 | hbc -static -O -msparc8 -cpp -o tsumupto.hbc tsumupto.hs 5 | SUBDIR ======> other/sieve 6 | hbc -static -O -msparc8 -cpp -o sieve.hbc sieve.hs 7 | SUBDIR ======> other/queens 8 | hbc -static -O -msparc8 -cpp -o queens.hbc queens.hs 9 | SUBDIR ======> other/words 10 | hbc -static -O -msparc8 -cpp -o words.hbc words.hs 11 | SUBDIR ======> other/puzzle 12 | hbc -static -O -msparc8 -cpp -o puzzle.hbc puzzle.hs 13 | SUBDIR ======> imaginary/tak 14 | hbc -static -O -msparc8 -cpp -o tak.hbc tak.hs 15 | SUBDIR ======> imaginary/exp3_8 16 | hbc -static -O -msparc8 -cpp -o exp3_8.hbc exp3_8.hs 17 | SUBDIR ======> spectral/awards 18 | hbc -static -O -msparc8 -cpp -o awards.hbc awards.hs 19 | SUBDIR ======> spectral/boyer2 20 | hbc -static -O -msparc8 -o boyer2.hbc boyer2.hs 21 | SUBDIR ======> spectral/cichelli 22 | hbc -static -O -msparc8 -cpp -o cichelli.hbc cichelli.hs 23 | SUBDIR ======> spectral/clausify 24 | hbc -static -O -msparc8 -cpp -o clausify.hbc clausify.hs 25 | SUBDIR ======> spectral/hartel/event 26 | hbc -static -O -msparc8 -cpp -o event.hbc event.hs 27 | SUBDIR ======> spectral/hartel/typecheck 28 | hbc -static -O -msparc8 -cpp -o typecheck.hbc typecheck.hs 29 | SUBDIR ======> spectral/sorting 30 | hbc -static -O -msparc8 -cpp -o sorting.hbc sorting.hs 31 | -------------------------------------------------------------------------------- /lambda-grin/souffle-datalog/PrimOp-StablePtr.dl: -------------------------------------------------------------------------------- 1 | /* 2 | HINT: is interpreted -/+ 3 | 4 | primop effectful 5 | + "makeStablePtr#" :: %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" {"StablePtr#" %a}} 6 | + "deRefStablePtr#" :: {"StablePtr#" %a} -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" %a} 7 | - "eqStablePtr#" :: {"StablePtr#" %a} -> {"StablePtr#" %a} -> T_Int64 8 | - "makeStableName#" :: %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" {"StableName#" %a}} 9 | 10 | primop pure 11 | - "eqStableName#" :: {"StableName#" %a} -> {"StableName#" %b} -> T_Int64 12 | - "stableNameToInt#" :: {"StableName#" %a} -> T_Int64 13 | 14 | */ 15 | 16 | .decl StablePtr(item:Variable) 17 | .output StablePtr 18 | 19 | // "makeStablePtr#" :: %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" {"StablePtr#" %a}} 20 | // new stable ptr 21 | USED("PrimOp-StablePtr-01") 22 | Called(r, op), 23 | StablePtr(item) :- 24 | op = "makeStablePtr#", 25 | REACHABLE(r) 26 | Call(r, op, _), 27 | // initial item 28 | CallArgument(r, 0, item). 29 | // CHECKED 30 | 31 | // "deRefStablePtr#" :: {"StablePtr#" %a} -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" %a} 32 | USED("PrimOp-StablePtr-02") 33 | Called(r, op), 34 | TypeVarPointsTo(r, ty_node, item) :- 35 | op = "deRefStablePtr#", 36 | REACHABLE(r) 37 | Call(r, op, _), 38 | // lookup stable ptr items 39 | StablePtr(item), 40 | // lookup result node 41 | RetTup1Node0(op, ty_node). 42 | // CHECKED 43 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/cichelli/prel.hs: -------------------------------------------------------------------------------- 1 | {-# INLINE error #-} 2 | error :: String -> a 3 | error s = _error s 4 | 5 | {-# INLINE map #-} 6 | map :: (a -> b) -> [a] -> [b] 7 | map f = map' 8 | where map' [] = [] 9 | map' (x:xs) = f x : map' xs 10 | 11 | {-# INLINE head #-} 12 | head :: [a] -> a 13 | head (x:_) = x 14 | head [] = error "head" 15 | 16 | {-# INLINE last #-} 17 | last :: [a] -> a 18 | last l = last' l 19 | where last' :: [a] -> a 20 | last' [] = error "last" 21 | last' (x:xs) = case xs of 22 | [] -> x 23 | _:_ -> last' xs 24 | 25 | {-# INLINE length #-} 26 | length :: [a] -> Int 27 | length l = len l 0 28 | where len :: [a]->Int->Int 29 | len [] a = a 30 | len (_:xs) a = len xs (a+1) 31 | 32 | {-# INLINE foldr #-} 33 | foldr :: (a -> b -> b) -> b -> [a] -> b 34 | foldr f = foldr' 35 | where foldr' z [] = z 36 | foldr' z (x:xs) = f x (foldr' z xs) 37 | 38 | {-# INLINE (++) #-} 39 | (++) :: [a] -> [a] -> [a] 40 | (++) = app 41 | where app [] ys = ys 42 | app (x:xs) ys = x : (app xs ys) 43 | 44 | {-# INLINE concat #-} 45 | concat :: [[a]] -> [a] 46 | concat = conc 47 | where 48 | conc [] = [] 49 | conc ([]:xss) = conc xss -- for better stack behaviour! 50 | conc (xs:xss) = xs ++ conc xss 51 | 52 | {-# INLINE all #-} 53 | all :: (a -> Bool) -> [a] -> Bool 54 | all p = all' 55 | where all' [] = True 56 | all' (x:xs) = p x && all' xs 57 | 58 | #define print xprint 59 | -------------------------------------------------------------------------------- /lambda-grin/test/lambda-cg-bug01.grin: -------------------------------------------------------------------------------- 1 | upto m n = 2 | cmp <- store (Frts_int_gt m n) 3 | value.0 <- eval cmp 4 | case value.0 of 5 | (CTrue) -> 6 | pure (CNil) 7 | (CFalse) -> 8 | box1 <- store (CInt 1) 9 | succ <- rts_int_add m box1 -- ERROR: this should be stored on the heap 10 | tail <- store (Fupto succ n) 11 | pure (CCons m tail) 12 | 13 | sum l = 14 | value.1 <- eval l 15 | case value.1 of 16 | (CNil) -> 17 | pure (CInt 0) 18 | (CCons n ns) -> 19 | s <- store (Fsum ns) 20 | rts_int_add n s 21 | 22 | grinMain = 23 | box1 <- store (CInt 1) 24 | box2 <- store (CInt 10) 25 | l <- store (Fupto box1 box2) 26 | s <- store (Fsum l) 27 | rts_int_print s 28 | 29 | rts_int_gt p0$ p1$ = 30 | value.2 <- eval p0$ 31 | case value.2 of 32 | (CInt i0$) -> 33 | value.3 <- eval p1$ 34 | case value.3 of 35 | (CInt i1$) -> 36 | b0$ <- _prim_int_gt i0$ i1$ 37 | value.4 <- pure b0$ 38 | case value.4 of 39 | #False -> 40 | pure (CFalse) 41 | #True -> 42 | pure (CTrue) 43 | 44 | rts_int_print p2$ = 45 | value.5 <- eval p2$ 46 | case value.5 of 47 | (CInt i2$) -> 48 | u0$ <- _prim_int_print i2$ 49 | pure (CUnit) 50 | 51 | rts_int_add p3$ p4$ = 52 | value.6 <- eval p3$ 53 | case value.6 of 54 | (CInt i3$) -> 55 | value.7 <- eval p4$ 56 | case value.7 of 57 | (CInt i4$) -> 58 | i5$ <- _prim_int_add i3$ i4$ 59 | pure (CInt i5$) 60 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/app/genObj.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | module Main where 3 | 4 | import Control.Monad 5 | import Control.Monad.IO.Class 6 | 7 | import System.Environment 8 | 9 | import StgLoopback 10 | 11 | import Stg.Util 12 | import Stg.ToStg 13 | import Stg.DeadFunctionElimination.StripModule 14 | 15 | import qualified GHC.Driver.Types as GHC 16 | 17 | import GHC 18 | import GHC.Paths ( libdir ) 19 | 20 | {- 21 | = StgModule 22 | { stgUnitId :: UnitId 23 | , stgModuleName :: ModuleName 24 | , stgModuleTyCons :: [TyCon] 25 | , stgTopBindings :: [StgTopBinding] 26 | , stgForeignStubs :: ForeignStubs 27 | , stgForeignFiles :: [(ForeignSrcLang, FilePath)] 28 | } 29 | -} 30 | 31 | main :: IO () 32 | main = runGhc (Just libdir) $ do 33 | let cg = NCG 34 | 35 | stgbins <- liftIO getArgs 36 | forM_ stgbins $ \stgbinName -> do 37 | extStgModule <- liftIO $ do 38 | putStrLn $ stgbinName 39 | readStgbin stgbinName 40 | 41 | strippedExtModule <- liftIO $ tryStripDeadParts {-stgbinName-}"." extStgModule -- TODO: fix liveness input name 42 | 43 | let StgModule{..} = toStg strippedExtModule 44 | oName = stgbinName ++ ".o" 45 | --liftIO $ putStrLn $ "compiling " ++ oName 46 | --putStrLn $ unlines $ map show stgIdUniqueMap 47 | 48 | -- HINT: the stubs are compiled at link time 49 | compileToObjectM cg stgUnitId stgModuleName GHC.NoStubs stgModuleTyCons stgTopBindings oName 50 | 51 | -- TODO: simplify API to: compileToObject cg stgModule oName 52 | -------------------------------------------------------------------------------- /lambda-grin/test/001.from-lambda.grin: -------------------------------------------------------------------------------- 1 | upto m n = 2 | cmp <- store (Frts_int_gt m n) 3 | value.0 <- eval cmp 4 | case value.0 of 5 | (CTrue) -> 6 | pure (CNil) 7 | (CFalse) -> 8 | box1 <- store (CInt 1) 9 | succ <- store (Frts_int_add m box1) 10 | tail <- store (Fupto succ n) 11 | pure (CCons m tail) 12 | 13 | sum a1 l1 = 14 | value.1 <- eval l1 15 | case value.1 of 16 | (CNil) -> 17 | eval a1 18 | (CCons n1 ns) -> 19 | a2 <- store (Frts_int_add n1 a1) 20 | sum a2 ns 21 | 22 | grinMain = 23 | box2 <- store (CInt 1) 24 | box3 <- store (CInt 10) 25 | box4 <- store (CInt 0) 26 | l2 <- store (Fupto box2 box3) 27 | s2 <- store (Fsum box4 l2) 28 | rts_int_print s2 29 | 30 | rts_int_gt p0$ p1$ = 31 | value.2 <- eval p0$ 32 | case value.2 of 33 | (CInt i0$) -> 34 | value.3 <- eval p1$ 35 | case value.3 of 36 | (CInt i1$) -> 37 | b0$ <- _prim_int_gt i0$ i1$ 38 | value.4 <- pure b0$ 39 | case value.4 of 40 | #False -> 41 | pure (CFalse) 42 | #True -> 43 | pure (CTrue) 44 | 45 | rts_int_print p2$ = 46 | value.5 <- eval p2$ 47 | case value.5 of 48 | (CInt i2$) -> 49 | u0$ <- _prim_int_print i2$ 50 | pure (CUnit) 51 | 52 | rts_int_add p3$ p4$ = 53 | value.6 <- eval p3$ 54 | case value.6 of 55 | (CInt i3$) -> 56 | value.7 <- eval p4$ 57 | case value.7 of 58 | (CInt i4$) -> 59 | i5$ <- _prim_int_add i3$ i4$ 60 | pure (CInt i5$) 61 | -------------------------------------------------------------------------------- /external-stg/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, Csaba Hruska 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 Ben Gamari nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /external-stg-util/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020, Csaba Hruska 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 Ben Gamari nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/app/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Ben Gamari 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 Ben Gamari nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/basic/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Csaba Hruska 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 Ben Gamari nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/lib/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Ben Gamari 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 Ben Gamari nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/sum-list/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Csaba Hruska 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 Ben Gamari nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/app/grin-test-app.cabal: -------------------------------------------------------------------------------- 1 | name: grin-test-app 2 | version: 0.1.0.0 3 | synopsis: An AST and compiler plugin for dumping GHC's Core representation. 4 | description: 5 | @ghc-dump@ is a library, GHC plugin, and set of tools for recording and 6 | analysing GHC's Core representation. The plugin is compatible with GHC 7.10 7 | through 8.3, exporting a consistent (albeit somewhat lossy) representation 8 | across these versions. The AST is encoded as CBOR, which is small and easy to 9 | deserialise. 10 | . 11 | This package provides the AST and compiler plugin. See the @ghc-dump-util@ 12 | package for a useful command-line tool for working with dumps produced by this 13 | plugin. 14 | . 15 | = Usage 16 | . 17 | "GhcDump.Plugin" provides a Core-to-Core plugin which dumps a representation 18 | of the Core AST to a file after every Core-to-Core pass. To use it, simply 19 | install this package and add @-fplugin GhcDump.Plugin@ to your GHC 20 | command-line. See the [README](https://github.com/bgamari/ghc-dump) 21 | for further analysis tips. 22 | 23 | license: BSD3 24 | license-file: LICENSE 25 | author: Ben Gamari 26 | maintainer: ben@well-typed.com 27 | copyright: (c) 2017 Ben Gamari 28 | category: Development 29 | build-type: Simple 30 | tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 31 | cabal-version: >=1.10 32 | 33 | executable hello 34 | build-depends: 35 | base, 36 | grin-test-lib 37 | main-is: 38 | Main.hs 39 | other-modules: 40 | Util 41 | c-sources: 42 | main_c_lib.c 43 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boq-custom/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999, Urban Boquist 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 Ben Gamari nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999, Urban Boquist 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 Ben Gamari nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ghc-grin/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Andor Pénzes, Csaba Hruska 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 Csaba Hruska, Peter Divianszky nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /lambda-grin/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Andor Pénzes, Csaba Hruska 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 Csaba Hruska, Peter Divianszky nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020, Csaba Hruska 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 Csaba Hruska, Peter Divianszky nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/lib/grin-test-lib.cabal: -------------------------------------------------------------------------------- 1 | name: grin-test-lib 2 | version: 0.1.0.0 3 | synopsis: An AST and compiler plugin for dumping GHC's Core representation. 4 | description: 5 | @ghc-dump@ is a library, GHC plugin, and set of tools for recording and 6 | analysing GHC's Core representation. The plugin is compatible with GHC 7.10 7 | through 8.3, exporting a consistent (albeit somewhat lossy) representation 8 | across these versions. The AST is encoded as CBOR, which is small and easy to 9 | deserialise. 10 | . 11 | This package provides the AST and compiler plugin. See the @ghc-dump-util@ 12 | package for a useful command-line tool for working with dumps produced by this 13 | plugin. 14 | . 15 | = Usage 16 | . 17 | "GhcDump.Plugin" provides a Core-to-Core plugin which dumps a representation 18 | of the Core AST to a file after every Core-to-Core pass. To use it, simply 19 | install this package and add @-fplugin GhcDump.Plugin@ to your GHC 20 | command-line. See the [README](https://github.com/bgamari/ghc-dump) 21 | for further analysis tips. 22 | 23 | license: BSD3 24 | license-file: LICENSE 25 | author: Ben Gamari 26 | maintainer: ben@well-typed.com 27 | copyright: (c) 2017 Ben Gamari 28 | category: Development 29 | build-type: Simple 30 | tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 31 | cabal-version: >=1.10 32 | 33 | library 34 | exposed-modules: Hello 35 | ghc-options: -Wall 36 | other-extensions: GeneralizedNewtypeDeriving 37 | build-depends: base, 38 | mtl 39 | default-language: Haskell2010 40 | c-sources: mylib.c 41 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.evals: -------------------------------------------------------------------------------- 1 | SUBDIR ======> other/nfib 2 | STATS: 1 eval, mean=1.0, min=1, max=[1] 3 | SUBDIR ======> other/tsumupto 4 | STATS: 3 eval, mean=1.0, min=1, max=[1, 1, 1] 5 | SUBDIR ======> other/sieve 6 | STATS: 9 eval, mean=1.5555556, min=1, max=[2, 2, 2, 2, 2, 1, 1, 1, 1] 7 | SUBDIR ======> other/queens 8 | STATS: 15 eval, mean=1.6666666, min=1, max=[3, 3, 2, 2, 2, 2, 2, 2, 1, 1] 9 | SUBDIR ======> other/words 10 | STATS: 115 eval, mean=1.9130435, min=1, max=[7, 6, 4, 4, 4, 4, 4, 3, 3, 3] 11 | SUBDIR ======> other/puzzle 12 | STATS: 76 eval, mean=2.5921052, min=1, max=[14, 12, 7, 5, 5, 5, 5, 5, 5, 4] 13 | SUBDIR ======> imaginary/tak 14 | STATS: 1 eval, mean=1.0, min=1, max=[1] 15 | SUBDIR ======> imaginary/exp3_8 16 | STATS: 6 eval, mean=3.6666667, min=1, max=[5, 5, 5, 3, 3, 1] 17 | SUBDIR ======> spectral/awards 18 | STATS: 64 eval, mean=2.546875, min=1, max=[12, 5, 5, 5, 5, 4, 4, 4, 4, 4] 19 | SUBDIR ======> spectral/sorting 20 | STATS: 145 eval, mean=2.3517241, min=1, max=[6, 6, 6, 6, 6, 6, 5, 5, 5, 5] 21 | SUBDIR ======> spectral/cichelli 22 | STATS: 95 eval, mean=2.4421053, min=1, max=[11, 8, 5, 5, 5, 4, 4, 4, 4, 4] 23 | SUBDIR ======> spectral/hartel/event 24 | STATS: 95 eval, mean=4.2526317, min=1, max=[18, 18, 13, 13, 13, 13, 12, 12, 12, 11] 25 | SUBDIR ======> spectral/clausify 26 | STATS: 116 eval, mean=2.663793, min=1, max=[7, 7, 7, 7, 7, 7, 6, 5, 5, 5] 27 | SUBDIR ======> spectral/hartel/ida 28 | STATS: 163 eval, mean=2.619632, min=1, max=[14, 9, 7, 7, 7, 7, 7, 6, 6, 6] 29 | SUBDIR ======> spectral/hartel/typecheck 30 | STATS: 217 eval, mean=3.981567, min=1, max=[40, 21, 21, 21, 20, 19, 19, 18, 18, 18] 31 | SUBDIR ======> spectral/boyer2 32 | STATS: 133 eval, mean=2.9323308, min=1, max=[14, 12, 10, 10, 8, 7, 7, 7, 7, 6] 33 | -------------------------------------------------------------------------------- /lambda-grin/src/Lambda/ControlFlowAnalysisM.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, TupleSections, OverloadedStrings #-} 2 | module Lambda.ControlFlowAnalysisM where 3 | 4 | -- NOTE: only when the whole program is available 5 | 6 | import Control.Monad 7 | import Data.Text (Text) 8 | import qualified Data.Text as Text 9 | import qualified Data.Text.IO as Text 10 | import Data.Map (Map) 11 | import qualified Data.Map as Map 12 | 13 | import System.Directory 14 | import System.FilePath 15 | import System.Process 16 | import System.IO 17 | import System.IO.Temp 18 | 19 | import Lambda.Syntax 20 | import Lambda.ToDatalog 21 | 22 | controlFlowAnalysisM :: [String] -> Program -> IO (Map String [[Text]]) 23 | controlFlowAnalysisM = controlFlowAnalysisImplM False 24 | 25 | controlFlowAnalysisLogM :: [String] -> Program -> IO (Map String [[Text]]) 26 | controlFlowAnalysisLogM = controlFlowAnalysisImplM True 27 | 28 | controlFlowAnalysisImplM :: Bool -> [String] -> Program -> IO (Map String [[Text]]) 29 | controlFlowAnalysisImplM log initialReachable prg = do 30 | 31 | tmpSys <- getCanonicalTemporaryDirectory 32 | tmpCfa <- createTempDirectory tmpSys "lambda-cfa" 33 | 34 | when log $ do 35 | putStrLn "controlFlowAnalysisM:" 36 | putStrLn $ "export facts to:" 37 | putStrLn tmpCfa 38 | 39 | programToFactsM log tmpCfa prg 40 | 41 | let srcFile = tmpCfa "InitialReachable.facts" 42 | when log $ putStrLn srcFile 43 | writeFile srcFile $ unlines initialReachable 44 | 45 | when log $ putStrLn "run: lambda-cfa" 46 | callProcess "lambda-cfa" ["--output=" ++ tmpCfa, "--facts=" ++ tmpCfa, "--jobs=4"] 47 | 48 | when log $ putStrLn "read back result" 49 | result <- filter (\n -> takeExtension n == ".csv") <$> listDirectory tmpCfa 50 | Map.fromList <$> forM result (\fname -> do 51 | row <- map (Text.splitOn "\t") . Text.lines <$> Text.readFile (tmpCfa fname) 52 | pure (takeBaseName fname, row) 53 | ) 54 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/boyer2/Checker.hs: -------------------------------------------------------------------------------- 1 | {- 2 | Haskell version of ... 3 | 4 | ! The Checker module for the Boyer benchmark 5 | ! Started by Tony Kitto on March 30th 1988 6 | 7 | ! Changes Log 8 | ! 07-04-88 ADK Tautp function removed to main body 9 | ! 08-04-88 ADK bug fix = Truep returns True for (t) 10 | ! Falsep returns True for (f) 11 | 12 | Haskell version:: 13 | 14 | 23-06-93 JSM initial version 15 | 16 | -} 17 | 18 | module Checker (tautologyp) where 19 | 20 | import Lisplikefns 21 | 22 | tautologyp :: (Lisplist, Lisplist, Lisplist) -> Bool 23 | tautologyp (Nil, _, _) = False 24 | tautologyp (term@(Atom x), truelst, _) = truep (term, truelst) 25 | tautologyp (term@(Cons (x, y)), truelst, falselst) = 26 | if truep (term, truelst) then True 27 | else if falsep (term, falselst) then False 28 | else case x of 29 | Atom "if" -> if truep (car y, truelst) then 30 | tautologyp (cadr y, truelst, falselst) 31 | else if falsep (car y, falselst) then 32 | tautologyp (caddr y, truelst, falselst) 33 | else 34 | (tautologyp (cadr y, Cons (car y, truelst), falselst)) && 35 | (tautologyp (caddr y, truelst, Cons (car y, falselst))) 36 | _ -> False 37 | 38 | truep :: (Lisplist, Lisplist) -> Bool 39 | truep (Nil, _) = False 40 | truep (Cons (Atom "t", Nil), _) = True 41 | truep (term, l) = lispmember (term, l) 42 | 43 | falsep :: (Lisplist, Lisplist) -> Bool 44 | falsep (Nil, _) = False 45 | falsep (Cons (Atom "f", Nil), _) = True 46 | falsep (term, l) = lispmember (term, l) 47 | 48 | lispmember :: (Lisplist, Lisplist) -> Bool 49 | lispmember (e, Cons (x, xs)) | e == x = True 50 | | otherwise = lispmember (e, xs) 51 | 52 | lispmember (_, _) = False 53 | 54 | 55 | -------------------------------------------------------------------------------- /ghc-grin/src/Lambda/GHCSymbols.hs: -------------------------------------------------------------------------------- 1 | module Lambda.GHCSymbols where 2 | 3 | liveSymbols = 4 | -- base 5 | [ "base_Control.Exception.Base.absentSumFieldError" 6 | , "base_Control.Exception.Base.nestedAtomically" 7 | , "base_Control.Exception.Base.nonTermination" 8 | , "base_GHC.Conc.IO.ensureIOManagerIsRunning" 9 | , "base_GHC.Conc.IO.ioManagerCapabilitiesChanged" 10 | , "base_GHC.Conc.Signal.runHandlersPtr" 11 | , "base_GHC.Conc.Sync.runSparks" 12 | , "base_GHC.Event.Thread.blockedOnBadFD" 13 | , "base_GHC.Exception.Type.divZeroException" 14 | , "base_GHC.Exception.Type.overflowException" 15 | , "base_GHC.Exception.Type.underflowException" 16 | , "base_GHC.Int.I16#" 17 | , "base_GHC.Int.I32#" 18 | , "base_GHC.Int.I64#" 19 | , "base_GHC.Int.I8#" 20 | , "base_GHC.IO.Exception.allocationLimitExceeded" 21 | , "base_GHC.IO.Exception.blockedIndefinitelyOnMVar" 22 | , "base_GHC.IO.Exception.blockedIndefinitelyOnSTM" 23 | , "base_GHC.IO.Exception.cannotCompactFunction" 24 | , "base_GHC.IO.Exception.cannotCompactMutable" 25 | , "base_GHC.IO.Exception.cannotCompactPinned" 26 | , "base_GHC.IO.Exception.heapOverflow" 27 | , "base_GHC.IO.Exception.stackOverflow" 28 | , "base_GHC.Pack.unpackCString" 29 | , "base_GHC.Ptr.FunPtr" 30 | , "base_GHC.Ptr.Ptr" 31 | , "base_GHC.Stable.StablePtr" 32 | , "base_GHC.TopHandler.flushStdHandles" 33 | , "base_GHC.TopHandler.runIO" 34 | , "base_GHC.TopHandler.runMainIO" 35 | , "base_GHC.TopHandler.runNonIO" 36 | , "base_GHC.Weak.runFinalizerBatch" 37 | , "base_GHC.Word.W16#" 38 | , "base_GHC.Word.W32#" 39 | , "base_GHC.Word.W64#" 40 | , "base_GHC.Word.W8#" 41 | 42 | -- ghc-prim 43 | , "ghc-prim_GHC.Tuple.()" 44 | , "ghc-prim_GHC.Types.C#" 45 | , "ghc-prim_GHC.Types.D#" 46 | , "ghc-prim_GHC.Types.F#" 47 | , "ghc-prim_GHC.Types.False" 48 | , "ghc-prim_GHC.Types.I#" 49 | , "ghc-prim_GHC.Types_True" 50 | , "ghc-prim_GHC.Types.W#" 51 | 52 | -- main 53 | , "main_:Main.main" 54 | ] 55 | -------------------------------------------------------------------------------- /roadmap.ghc-grin: -------------------------------------------------------------------------------- 1 | # MVP 2 | 3 | ## Feature Cut 4 | - no exceptions 5 | - no threads 6 | - ignore / workaround problematic primops (~10 primops) 7 | - no GC 8 | - no weak pointers 9 | - no stable pointers 10 | - no STM 11 | 12 | # Goals 13 | - end-to-end compiler pipeline 14 | - analyze / optimize programs with non problematic primops 15 | - report unsupported primops and features 16 | - codegen simple primops 17 | - codegen and link simple FFI 18 | 19 | 20 | milestone todo - docs 21 | - pateron video 22 | - grin project page 23 | - patreon project page 24 | 25 | milestone todo - programming 26 | - finalize ghc/grin pipeline 27 | - linking phase 28 | - FFI extension 29 | - ghc/grin test framework 30 | 31 | 32 | small step programming TODO: 33 | GHC semantics: 34 | done - what is dynamic target? ; it's a jump to a runtime known Addr (indirect call) 35 | done - is ByteArray treated specially in GHC FFI codegen? YES, see: getFCallArgs 36 | - study Foreign Cmm codegen: StgCmmForeign.hs 37 | - how are coercions related to data representation? 38 | ghc-primop: 39 | done - generate primop prelude for Lambda 40 | done - delete state parameter from prim types i.e. MutVar s a 41 | done - generate primop prelude for GRIN 42 | STG -> Lambda: 43 | done - add externals for primops calls 44 | done - add externals for FFI calls 45 | done - validate if FFI calls use simple types only 46 | done - do not report externals as unknown 47 | done - eliminate wrapper primops (i.e. atomicXXX) 48 | done - allow ByteArray and MutableByteArray arguments as special case in FFI 49 | done - generate code for tagToEnum / add enough type info 50 | done - strip exetrnals for the whole program 51 | - group by kinds of used primiops (simple type / parametric / unsupported) 52 | Lambda -> GRIN: 53 | - map Ty-s properly 54 | - add missing types to GRIN 55 | - add Addr type 56 | - add label as Addr constant 57 | - linker phase 58 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.time_all2.lips: -------------------------------------------------------------------------------- 1 | 6.65 6.34 6.37 6.53 6.44 2 | 2.92 2.94 2.93 2.93 2.90 3 | 1.72 1.73 1.71 1.73 1.72 4 | 5 | 6.33 6.22 6.26 6.30 6.04 6 | 4.03 3.93 3.99 3.91 4.02 7 | 0.11 0.11 0.11 0.11 0.10 8 | 9 | 9.82 9.77 9.94 10.04 10.05 10 | 15.18 15.13 15.11 15.18 15.01 11 | 4.58 4.46 4.45 4.46 4.41 12 | 13 | 30.66 31.05 31.18 31.27 31.33 14 | 37.32 37.00 37.22 37.07 37.05 15 | 6.46 6.48 6.72 6.53 6.46 16 | 17 | 3.80 3.71 3.84 3.85 3.85 18 | 6.89 6.94 6.95 6.86 6.89 19 | 1.22 1.18 1.28 1.21 1.18 20 | 21 | 21.45 21.92 21.24 21.13 21.11 22 | 21.39 21.62 21.55 21.59 21.52 23 | 8.83 8.69 8.72 9.12 8.76 24 | 25 | 0.61 0.61 0.58 0.63 0.63 26 | 0.22 0.22 0.23 0.22 0.22 27 | 0.14 0.14 0.14 0.15 0.13 28 | 29 | 3.30 3.19 3.26 3.19 3.27 30 | 3.60 3.63 3.62 3.62 3.85 31 | 1.40 1.40 1.39 1.32 1.38 32 | 33 | 0.02 0.01 0.00 0.01 0.00 34 | 0.01 0.01 0.02 0.00 0.01 35 | 0.00 0.00 0.01 0.01 0.00 36 | 37 | 10.26 10.04 10.35 9.88 9.80 38 | 6.66 6.59 6.55 6.66 6.55 39 | 1.53 1.54 1.56 1.73 1.65 40 | 41 | 0.24 0.26 0.27 0.25 0.20 42 | 0.33 0.33 0.33 0.30 0.34 43 | 0.07 0.09 0.11 0.08 0.10 44 | 45 | 1.14 1.16 1.06 1.09 1.05 46 | 1.27 1.19 1.10 1.24 1.19 47 | 0.46 0.55 0.41 0.49 0.52 48 | 49 | 1.44 1.42 1.43 1.44 1.49 50 | 0.91 0.91 0.90 0.92 0.94 51 | 0.68 0.65 0.63 0.65 0.69 52 | 53 | 9.38 8.99 9.60 9.56 9.58 54 | 0.44 0.60 0.57 0.56 0.57 55 | 0.21 0.13 0.17 0.22 0.19 56 | 57 | 2.75 2.54 2.71 2.74 2.75 58 | 1.93 2.03 1.97 1.83 2.03 59 | 1.08 1.13 1.06 1.06 0.92 60 | 61 | 0.17 0.18 0.22 0.19 0.24 62 | 0.22 0.24 0.21 0.22 0.21 63 | 0.11 0.07 0.11 0.08 0.10 64 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.time_all2.zoot: -------------------------------------------------------------------------------- 1 | 14.03 14.03 14.05 14.02 14.07 2 | 5.92 5.94 5.80 5.87 5.90 3 | 3.51 3.49 3.58 3.38 3.54 4 | 5 | 12.89 12.87 12.84 12.87 12.85 6 | 7.98 7.93 7.96 7.93 7.97 7 | 0.21 0.21 0.20 0.21 0.21 8 | 9 | 20.45 20.45 20.35 20.29 20.38 10 | 30.50 30.47 30.55 30.49 30.58 11 | 9.24 9.10 9.00 9.29 9.02 12 | 13 | 63.13 63.24 63.24 63.04 63.02 14 | 87.90 87.80 87.70 88.04 89.00 15 | 11.59 11.75 11.46 11.54 11.45 16 | 17 | 7.31 7.35 7.35 7.27 7.37 18 | 14.10 14.02 14.04 13.94 13.98 19 | 2.21 2.34 2.32 2.28 2.26 20 | 21 | 43.16 43.02 42.97 42.99 42.95 22 | 43.59 43.58 43.61 43.58 43.69 23 | 16.11 16.12 16.08 16.23 16.00 24 | 25 | 1.28 1.30 1.31 1.29 1.32 26 | 0.45 0.48 0.48 0.47 0.46 27 | 0.27 0.28 0.29 0.27 0.29 28 | 29 | 6.59 6.60 6.67 6.51 6.47 30 | 7.12 7.10 7.13 7.11 7.12 31 | 2.55 2.39 2.49 2.57 2.42 32 | 33 | 0.00 0.02 0.02 0.01 0.01 34 | 0.00 0.02 0.01 0.02 0.01 35 | 0.01 0.01 0.01 0.01 0.01 36 | 37 | 20.19 20.07 20.20 20.21 20.12 38 | 13.19 13.25 13.23 13.23 13.22 39 | 2.85 2.88 2.76 2.81 2.76 40 | 41 | 0.52 0.45 0.48 0.47 0.48 42 | 0.66 0.65 0.67 0.66 0.67 43 | 0.15 0.17 0.16 0.14 0.17 44 | 45 | 1.91 1.79 1.90 1.86 2.01 46 | 2.44 2.46 2.49 2.53 2.46 47 | 0.84 0.85 0.83 0.88 0.85 48 | 49 | 2.75 2.77 2.67 2.79 2.73 50 | 1.85 1.82 1.83 1.84 1.86 51 | 1.28 1.25 1.22 1.28 1.23 52 | 53 | 17.09 17.02 16.88 17.04 17.08 54 | 1.13 1.17 1.17 1.16 1.15 55 | 0.30 0.33 0.31 0.30 0.26 56 | 57 | 5.20 5.14 5.24 5.28 5.28 58 | 4.02 3.97 3.99 3.98 3.99 59 | 2.06 1.96 1.94 1.96 2.02 60 | 61 | 0.41 0.38 0.39 0.40 0.37 62 | 0.42 0.43 0.42 0.42 0.42 63 | 0.16 0.15 0.15 0.19 0.17 64 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/src/Stg/DeadFunctionElimination/StripModule.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards, LambdaCase, TupleSections, OverloadedStrings #-} 2 | module Stg.DeadFunctionElimination.StripModule where 3 | 4 | import Data.Maybe 5 | import Data.Set (Set) 6 | import qualified Data.Set as Set 7 | import qualified Data.ByteString.Char8 as BS8 8 | 9 | import System.FilePath 10 | import System.Directory 11 | 12 | import Stg.Syntax 13 | 14 | stripDeadParts :: FilePath -> Module -> IO Module 15 | stripDeadParts stgappName mod = do 16 | let liveFunFname = {-stgappName -<.> -}"LiveFunName.csv" 17 | liveDataConFname = {-stgappName -<.> -}"LiveDataConName.csv" 18 | liveFunSet0 <- Set.fromList . BS8.lines <$> BS8.readFile liveFunFname 19 | liveDataConSet <- Set.fromList . BS8.lines <$> BS8.readFile liveDataConFname 20 | let liveFunSet = Set.union liveFunSet0 liveDataConSet 21 | 22 | putStrLn "stripDeadParts" 23 | 24 | let dropDeadBinding :: TopBinding -> Maybe TopBinding 25 | dropDeadBinding tb = case tb of 26 | StgTopLifted (StgNonRec b _) 27 | | Set.member (binderUniqueName b) liveFunSet -> Just tb 28 | | otherwise -> Nothing 29 | 30 | StgTopLifted (StgRec bs) 31 | | lives <- [a | a@(b,_) <- bs, Set.member (binderUniqueName b) liveFunSet] 32 | , not $ null lives 33 | -> Just $ StgTopLifted (StgRec lives) 34 | | otherwise -> Nothing 35 | 36 | StgTopStringLit b l 37 | | Set.member (binderUniqueName b) liveFunSet -> Just tb 38 | | otherwise -> Nothing 39 | 40 | -- TODO: strip stgModuleTyCons 41 | pure mod {moduleTopBindings = catMaybes $ map dropDeadBinding $ moduleTopBindings mod} 42 | 43 | tryStripDeadParts :: FilePath -> Module -> IO Module 44 | tryStripDeadParts stgappName mod = do 45 | let liveFunFname = {-stgappName -<.> -}"LiveFunName.csv" 46 | hasLivenessInfo <- doesFileExist liveFunFname 47 | if hasLivenessInfo 48 | then stripDeadParts stgappName mod 49 | else pure mod 50 | -------------------------------------------------------------------------------- /lambda-grin/souffle-datalog/PrimOp-Concurrency.dl: -------------------------------------------------------------------------------- 1 | /* 2 | HINT: is interpreted -/+ 3 | 4 | primop effectful 5 | + "fork#" :: %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" {"ThreadId#"}} 6 | + "forkOn#" :: T_Int64 -> %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" {"ThreadId#"}} 7 | + "killThread#" :: {"ThreadId#"} -> %a -> {"State#" {RealWorld}} -> {"GHC.Prim.(##)"} 8 | - "yield#" :: {"State#" {RealWorld}} -> {"GHC.Prim.(##)"} 9 | - "myThreadId#" :: {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" {"ThreadId#"}} 10 | - "labelThread#" :: {"ThreadId#"} -> T_Addr -> {"State#" {RealWorld}} -> {"GHC.Prim.(##)"} 11 | - "isCurrentThreadBound#" :: {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" T_Int64} 12 | - "noDuplicate#" :: {"State#" %s} -> {"GHC.Prim.(##)"} 13 | - "threadStatus#" :: {"ThreadId#"} -> {"State#" {RealWorld}} -> {"GHC.Prim.(#,,#)" T_Int64 T_Int64 T_Int64} 14 | */ 15 | 16 | 17 | // "killThread#" :: {"ThreadId#"} -> %a -> {"State#" {RealWorld}} -> {"GHC.Prim.(##)"} 18 | // collect raised exceptions 19 | USED("PrimOp-Concurrency-01") 20 | Called(r, "killThread#"), 21 | RaisedEx(ex) :- 22 | REACHABLE(r) 23 | Call(r, "killThread#", _), 24 | CallArgument(r, 1, ex). 25 | 26 | /* 27 | // "fork#" :: %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" {"ThreadId#"}} 28 | // TODO: ignore the result 29 | USED("PrimOp-Concurrency-02") 30 | Called(r, "fork#"), 31 | ExecCall("fork#-thunk", r, v0, 0) :- 32 | REACHABLE(r) 33 | Call(r, "fork#", _), 34 | CallArgument(r, 0, v0). 35 | 36 | // "forkOn#" :: T_Int64 -> %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" {"ThreadId#"}} 37 | // TODO: ignore the result 38 | USED("PrimOp-Concurrency-03") 39 | Called(r, "forkOn#"), 40 | ExecCall("forkOn#-thunk", r, v0, 0) :- 41 | REACHABLE(r) 42 | Call(r, "forkOn#", _), 43 | CallArgument(r, 1, v0). 44 | */ 45 | 46 | // TODO: future work 47 | Error(r, cat("Unsupported (reachable) primop: ", op)) :- 48 | ( op = "fork#" 49 | ; op = "forkOn#" 50 | ), 51 | REACHABLE(r) 52 | Call(r, op, _). 53 | -------------------------------------------------------------------------------- /external-stg-util/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | import Control.Monad 4 | import Data.Maybe 5 | import Data.List (sortBy) 6 | import Data.Monoid 7 | import Data.Ord 8 | 9 | import Options.Applicative 10 | import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>)) 11 | import qualified Text.PrettyPrint.ANSI.Leijen as PP 12 | import qualified Data.ByteString.Char8 as BS8 13 | 14 | import Stg.Syntax 15 | import Stg.Pretty 16 | import Stg.Util 17 | 18 | 19 | modes :: Parser (IO ()) 20 | modes = subparser 21 | ( mode "show" showMode (progDesc "print Stg") 22 | <> mode "show-prep-core" showPCoreMode (progDesc "print prep Core") 23 | <> mode "show-core" showCoreMode (progDesc "print Core") 24 | <> mode "show-ghc-stg" showGHCStgMode (progDesc "print GHC Stg") 25 | ) 26 | where 27 | mode :: String -> Parser a -> InfoMod a -> Mod CommandFields a 28 | mode name f opts = command name (info (helper <*> f) opts) 29 | 30 | dumpFile :: Parser FilePath 31 | dumpFile = argument str (metavar "DUMP FILE" <> help "STGBIN dump file") 32 | 33 | showMode :: Parser (IO ()) 34 | showMode = 35 | run <$> dumpFile 36 | where 37 | run fname = do 38 | dump <- Stg.Util.readStgbin fname 39 | print $ pprModule dump 40 | 41 | showPCoreMode :: Parser (IO ()) 42 | showPCoreMode = 43 | run <$> dumpFile 44 | where 45 | run fname = do 46 | dump <- Stg.Util.readStgbin fname 47 | putStrLn . BS8.unpack . modulePrepCoreSrc $ dump 48 | 49 | showCoreMode :: Parser (IO ()) 50 | showCoreMode = 51 | run <$> dumpFile 52 | where 53 | run fname = do 54 | dump <- Stg.Util.readStgbin fname 55 | putStrLn . BS8.unpack . moduleCoreSrc $ dump 56 | 57 | showGHCStgMode :: Parser (IO ()) 58 | showGHCStgMode = 59 | run <$> dumpFile 60 | where 61 | run fname = do 62 | dump <- Stg.Util.readStgbin fname 63 | putStrLn . BS8.unpack . moduleStgSrc $ dump 64 | 65 | main :: IO () 66 | main = join $ execParser $ info (helper <*> modes) mempty 67 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/clausify/prel.hs: -------------------------------------------------------------------------------- 1 | -- $Id: prel.hs,v 1.3 1999/02/07 20:28:10 boquist Exp $ 2 | 3 | -- repeat x is an infinite list, with x the value of every element. 4 | repeat :: a -> [a] 5 | --repeat x = xs where xs = x:xs 6 | repeat x = x : repeat x -- XXX no letrec 7 | 8 | {-# SPECIALIZE elem :: Char -> [Char] -> Bool #-} 9 | elem :: (Eq a) => a -> [a] -> Bool 10 | elem _ [] = False 11 | elem x (y:ys) = x==y || elem x ys 12 | 13 | {-# INLINE map #-} 14 | map :: (a -> b) -> [a] -> [b] 15 | map f = map' 16 | where map' [] = [] 17 | map' (x:xs) = f x : map' xs 18 | 19 | {-# INLINE concatMap #-} 20 | concatMap :: (a -> [b]) -> [a] -> [b] 21 | concatMap f = concatMap' 22 | where concatMap' [] = [] 23 | concatMap' (x:xs) = f x ++ concatMap' xs 24 | 25 | {-# INLINE filter #-} 26 | filter :: (a -> Bool) -> [a] -> [a] 27 | filter f = filter' 28 | where filter' [] = [] 29 | filter' (x:xs) = if f x then 30 | x : filter' xs 31 | else 32 | filter' xs 33 | 34 | {-# INLINE foldr #-} 35 | foldr :: (a -> b -> b) -> b -> [a] -> b 36 | foldr f = foldr' 37 | where foldr' z [] = z 38 | foldr' z (x:xs) = f x (foldr' z xs) 39 | 40 | {-# INLINE take #-} 41 | take :: Int -> [b] -> [b] 42 | take = itake 43 | where itake :: Int -> [b] -> [b] 44 | itake 0 _ = [] 45 | itake _ [] = [] 46 | itake n (x:xs) = x : itake (n-1) xs 47 | 48 | {-# INLINE error #-} 49 | error :: String -> a 50 | error s = _error s 51 | 52 | -- list concatenation (right-associative) 53 | {-# INLINE (++) #-} 54 | (++) :: [a] -> [a] -> [a] 55 | (++) = app 56 | where app [] ys = ys 57 | app (x:xs) ys = x : (app xs ys) 58 | 59 | -- concat, applied to a list of lists, returns their flattened concatenation. 60 | {-# INLINE concat #-} 61 | concat :: [[a]] -> [a] 62 | concat = conc 63 | where 64 | conc [] = [] 65 | conc ([]:xss) = conc xss -- for better stack behaviour! 66 | conc (xs:xss) = xs ++ conc xss 67 | 68 | #define putStr xprint 69 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/stack.yaml.save: -------------------------------------------------------------------------------- 1 | resolver: lts-15.6 2 | 3 | allow-newer: true 4 | 5 | extra-path: 6 | - /home/csaba/haskell/ghc-gitlab/ghc-8.11.0.20200222-src-git-fromSTG-Quickest/ghc-8.11.0.20200222-src/_build/stage1/bin 7 | 8 | packages: 9 | - 'app' 10 | - 'lib' 11 | 12 | #- 'sum-list' 13 | 14 | #- 'basic' 15 | #- 'boq-custom' 16 | #- 'boquist-grin-bench' 17 | #- 'miniagda' 18 | #- 'hpp-0.6.1' 19 | #- 'stylish-haskell-0.11.0.0' 20 | #- 'calenderweek-1.0.0' 21 | #- 'pandoc-2.9.2.1' 22 | #- 'idris-1.3.2' 23 | 24 | ############################ 25 | #- 'memory-0.15.0' 26 | #- 'hxt-9.3.1.18' 27 | #- 'HTTP-4000.3.14' 28 | #- 'hxt-regex-xmlschema-9.2.0.3' 29 | #- 'regex-base-0.94.0.0' 30 | #- 'basement-0.0.11' 31 | #- 'pandoc-master' 32 | ############################## 33 | 34 | #- 'Idris-dev-master' 35 | 36 | #- 'Idris-dev-1.3.1' 37 | 38 | #- 'lambdacube-workshop-master/hello' 39 | #- 'lambdacube-workshop-master/hello-obj' 40 | #- 'lambdacube-workshop-master/asteroids' 41 | #- 'lambdacube-workshop-master/lambdacube-obj' 42 | 43 | #- 'lambdacube-quake3-master' 44 | 45 | extra-deps: 46 | - primitive-0.7.0.1 47 | - cheapskate-0.1.1.2@sha256:b8ae3cbb826610ea45e6840b7fde0af2c2ea6690cb311edfe9683f61c0a50d96,3072 48 | - base-noprelude-4.13.0.0@sha256:3cccbfda38e1422ca5cc436d58858ba51ff9114d2ed87915a6569be11e4e5a90,6842 49 | - jira-wiki-markup-1.3.0 50 | 51 | 52 | # - proteaaudio-0.7.0.1 53 | # - vect-0.4.7 54 | # - wavefront-0.7.1.1 55 | # - megaparsec-6.5.0 56 | # - cheapskate-0.1.1 57 | # - haskell-src-exts-1.21.1 58 | 59 | 60 | #- github: lambdacube3d/lambdacube-ir 61 | # commit: 8a0a17abedc9d6b46b41d744c1a2be53efa6336b 62 | # subdirs: 63 | # - lambdacube-ir.haskell 64 | 65 | #- github: lambdacube3d/lambdacube-gl 66 | # commit: 297828bdcf105c5942ed0e43d9f28130f543f34c 67 | 68 | #- github: lambdacube3d/lambdacube-compiler 69 | # commit: dc10dc255638b86f4a20a29a1b492e2415640b60 70 | 71 | 72 | # ok ; Quick (not Quickest) 73 | # - /home/csaba/haskell/ghc-gitlab/gitlab-ghc-fresh/ghc/_build/stage1/bin 74 | 75 | # Turn on system GHC 76 | system-ghc: true 77 | skip-ghc-check: true 78 | 79 | dump-logs: all 80 | 81 | build: 82 | keep-tmp-files: true 83 | cabal-verbose: true 84 | 85 | ghc-options: 86 | boquist-grin-bench: -O2 87 | -------------------------------------------------------------------------------- /lambda-grin/souffle-datalog/PrimOp-Compact.dl: -------------------------------------------------------------------------------- 1 | /* 2 | HINT: is interpreted -/+ 3 | 4 | primop effectful 5 | - "compactNew#" :: T_Word64 -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" {"Compact#"}} 6 | - "compactResize#" :: {"Compact#"} -> T_Word64 -> {"State#" {RealWorld}} -> {"GHC.Prim.(##)"} 7 | 8 | primop pure 9 | - "compactContains#" :: {"Compact#"} -> %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" T_Int64} 10 | - "compactContainsAny#" :: %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" T_Int64} 11 | - "compactGetFirstBlock#" :: {"Compact#"} -> {"State#" {RealWorld}} -> {"GHC.Prim.(#,#)" T_Addr T_Word64} 12 | - "compactGetNextBlock#" :: {"Compact#"} -> T_Addr -> {"State#" {RealWorld}} -> {"GHC.Prim.(#,#)" T_Addr T_Word64} 13 | 14 | primop effectful 15 | - "compactAllocateBlock#" :: T_Word64 -> T_Addr -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" T_Addr} 16 | - "compactFixupPointers#" :: T_Addr -> T_Addr -> {"State#" {RealWorld}} -> {"GHC.Prim.(#,#)" {"Compact#"} T_Addr} 17 | + "compactAdd#" :: {"Compact#"} -> %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" %a} 18 | + "compactAddWithSharing#" :: {"Compact#"} -> %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" %a} 19 | - "compactSize#" :: {"Compact#"} -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" T_Word64} 20 | */ 21 | 22 | // "compactAdd#" :: {"Compact#"} -> %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" %a} 23 | // "compactAddWithSharing#" :: {"Compact#"} -> %a -> {"State#" {RealWorld}} -> {"GHC.Prim.Unit#" %a} 24 | // FIXME: should transitively evaluate the thunks 25 | // probably we should disable this primop (future work) 26 | /* 27 | USED("PrimOp-Compact-01") 28 | Called(r, op), 29 | TypeVarPointsTo(r, ty_node, item) :- 30 | ( op = "compactAdd#" 31 | ; op = "compactAddWithSharing#" 32 | ), 33 | REACHABLE(r) 34 | Call(r, op, _), 35 | // item to bypass 36 | CallArgument(r, 1, item), 37 | // lookup result node 38 | RetTup1Node0(op, ty_node). 39 | */ 40 | // ISSUE: should transitively evaluate the thunks 41 | Error(r, cat("Unsupported (reachable) primop: ", op)) :- 42 | ( op = "compactAdd#" 43 | ; op = "compactAddWithSharing#" 44 | ), 45 | REACHABLE(r) 46 | Call(r, op, _). 47 | -------------------------------------------------------------------------------- /lambda-grin/app/LambdaGrinCLI.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Monad 4 | 5 | import System.Environment 6 | import System.Exit 7 | import qualified Text.Megaparsec as M 8 | 9 | import Lambda.Syntax 10 | import Lambda.Parse 11 | import Lambda.Pretty 12 | import Lambda.Lint 13 | --import Lambda.GrinCodeGenTyped 14 | import Grin.Pretty 15 | import Pipeline.Pipeline 16 | 17 | import Text.PrettyPrint.ANSI.Leijen (ondullblack, plain) 18 | 19 | import qualified Data.ByteString as BS 20 | import Data.Store 21 | 22 | data Opts 23 | = Opts 24 | { inputs :: [FilePath] 25 | , output :: FilePath 26 | } 27 | 28 | showUsage = do putStrLn "Usage: lambda-grin [-o ]" 29 | exitWith ExitSuccess 30 | 31 | getOpts :: IO Opts 32 | getOpts = do xs <- getArgs 33 | return $ process (Opts [] "a.out") xs 34 | where 35 | process opts ("-o":o:xs) = process (opts { output = o }) xs 36 | process opts (x:xs) = process (opts { inputs = x:inputs opts }) xs 37 | process opts [] = opts 38 | 39 | cg_main :: Opts -> IO () 40 | cg_main opts = do 41 | forM_ (inputs opts) $ \fname -> do 42 | {- 43 | content <- readFile fname 44 | let program = either (error . M.parseErrorPretty' content) id $ parseLambda fname content 45 | putStrLn "\n* Lambda" 46 | printLambda program 47 | let lambdaGrin = codegenGrin program 48 | void $ pipeline pipelineOpts lambdaGrin 49 | [ SaveGrin "from-lambda.grin" 50 | , T GenerateEval 51 | , SaveGrin (output opts) 52 | , PrintGrin ondullblack 53 | ] 54 | -} 55 | program <- decodeEx <$> BS.readFile fname :: IO Exp 56 | lintLambda program 57 | let lambdaGrin = undefined -- codegenGrin program 58 | void $ pipeline pipelineOpts Nothing lambdaGrin 59 | [ T TrivialCaseElimination 60 | , T BindNormalisation 61 | , SaveGrin (Rel $ fname ++ ".grin") 62 | , SaveBinary (fname ++ ".grin") 63 | ] 64 | 65 | main :: IO () 66 | main = do opts <- getOpts 67 | if (null (inputs opts)) 68 | then showUsage 69 | else cg_main opts 70 | 71 | pipelineOpts :: PipelineOpts 72 | pipelineOpts = defaultOpts 73 | { _poOutputDir = ".lambda" 74 | , _poFailOnLint = True 75 | } 76 | -------------------------------------------------------------------------------- /lambda-grin/souffle-datalog/PrimOp-Parallelism.dl: -------------------------------------------------------------------------------- 1 | /* 2 | HINT: is interpreted -/+ 3 | 4 | primop effectful 5 | + "par#" :: %a -> T_Int64 6 | + "spark#" :: %a -> {"State#" %s} -> {"GHC.Prim.Unit#" %a} 7 | 8 | primop pure 9 | + "seq#" :: %a -> {"State#" %s} -> {"GHC.Prim.Unit#" %a} 10 | 11 | primop effectful 12 | + "getSpark#" :: {"State#" %s} -> {"GHC.Prim.(#,#)" T_Int64 %a} 13 | - "numSparks#" :: {"State#" %s} -> {"GHC.Prim.Unit#" T_Int64} 14 | */ 15 | #if 0 16 | .decl Spark(item:Variable) 17 | .output Spark 18 | 19 | // "par#" :: %a -> T_Int64 20 | USED("PrimOp-Parallelism-01") 21 | Called(r, "par#"), 22 | Spark(item) :- 23 | REACHABLE(r) 24 | Call(r, "par#", _), 25 | // value 26 | CallArgument(r, 0, item). 27 | 28 | // "spark#" :: %a -> {"State#" %s} -> {"GHC.Prim.Unit#" %a} 29 | USED("PrimOp-Parallelism-02") 30 | Called(r, op), 31 | TypeVarPointsTo(r, ty_node, item), 32 | Spark(item) :- 33 | REACHABLE(r) 34 | op = "spark#", 35 | Call(r, op, _), 36 | // value 37 | CallArgument(r, 0, item), 38 | // extract result node 39 | RetTup1Node0(op, ty_node). 40 | 41 | // "seq#" :: %a -> {"State#" %s} -> {"GHC.Prim.Unit#" %a} 42 | // TODO: ExecCall should support to emit TypeVarPointsTo relations 43 | // ExecCall result can be: none, PointsTo, TypeVarPointsTo 44 | /* 45 | TypeVarPointsTo(r, ty_node, item), 46 | ExecCall("seq#-thunk", r, item, 0) :- 47 | op = "seq#", 48 | Call(r, op, _), 49 | // value 50 | CallArgument(r, 0, item), 51 | // extract result node 52 | RetTup1Node0(op, ty_node). 53 | */ 54 | Error(r, "Unsupported (reachable) primop: seq# (TBD)") :- 55 | Call(r, "seq#", _), 56 | HasInst(f, r), 57 | ReachableCode(f). 58 | 59 | // "getSpark#" :: {"State#" %s} -> {"GHC.Prim.(#,#)" T_Int64 %a} 60 | USED("PrimOp-Parallelism-03") 61 | Called(r, op), 62 | TypeVarPointsTo(r, ty_node, item) :- 63 | op = "getSpark#", 64 | REACHABLE(r) 65 | Call(r, op, _), 66 | // lookup items 67 | Spark(item), 68 | // lookup result node 69 | RetTup(op, "GHC.Prim.(#,#)", 1, ty_node). 70 | 71 | #endif 72 | 73 | // TODO: future work 74 | Error(r, cat("Unsupported (reachable) primop: ", op)) :- 75 | ( op = "par#" 76 | ; op = "spark#" 77 | ; op = "seq#" 78 | ; op = "getSpark#" 79 | ), 80 | REACHABLE(r) 81 | Call(r, op, _). 82 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.size_hgc: -------------------------------------------------------------------------------- 1 | SUBDIR ======> other/nfib 2 | size nfib.o 3 | text data bss dec hex filename 4 | 190 8 0 198 c6 nfib.o 5 | SUBDIR ======> other/tsumupto 6 | size tsumupto.o 7 | text data bss dec hex filename 8 | 126 8 0 134 86 tsumupto.o 9 | SUBDIR ======> other/sieve 10 | size sieve.o 11 | text data bss dec hex filename 12 | 894 20 0 914 392 sieve.o 13 | SUBDIR ======> other/queens 14 | size queens.o 15 | text data bss dec hex filename 16 | 1806 28 0 1834 72a queens.o 17 | SUBDIR ======> other/words 18 | size words.o 19 | text data bss dec hex filename 20 | 9560 2652 0 12212 2fb4 words.o 21 | SUBDIR ======> other/puzzle 22 | size puzzle.o 23 | text data bss dec hex filename 24 | 12742 840 0 13582 350e puzzle.o 25 | SUBDIR ======> imaginary/tak 26 | size tak.o 27 | text data bss dec hex filename 28 | 290 8 0 298 12a tak.o 29 | SUBDIR ======> imaginary/exp3_8 30 | size exp3_8.o 31 | text data bss dec hex filename 32 | 1462 12 0 1474 5c2 exp3_8.o 33 | SUBDIR ======> spectral/awards 34 | size awards.o 35 | text data bss dec hex filename 36 | 9852 1432 0 11284 2c14 awards.o 37 | SUBDIR ======> spectral/sorting 38 | size sorting.o 39 | text data bss dec hex filename 40 | 20282 312 0 20594 5072 sorting.o 41 | SUBDIR ======> spectral/cichelli 42 | size cichelli.o 43 | text data bss dec hex filename 44 | 13882 1868 0 15750 3d86 cichelli.o 45 | SUBDIR ======> spectral/hartel/event 46 | size event.o 47 | text data bss dec hex filename 48 | 27358 1348 0 28706 7022 event.o 49 | SUBDIR ======> spectral/clausify 50 | size clausify.o 51 | text data bss dec hex filename 52 | 19734 1288 0 21022 521e clausify.o 53 | SUBDIR ======> spectral/hartel/ida 54 | size ida.o 55 | text data bss dec hex filename 56 | 27622 780 0 28402 6ef2 ida.o 57 | SUBDIR ======> spectral/hartel/typecheck 58 | size typecheck.o 59 | text data bss dec hex filename 60 | 62124 4944 0 67068 105fc typecheck.o 61 | SUBDIR ======> spectral/boyer2 62 | size boyer2.o 63 | text data bss dec hex filename 64 | 22954 80184 0 103138 192e2 boyer2.o 65 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/cichelli/Key.lhs: -------------------------------------------------------------------------------- 1 | > module Key where 2 | 3 | > keys :: [String] 4 | 5 | YesIts 2470 [('h',0),('d',7),('s',2),('v',6),('c',3),('r',0),('e',3),('t',8)] 6 | 7 | keys = ["expect","respect","conduct","viaduct","tender","render","sender","cinder","vender","ride","confide","tried","visit","restrict","stoic","historic"] 8 | 9 | keys = ["ark","ant","tank","start","aardvark","packaging","park","king","artic","spark", "antartic","prank"] 10 | 11 | keys = [ "a", "and", "are", "as", "at", "be", "but", "by", "for", "from", "had", "have", 12 | "he", "her", "his", "i", "in", "is", "it", "not", "of", "on", "or", "that", 13 | "the", "this", "to", "was", "which", "with", "you" ] 14 | 15 | keys = ["every", "which", "way", "but", "loose"] 16 | 17 | keys = ["aa","aab","b"] 18 | 19 | keys = ["ark","ant","tank","start","aardvark","packaging","park","king"] 20 | 21 | keys = ["not","that","we","warn","of","five"] 22 | 23 | keys = ["apple","banana","peach","apricot","orange","pear","plum","cherry"] 24 | 25 | 26 | keys = ["ark","ant","tank","start","aardvark","packaging","park","king","artic","spark", "antartic","prank"] 27 | 28 | keys = ["aa","bbb","ac","bbbbd","eee","fedb","g","gbb","ae","afff","ccccccc","dabg","ddddddd"] 29 | 30 | keys = ["yak","monkey","mouse","elephant","giraffe","gnu","emu","duck","gunk"] 31 | 32 | ---- Too Big ---- 33 | 34 | keys = ["an","apple","that","does","not","want","to","get", "eaten","will","still","fall","off","the","tree"] 35 | 36 | keys = [ "a", "and", "are", "as", "at", "be", "but", "by", "for", "from", "had", "have", "he", "her", "his", "i", "in", "is", "it", "not", "of", "on", "or", "that", "the", "this", "to", "was", "which", "with", "you" ] 37 | 38 | Names below has a first solution a long long way to the left 39 | 40 | keys = ["john","jane","janet","kate","katy","tony","bert","betty","cathy","carol","timmy","jud 41 | y","ivy","ian","jan","jack","eva","ivan","linda","andy","edna"] 42 | 43 | > keys = ["case","class","data","default","deriving","else","hiding", "if","import","in","infix","infixl","instance","interface", 44 | > "let","module","of","renaming","then","to","type","where"] 45 | 46 | keys = ["This","is","a","very","trivial","data","set","with","very","little","deliberate","contention","of","characters"] 47 | 48 | keys = ["a","aust","t","ta"] 49 | 50 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/awards/Main.hs: -------------------------------------------------------------------------------- 1 | {- 2 | Date: Thu, 22 Jun 95 15:39:44 BST 3 | From: kh@dcs.gla.ac.uk 4 | Message-Id: <9506221439.AA07592@tuvula.dcs.gla.ac.uk> 5 | To: partain@dcs.gla.ac.uk 6 | Subject: nofib submission 7 | Cc: trinder@dcs.gla.ac.uk 8 | 9 | A little program written as a demonstrator to show someone how to solve 10 | a real problem. I make no claims of elegance or efficiency. The data 11 | is fake (Phil may want to improve this!). 12 | 13 | Kevin 14 | -} 15 | 16 | -- In a public award scheme, each entrant can receive awards 17 | -- based on their scores in a number of events. To achieve an 18 | -- award, the competitor must have competed in three events 19 | -- and achieved a total score greater than the fixed threshold 20 | -- for the award. 21 | 22 | -- No score can be counted towards more than one award, 23 | -- but there is no limit on the total number of awards that can be won. 24 | 25 | -- The thresholds for the various awards are: 26 | -- Gold 70 points 27 | -- Silver 60 points 28 | -- Bronze 50 points 29 | 30 | import QSort 31 | import List((\\)) 32 | 33 | -- Generate all possible permutations of length m from a list of scores 34 | perms m [] = [] 35 | perms 1 l = map (: []) l 36 | perms m (n:ns) = map ((:) n) (perms (m-1) ns) ++ perms m ns 37 | 38 | -- Find the (sorted) list of possible awards for a list of scores 39 | awards scores = 40 | award ("Gold",70) ++ award ("Silver",60) ++ award ("Bronze",50) 41 | where sumscores = map (\ p -> (sum p, p)) (perms 3 scores) 42 | atleast threshold = filter (\(sum,p) -> sum >= threshold) sumscores 43 | award (name,threshold) = map (\ ps -> (name,ps)) (sort (atleast threshold)) 44 | 45 | -- Find all possible awards for a list of scores, counting each score once only 46 | findawards scores | null theawards = [] 47 | | otherwise = firstaward : findawards (scores \\ perm) 48 | where firstaward@(award,(sum,perm)) = head theawards 49 | theawards = awards scores 50 | 51 | -- Find the awards for all competitors, each competitor is a pair of 52 | -- (Name, list of scores) 53 | findallawards competitors = 54 | map (\ (name,scores) -> (name,findawards scores)) competitors 55 | 56 | 57 | competitors = [ 58 | ("Simon",[35,27,40,19,34,21]), 59 | ("Hans",[23,19,45,17,10,5,8,14]), 60 | ("Phil",[1,18,35,20,21,19,34,8,16,21]), 61 | ("Kevin",[9,23,17,54,18,41,9,18,14]) 62 | ] 63 | 64 | main = print (findallawards competitors) 65 | -------------------------------------------------------------------------------- /lambda-grin/src/Lambda/Name.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveAnyClass, StandaloneDeriving, LambdaCase, OverloadedStrings #-} 2 | module Lambda.Name where 3 | 4 | import GHC.Generics (Generic) 5 | import Data.Data 6 | import Data.String 7 | import Text.Printf 8 | import Data.Text (Text, pack, unpack, replace) 9 | 10 | -- Names are stored in NM form when we do program generation. NI is only used 11 | -- when we seralize the Exp 12 | data Name 13 | = NM { unNM :: !Text } 14 | | NI !Int 15 | deriving (Generic, Data, Eq, Ord, Show) 16 | 17 | nMap :: (Text -> Text) -> Name -> Name 18 | nMap f (NM n) = NM (f n) 19 | 20 | instance Semigroup Name where 21 | (NM n1) <> (NM n2) = NM (n1 <> n2) 22 | 23 | instance Monoid Name where 24 | mempty = NM mempty 25 | 26 | instance IsString Name where 27 | fromString = NM . fromString 28 | 29 | instance PrintfArg Name where 30 | formatArg = formatString . unpack . unNM 31 | 32 | -- utils 33 | unpackName :: Name -> String 34 | unpackName (NM name) = unpack name 35 | 36 | packName :: String -> Name 37 | packName = NM . pack 38 | 39 | showTS :: Show a => a -> Name 40 | showTS = packName . show 41 | 42 | -- module name handling 43 | -- Qualified Name = PACKAGE_ID + '_' + MODULE_NAME_THAT_CAN_CONTAIN_DOTS + '.' + DOT_ENCODED_NAME 44 | mkPackageQualifiedName :: String -> String -> String -> Name 45 | mkPackageQualifiedName pkg mod name = encodeUnderscore (packName pkg) <> "_" <> packName mod <> "." <> encodeDot (packName name) 46 | 47 | decodePackageQualifiedName :: Name -> Maybe (String, String, String) 48 | decodePackageQualifiedName n = do 49 | (pkg, mod_and_name) <- decodeUntil '_' $ unpackName n 50 | (rev_name, rev_mod) <- decodeUntil '.' $ reverse mod_and_name 51 | pure (pkg, reverse rev_mod, reverse rev_name) 52 | 53 | decodeUntil :: Char -> String -> Maybe (String, String) 54 | decodeUntil key = go [] where 55 | go locName (a : b : xs) 56 | | a == key 57 | , b == key 58 | = go (key : locName) xs 59 | go locName (a : xs) 60 | | a == key 61 | = Just (reverse locName, xs) 62 | go locName (x : xs) = go (x : locName) xs 63 | go locName [] = Nothing 64 | 65 | -- dot mangling 66 | encodeDot :: Name -> Name 67 | encodeDot = nMap $ replace "." ".." 68 | 69 | decodeDot :: Name -> Name 70 | decodeDot = nMap $ replace ".." "." 71 | 72 | -- underscore mangling 73 | encodeUnderscore :: Name -> Name 74 | encodeUnderscore = nMap $ replace "_" "__" 75 | 76 | decodeUnderscore :: Name -> Name 77 | decodeUnderscore = nMap $ replace "__" "_" 78 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/basic/basic.cabal: -------------------------------------------------------------------------------- 1 | name: basic 2 | version: 0.1.0.0 3 | 4 | license: BSD3 5 | license-file: LICENSE 6 | category: Development 7 | build-type: Simple 8 | cabal-version: >=1.10 9 | 10 | executable basic00 11 | build-depends: base 12 | main-is: basic00.hs 13 | ghc-options: -O0 14 | 15 | executable basic01 16 | build-depends: base 17 | main-is: basic01.hs 18 | c-sources: clib.c 19 | ghc-options: -O0 20 | 21 | executable basic02 22 | build-depends: base 23 | main-is: basic02.hs 24 | c-sources: clib.c 25 | ghc-options: -O0 26 | 27 | executable basic03 28 | build-depends: base 29 | main-is: basic03.hs 30 | c-sources: clib.c 31 | ghc-options: -O0 32 | 33 | executable basic04 34 | build-depends: base 35 | main-is: basic04.hs 36 | c-sources: clib.c 37 | ghc-options: -O0 38 | 39 | executable basic05 40 | build-depends: base 41 | main-is: basic05.hs 42 | c-sources: clib.c 43 | ghc-options: -O0 44 | 45 | executable basic06 46 | build-depends: base 47 | main-is: basic06.hs 48 | c-sources: clib.c 49 | ghc-options: -O0 50 | 51 | -- opt 52 | 53 | executable basic00_opt 54 | build-depends: base 55 | main-is: basic00.hs 56 | ghc-options: -O 57 | 58 | executable basic01_opt 59 | build-depends: base 60 | main-is: basic01.hs 61 | ghc-options: -O 62 | c-sources: clib.c 63 | 64 | executable basic02_opt 65 | build-depends: base 66 | main-is: basic02.hs 67 | ghc-options: -O 68 | c-sources: clib.c 69 | 70 | executable basic03_opt 71 | build-depends: base 72 | main-is: basic03.hs 73 | ghc-options: -O 74 | c-sources: clib.c 75 | 76 | executable basic04_opt 77 | build-depends: base 78 | main-is: basic04.hs 79 | ghc-options: -O 80 | c-sources: clib.c 81 | 82 | executable basic05_opt 83 | build-depends: base 84 | main-is: basic05.hs 85 | ghc-options: -O 86 | c-sources: clib.c 87 | 88 | executable basic06_opt 89 | build-depends: base 90 | main-is: basic06.hs 91 | ghc-options: -O 92 | c-sources: clib.c 93 | 94 | -- opt 95 | 96 | executable ffi00_opt 97 | build-depends: base 98 | main-is: ffi00.hs 99 | ghc-options: -O 100 | c-sources: clib.c 101 | -------------------------------------------------------------------------------- /external-stg/stg-type-query-experiment: -------------------------------------------------------------------------------- 1 | [OK] isUnboxedTupleCon - worked unconditionally for all DataCons that external stg deals with 2 | 3 | isUnboxedTupleType 4 | 5 | 6 | experiments: 7 | OK - no type, just DC isUTup, type PP 8 | OK - no type, just datacon, type PP ; this validates the full DataCon conversion => [DATACON CONVERSION IS ALL OK] 9 | NO - isUnboxedTupleType test for all types in Stg AST 10 | A: no, it does not work for leviti polymorphic type 11 | NO - isTypeLevPoly + isUnboxedTupleType 12 | A: isUnboxedTupleType still fails 13 | OK - no StgApp ty + isTypeLevPoly + isUnboxedTupleType + cvtBinderIdClosureParam, data con, type PP 14 | OK - full type (no StgApp ty), data con, type PP 15 | NO - only StgApp ty (original) + isTypeLevPoly ; check if App result type is valid at core to stg conversion step 16 | A: core to stg res_ty is already messed up, use core app expre type instead 17 | it is possible that it is 18 | NO - not valid from the begining ; pass core's ret_ty promptly + add unboxed sum checking to cvtType 19 | OK got examples - catch exceptions ; dump the types ; store original fun type + arg types + result type ; GOAL: collect example cases of failure 20 | - stg optimization messes it up ; cse or unarise 21 | OK - use original core app exp type in StgApp result type + igonre StgApp added by stg optimizations cse/unarise 22 | OK - use core App result type + cse + unarise + with unboxed sum types (no type unarisation) 23 | - do not support unboxed sums ; check if there is any in the base 24 | - use core App result type + cse + unarise + unarise unboxes sum types 25 | 26 | 27 | - export stg before cse and unarisation 28 | - disable stg cse 29 | 30 | StgApp thoughs: 31 | - StgApp [] ; variable, does not force, result type is the variable type 32 | - StgApp args are always single values 33 | - StgApp as scrutinee ; case binder decides the type 34 | - StgApp as 35 | 36 | to consider 37 | - is case scrutinee (app in case) 38 | - is saturated 39 | - is variable 40 | 41 | 2 APPROACH to extract fun app rep type: 42 | - from core type (PREFERRED) 43 | - from stg ast 44 | 45 | 46 | NOTE: 47 | ubxSumRepType :: [[PrimRep]] -> [SlotTy] 48 | 49 | unbox tuple can not be thunk 50 | 51 | TODO: 52 | external stg pretty printer 53 | include pretty printed core in stgbin 54 | include the origin of stgapp (Var/Coercion/App) 55 | 56 | QUESTIONS: 57 | Is all core App mapped to StgApp? 58 | A: yes 59 | 60 | Is StgApp strict? 61 | 62 | Can an StgApp create thunk? 63 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/imaginary/exp3_8/Main.hs: -------------------------------------------------------------------------------- 1 | {- 2 | From augustss@cs.chalmers.se Sat Jan 11 11:56:04 1992 3 | From: augustss@cs.chalmers.se (Lennart Augustsson) 4 | Newsgroups: comp.lang.functional 5 | Subject: Re: some kindof benchmark 6 | Keywords: n 7 | Date: 10 Jan 92 21:59:05 GMT 8 | Organization: Chalmers University of Technology 9 | 10 | > My system (running on a Sun-SPARC SLC) 11 | > does it in 93 seconds and uses about 12 | > 412k memory to give a motivation. 13 | 14 | I can't resist benchmarks! I did a quick translation to 15 | Haskell and here is the result using hbc. 16 | -} 17 | 18 | ---------------------------------------------------------- 19 | infix 8 ^^^ 20 | 21 | data Nat = Z | S Nat deriving (Eq,Ord,Show{-was:Text-}) 22 | 23 | instance Num Nat where 24 | Z + y = y 25 | S x + y = S (x + y) 26 | x * Z = Z 27 | x * S y = x * y + x 28 | fromInteger x = if x < 1 then Z else S (fromInteger (x-1)) 29 | 30 | -- partain:sig 31 | int :: Nat -> Int 32 | 33 | int Z = 0 34 | int (S x) = 1 + int x 35 | 36 | x ^^^ Z = S Z 37 | x ^^^ S y = x * (x ^^^ y) 38 | 39 | main = print (int (3 ^^^ 8)) 40 | 41 | -- 42 | -- Timing for hbc version 0.997.2 43 | -- Heap set to 1 Mbyte 44 | -- 45 | -- SPARC-SLC 78s (13% GC) 46 | -- DEC5500 27s (16% GC) 47 | -- Sequent Symmetry 165s (16% GC) 48 | -- SUN3/180 148s (15% GC) 49 | -- 50 | -- Sorry, but I havn't recompiled the compiler for any other 51 | -- platforms yet. 52 | -- 53 | -- 54 | {- 55 | 56 | -- Lennart Augustsson 57 | [This signature is intentionally left blank.] 58 | 59 | From aspect@sun1d.informatik.Uni-Bremen.DE Sat Jan 18 13:25:48 1992 60 | From: aspect@sun1d.informatik.Uni-Bremen.DE (Joern von Holten) 61 | Newsgroups: comp.lang.functional 62 | Subject: Re: some kindof benchmark 63 | Date: 17 Jan 92 10:06:57 GMT 64 | Organization: Universitaet Bremen 65 | Nntp-Posting-Host: sun1d 66 | 67 | 68 | ok guys, 69 | 70 | we are responsible for the '3^8 benchmark' ... and we gave a 71 | first approximative result of 93 sec and 412 K (old compiler version). 72 | 73 | Here's the final result for our ASpecT compiler ... it's a strict functional 74 | language based on algebraic specifications. 75 | 76 | ---- Sun 4/20(SLC): 9.8s (412k) ---- 77 | 78 | and comparable results for other platforms (we are generating C as target language). 79 | 80 | we hoped that our benchmark would initiate a collection of various outcoming 81 | benchmarks for functional language compilers. 82 | Where are all these compiler-freaks? 83 | 84 | :-) 85 | 86 | -- Joern von Holten 87 | 88 | 89 | -} 90 | -------------------------------------------------------------------------------- /ghc-grin/ghc-grin.cabal: -------------------------------------------------------------------------------- 1 | name: ghc-grin 2 | version: 0.1.0.0 3 | -- synopsis: 4 | -- description: 5 | homepage: https://github.com/githubuser/grin#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Andor Penzes, Csaba Hruska 9 | maintainer: andor.penzes@gmail.com 10 | copyright: 2018 Andor Penzes, Csaba Hruska 11 | category: Compiler 12 | build-type: Simple 13 | --extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: 19 | -- Lambda.ToStg 20 | Lambda.FromStg 21 | Lambda.GHCPrimOps 22 | Lambda.GHCSymbols 23 | -- StgLoopback 24 | -- StgSample 25 | 26 | build-depends: 27 | base 28 | , containers 29 | , mtl 30 | , transformers 31 | , text 32 | , bytestring 33 | , lambda-grin 34 | , external-stg 35 | , external-stg-util 36 | , ansi-wl-pprint 37 | , recursion-schemes 38 | , ghc 39 | , ghc-paths 40 | , time 41 | 42 | default-language: Haskell2010 43 | 44 | 45 | source-repository head 46 | type: git 47 | location: https://github.com/grin-tech/grin 48 | 49 | executable ghc-grin 50 | hs-source-dirs: app 51 | main-is: GHCGrin.hs 52 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 53 | build-depends: base 54 | , mtl 55 | , filepath 56 | , directory 57 | , containers 58 | , filemanip 59 | , unix 60 | , ansi-wl-pprint 61 | , binary 62 | , blake2 63 | , bytestring 64 | , ghc-grin 65 | , external-stg 66 | , external-stg-util 67 | , lambda-grin 68 | default-language: Haskell2010 69 | 70 | executable gen-lambda 71 | hs-source-dirs: app 72 | main-is: genLambda.hs 73 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 74 | build-depends: base 75 | , filepath 76 | , directory 77 | , containers 78 | , ansi-wl-pprint 79 | , binary 80 | , blake2 81 | , bytestring 82 | , ghc-grin 83 | , external-stg 84 | , external-stg-util 85 | , lambda-grin 86 | default-language: Haskell2010 87 | -------------------------------------------------------------------------------- /patched-lambda-to-ghc-stg/mini-ghc-grin/mini-ghc-grin.cabal: -------------------------------------------------------------------------------- 1 | name: mini-ghc-grin 2 | version: 0.1.0.0 3 | -- synopsis: 4 | -- description: 5 | homepage: https://github.com/githubuser/grin#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Csaba Hruska 9 | maintainer: csaba.hruska@gmail.com 10 | copyright: 2020 Csaba Hruska 11 | category: Compiler 12 | build-type: Simple 13 | cabal-version: >=1.10 14 | 15 | library 16 | hs-source-dirs: src 17 | exposed-modules: 18 | --Lambda.Name 19 | --Lambda.Syntax 20 | --Lambda.ToStg 21 | Lambda.GHCSymbols 22 | StgLoopback 23 | Stg.ToStg 24 | -- Stg.Convert 25 | -- Stg.Syntax 26 | Stg.Util 27 | Stg.Reconstruct 28 | Stg.DeadFunctionElimination.Analysis 29 | Stg.DeadFunctionElimination.Facts 30 | Stg.DeadFunctionElimination.StripModule 31 | 32 | build-depends: 33 | base 34 | , containers 35 | , mtl 36 | , transformers 37 | , bytestring 38 | , text 39 | , ghc 40 | , ghc-paths 41 | , ghc-boot 42 | , binary 43 | , recursion-schemes 44 | , filepath 45 | , directory 46 | , unordered-containers 47 | , hashable 48 | , process 49 | , temporary 50 | 51 | default-language: Haskell2010 52 | 53 | executable gen-exe 54 | hs-source-dirs: app 55 | main-is: genExe.hs 56 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 57 | build-depends: base 58 | , binary 59 | , ghc 60 | , mini-ghc-grin 61 | , split 62 | , async-pool 63 | , process 64 | , filepath 65 | , filemanip 66 | , containers 67 | , bytestring 68 | default-language: Haskell2010 69 | 70 | executable gen-obj 71 | hs-source-dirs: app 72 | main-is: genObj.hs 73 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 74 | build-depends: base 75 | , ghc 76 | , ghc-paths 77 | , mini-ghc-grin 78 | default-language: Haskell2010 79 | 80 | executable show-ghc-stg 81 | hs-source-dirs: app 82 | main-is: showGHCStg.hs 83 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 84 | build-depends: base 85 | , ghc 86 | , ghc-paths 87 | , mini-ghc-grin 88 | , filepath 89 | default-language: Haskell2010 90 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # GHC-GRIN 2 | 3 | [![Gitter chat](https://badges.gitter.im/grin-tech/grin.png)](https://gitter.im/Grin-Development/Lobby) 4 | 5 | 6 | GRIN backend for GHC 7 | 8 | ## Status 9 | 10 | The project is under heavy development. 11 | 12 | Currently I work on the high level semantic model of GHC primop and RTS. 13 | 14 | This work is hosted in a spearate repository: https://github.com/grin-compiler/ghc-whole-program-compiler-project 15 | 16 | 17 | GHC-GRIN can not compile programs yet. 18 | 19 | ## Components 20 | 21 | ### external-stg, external-stg-util 22 | custom AST Data type for GHC ~~Core~~ STG with serialization support and tooling 23 | 24 | ### ghc-8.11.0 25 | modified GHC which serializes the ~~core~~ STG AST of each compiled module using `external-stg`, and calls an external tool to link them at link-time 26 | 27 | ### lambda-grin 28 | utility (lambda calculus) layer for GRIN frontends 29 | 30 | ### ghc-grin 31 | converts the dumped GHC ~~Core~~ STG to Lambda 32 | 33 | ### ghc-grin-benchmark 34 | sample (stack based) projects to test the modified GHC with the GRIN backend 35 | 36 | ## Setup 37 | 38 | Follow these steps to install GHC/GRIN and compile the benchmark programs: 39 | 40 | 1. Compile included GHC-8.11.0 (*ghc-8.11.0.20200215-src*) 41 | `$ ./boot` 42 | `$ ./configure` 43 | `$ hadrian/build.sh -j --flavour=Quickest` 44 | 2. as soon as an error pops up: cannot execute 'grin-ghc' 45 | create a shell script with just this content (+ chmod 750): 46 | ``` 47 | #!/bin/sh 48 | 49 | exit 0 50 | ``` 51 | 3. Install `llvm-7` (on Mac: `brew install llvm-hs/llvm/llvm-7`) 52 | this will take some time to finish.. 53 | 4. Build the executables in directory `ghc-grin/`: 54 | `stack setup` 55 | `stack build` 56 | 5. link the compiled binaries to a directory in your path (e.g. ~/.local/bin) 57 | and also change the script that the patched GHC will call to: 58 | ``` 59 | #!/bin/sh 60 | 61 | set -e 62 | 63 | echo "GRIN Compiler" 64 | 65 | ghc-grin $@ | tee ${!#}.out 66 | ``` 67 | 6. Build the benchmark programs in directory `ghc-grin-benchmark`: 68 | `./c` 69 | - you should see the output of "GRIN Compiler" from the script that calls the grin optimizer 70 | 71 | 72 | ## Preliminary Benchmark 73 | 74 | Comparison of Boquist PhD results *(Sparc, RISC)* with GHC 8.2 *(x64, CISC)* based on the CPU instruction count. 75 | This is not an accurate comparison as the CPU architectures differ, instead it gives a rough overview. 76 | 77 | Instruction Count Benchmark 78 | - Boquist GRIN on Sparc (RISC) *1999* 79 | - GHC 4.01 on Sparc (RISC) *1999* 80 | - GHC 8.2 on x64 (CISC) *2018* 81 | 82 | ![Instruction Count Benchmark](boq-grin-ghc-inst-count.png) 83 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.a2: -------------------------------------------------------------------------------- 1 | SUBDIR ======> other/nfib, OUT=4 2 | START: 15:10:59 3 | STOP: 15:11:00 4 | SUBDIR ======> other/tsumupto, OUT=4 5 | START: 15:11:00 6 | STOP: 15:11:01 7 | SUBDIR ======> other/sieve, OUT=4 8 | START: 15:11:01 9 | STOP: 15:11:03 10 | SUBDIR ======> other/queens, OUT=4 11 | START: 15:11:03 12 | STOP: 15:11:07 13 | SUBDIR ======> other/words, OUT=4 14 | START: 15:11:07 15 | STOP: 15:11:57 16 | SUBDIR ======> other/puzzle, OUT=4 17 | START: 15:11:57 18 | STOP: 15:13:36 19 | SUBDIR ======> imaginary/tak, OUT=4 20 | START: 15:13:36 21 | STOP: 15:13:37 22 | SUBDIR ======> imaginary/exp3_8, OUT=4 23 | START: 15:13:37 24 | STOP: 15:13:40 25 | SUBDIR ======> spectral/awards, OUT=4 26 | START: 15:13:40 27 | STOP: 15:14:13 28 | SUBDIR ======> spectral/cichelli, OUT=4 29 | START: 15:14:13 30 | STOP: 15:15:38 31 | SUBDIR ======> spectral/boyer2, OUT=4 32 | START: 15:15:38 33 | STOP: 15:23:33 34 | SUBDIR ======> spectral/sorting, OUT=4 35 | START: 15:23:33 36 | STOP: 15:26:54 37 | SUBDIR ======> spectral/clausify, OUT=4 38 | START: 15:26:54 39 | STOP: 15:29:34 40 | SUBDIR ======> spectral/hartel/event, OUT=4 41 | START: 15:29:34 42 | STOP: 15:33:57 43 | SUBDIR ======> spectral/hartel/ida, OUT=4 44 | START: 15:33:57 45 | STOP: 15:37:28 46 | SUBDIR ======> spectral/hartel/typecheck, OUT=4 47 | START: 15:37:28 48 | STOP: 15:58:34 49 | SUBDIR ======> other/nfib, OUT=5 50 | START: 15:58:34 51 | STOP: 15:58:36 52 | SUBDIR ======> other/tsumupto, OUT=5 53 | START: 15:58:36 54 | STOP: 15:58:37 55 | SUBDIR ======> other/sieve, OUT=5 56 | START: 15:58:37 57 | STOP: 15:58:39 58 | SUBDIR ======> other/queens, OUT=5 59 | START: 15:58:39 60 | STOP: 15:58:43 61 | SUBDIR ======> other/words, OUT=5 62 | START: 15:58:43 63 | STOP: 15:59:34 64 | SUBDIR ======> other/puzzle, OUT=5 65 | START: 15:59:34 66 | STOP: 16:01:05 67 | SUBDIR ======> imaginary/tak, OUT=5 68 | START: 16:01:05 69 | STOP: 16:01:06 70 | SUBDIR ======> imaginary/exp3_8, OUT=5 71 | START: 16:01:06 72 | STOP: 16:01:09 73 | SUBDIR ======> spectral/awards, OUT=5 74 | START: 16:01:09 75 | STOP: 16:01:42 76 | SUBDIR ======> spectral/cichelli, OUT=5 77 | START: 16:01:42 78 | STOP: 16:03:05 79 | SUBDIR ======> spectral/boyer2, OUT=5 80 | START: 16:03:06 81 | STOP: 16:08:36 82 | SUBDIR ======> spectral/sorting, OUT=5 83 | START: 16:08:36 84 | STOP: 16:10:54 85 | SUBDIR ======> spectral/clausify, OUT=5 86 | START: 16:10:54 87 | STOP: 16:13:31 88 | SUBDIR ======> spectral/hartel/event, OUT=5 89 | START: 16:13:31 90 | STOP: 16:17:21 91 | SUBDIR ======> spectral/hartel/ida, OUT=5 92 | START: 16:17:21 93 | STOP: 16:20:51 94 | SUBDIR ======> spectral/hartel/typecheck, OUT=5 95 | START: 16:20:51 96 | STOP: 16:40:59 97 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.a4: -------------------------------------------------------------------------------- 1 | SUBDIR ======> other/nfib, OUT=a 2 | START: 16:40:59 3 | STOP: 16:41:01 4 | SUBDIR ======> other/tsumupto, OUT=a 5 | START: 16:41:01 6 | STOP: 16:41:02 7 | SUBDIR ======> other/sieve, OUT=a 8 | START: 16:41:02 9 | STOP: 16:41:04 10 | SUBDIR ======> other/queens, OUT=a 11 | START: 16:41:04 12 | STOP: 16:41:08 13 | SUBDIR ======> other/words, OUT=a 14 | START: 16:41:08 15 | STOP: 16:42:00 16 | SUBDIR ======> other/puzzle, OUT=a 17 | START: 16:42:00 18 | STOP: 16:43:32 19 | SUBDIR ======> imaginary/tak, OUT=a 20 | START: 16:43:32 21 | STOP: 16:43:33 22 | SUBDIR ======> imaginary/exp3_8, OUT=a 23 | START: 16:43:33 24 | STOP: 16:43:35 25 | SUBDIR ======> spectral/awards, OUT=a 26 | START: 16:43:36 27 | STOP: 16:44:09 28 | SUBDIR ======> spectral/cichelli, OUT=a 29 | START: 16:44:09 30 | STOP: 16:45:33 31 | SUBDIR ======> spectral/boyer2, OUT=a 32 | START: 16:45:33 33 | STOP: 16:55:18 34 | SUBDIR ======> spectral/sorting, OUT=a 35 | START: 16:55:19 36 | STOP: 17:00:34 37 | SUBDIR ======> spectral/clausify, OUT=a 38 | START: 17:00:34 39 | STOP: 17:06:17 40 | SUBDIR ======> spectral/hartel/event, OUT=a 41 | START: 17:06:17 42 | STOP: 17:12:04 43 | SUBDIR ======> spectral/hartel/ida, OUT=a 44 | START: 17:12:04 45 | STOP: 17:16:56 46 | SUBDIR ======> spectral/hartel/typecheck, OUT=a 47 | START: 17:16:57 48 | STOP: 17:36:58 49 | SUBDIR ======> other/nfib, OUT=b 50 | START: 17:36:58 51 | STOP: 17:37:00 52 | SUBDIR ======> other/tsumupto, OUT=b 53 | START: 17:37:00 54 | STOP: 17:37:01 55 | SUBDIR ======> other/sieve, OUT=b 56 | START: 17:37:01 57 | STOP: 17:37:03 58 | SUBDIR ======> other/queens, OUT=b 59 | START: 17:37:04 60 | STOP: 17:37:07 61 | SUBDIR ======> other/words, OUT=b 62 | START: 17:37:07 63 | STOP: 17:37:58 64 | SUBDIR ======> other/puzzle, OUT=b 65 | START: 17:37:58 66 | STOP: 17:39:28 67 | SUBDIR ======> imaginary/tak, OUT=b 68 | START: 17:39:28 69 | STOP: 17:39:29 70 | SUBDIR ======> imaginary/exp3_8, OUT=b 71 | START: 17:39:29 72 | STOP: 17:39:32 73 | SUBDIR ======> spectral/awards, OUT=b 74 | START: 17:39:32 75 | STOP: 17:40:05 76 | SUBDIR ======> spectral/cichelli, OUT=b 77 | START: 17:40:05 78 | STOP: 17:41:27 79 | SUBDIR ======> spectral/boyer2, OUT=b 80 | START: 17:41:27 81 | STOP: 17:46:54 82 | SUBDIR ======> spectral/sorting, OUT=b 83 | START: 17:46:54 84 | STOP: 17:49:09 85 | SUBDIR ======> spectral/clausify, OUT=b 86 | START: 17:49:09 87 | STOP: 17:51:44 88 | SUBDIR ======> spectral/hartel/event, OUT=b 89 | START: 17:51:44 90 | STOP: 17:55:24 91 | SUBDIR ======> spectral/hartel/ida, OUT=b 92 | START: 17:55:25 93 | STOP: 17:58:44 94 | SUBDIR ======> spectral/hartel/typecheck, OUT=b 95 | START: 17:58:44 96 | STOP: 18:15:25 97 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.a5: -------------------------------------------------------------------------------- 1 | SUBDIR ======> other/nfib, OUT=c 2 | START: 18:15:26 3 | STOP: 18:15:28 4 | SUBDIR ======> other/tsumupto, OUT=c 5 | START: 18:15:28 6 | STOP: 18:15:30 7 | SUBDIR ======> other/sieve, OUT=c 8 | START: 18:15:30 9 | STOP: 18:15:33 10 | SUBDIR ======> other/queens, OUT=c 11 | START: 18:15:33 12 | STOP: 18:15:42 13 | SUBDIR ======> other/words, OUT=c 14 | START: 18:15:42 15 | STOP: 18:17:21 16 | SUBDIR ======> other/puzzle, OUT=c 17 | START: 18:17:21 18 | STOP: 18:20:25 19 | SUBDIR ======> imaginary/tak, OUT=c 20 | START: 18:20:25 21 | STOP: 18:20:27 22 | SUBDIR ======> imaginary/exp3_8, OUT=c 23 | START: 18:20:27 24 | STOP: 18:20:31 25 | SUBDIR ======> spectral/awards, OUT=c 26 | START: 18:20:32 27 | STOP: 18:21:37 28 | SUBDIR ======> spectral/cichelli, OUT=c 29 | START: 18:21:37 30 | STOP: 18:23:50 31 | SUBDIR ======> spectral/boyer2, OUT=c 32 | START: 18:23:50 33 | STOP: 18:29:41 34 | SUBDIR ======> spectral/sorting, OUT=c 35 | START: 18:29:41 36 | STOP: 18:32:08 37 | SUBDIR ======> spectral/clausify, OUT=c 38 | START: 18:32:09 39 | STOP: 18:34:46 40 | SUBDIR ======> spectral/hartel/event, OUT=c 41 | START: 18:34:46 42 | STOP: 18:38:29 43 | SUBDIR ======> spectral/hartel/ida, OUT=c 44 | START: 18:38:29 45 | STOP: 18:41:52 46 | SUBDIR ======> spectral/hartel/typecheck, OUT=c 47 | START: 18:41:52 48 | STOP: 18:59:01 49 | SUBDIR ======> other/nfib, OUT=d 50 | START: 18:59:01 51 | STOP: 18:59:04 52 | SUBDIR ======> other/tsumupto, OUT=d 53 | START: 18:59:04 54 | STOP: 18:59:05 55 | SUBDIR ======> other/sieve, OUT=d 56 | START: 18:59:05 57 | STOP: 18:59:07 58 | SUBDIR ======> other/queens, OUT=d 59 | START: 18:59:07 60 | STOP: 18:59:11 61 | SUBDIR ======> other/words, OUT=d 62 | START: 18:59:11 63 | STOP: 19:00:09 64 | SUBDIR ======> other/puzzle, OUT=d 65 | START: 19:00:09 66 | STOP: 19:01:47 67 | SUBDIR ======> imaginary/tak, OUT=d 68 | START: 19:01:47 69 | STOP: 19:01:49 70 | SUBDIR ======> imaginary/exp3_8, OUT=d 71 | START: 19:01:49 72 | STOP: 19:01:51 73 | SUBDIR ======> spectral/awards, OUT=d 74 | START: 19:01:51 75 | STOP: 19:02:25 76 | SUBDIR ======> spectral/cichelli, OUT=d 77 | START: 19:02:25 78 | STOP: 19:04:01 79 | SUBDIR ======> spectral/boyer2, OUT=d 80 | START: 19:04:01 81 | STOP: 19:09:52 82 | SUBDIR ======> spectral/sorting, OUT=d 83 | START: 19:09:52 84 | STOP: 19:11:57 85 | SUBDIR ======> spectral/clausify, OUT=d 86 | START: 19:11:57 87 | STOP: 19:14:35 88 | SUBDIR ======> spectral/hartel/event, OUT=d 89 | START: 19:14:35 90 | STOP: 19:18:17 91 | SUBDIR ======> spectral/hartel/ida, OUT=d 92 | START: 19:18:18 93 | STOP: 19:21:40 94 | SUBDIR ======> spectral/hartel/typecheck, OUT=d 95 | START: 19:21:41 96 | STOP: 19:38:32 97 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.gcse1: -------------------------------------------------------------------------------- 1 | SUBDIR ======> other/nfib, OUT=gj 2 | START: 09:59:36 3 | STOP: 09:59:38 4 | SUBDIR ======> other/tsumupto, OUT=gj 5 | START: 09:59:38 6 | STOP: 09:59:39 7 | SUBDIR ======> other/sieve, OUT=gj 8 | START: 09:59:39 9 | STOP: 09:59:41 10 | SUBDIR ======> other/queens, OUT=gj 11 | START: 09:59:41 12 | STOP: 09:59:45 13 | SUBDIR ======> other/words, OUT=gj 14 | START: 09:59:45 15 | STOP: 10:00:35 16 | SUBDIR ======> other/puzzle, OUT=gj 17 | START: 10:00:35 18 | STOP: 10:02:10 19 | SUBDIR ======> imaginary/tak, OUT=gj 20 | START: 10:02:10 21 | STOP: 10:02:11 22 | SUBDIR ======> imaginary/exp3_8, OUT=gj 23 | START: 10:02:11 24 | STOP: 10:02:13 25 | SUBDIR ======> spectral/awards, OUT=gj 26 | START: 10:02:13 27 | STOP: 10:02:47 28 | SUBDIR ======> spectral/cichelli, OUT=gj 29 | START: 10:02:47 30 | STOP: 10:04:12 31 | SUBDIR ======> spectral/boyer2, OUT=gj 32 | START: 10:04:12 33 | STOP: 10:09:43 34 | SUBDIR ======> spectral/sorting, OUT=gj 35 | START: 10:09:43 36 | STOP: 10:12:17 37 | SUBDIR ======> spectral/clausify, OUT=gj 38 | START: 10:12:17 39 | STOP: 10:14:55 40 | SUBDIR ======> spectral/hartel/event, OUT=gj 41 | START: 10:14:55 42 | STOP: 10:18:44 43 | SUBDIR ======> spectral/hartel/ida, OUT=gj 44 | START: 10:18:44 45 | STOP: 10:22:08 46 | SUBDIR ======> spectral/hartel/typecheck, OUT=gj 47 | START: 10:22:08 48 | STOP: 10:38:37 49 | SUBDIR ======> other/nfib, OUT=gk 50 | START: 10:38:37 51 | STOP: 10:38:38 52 | SUBDIR ======> other/tsumupto, OUT=gk 53 | START: 10:38:38 54 | STOP: 10:38:39 55 | SUBDIR ======> other/sieve, OUT=gk 56 | START: 10:38:39 57 | STOP: 10:38:41 58 | SUBDIR ======> other/queens, OUT=gk 59 | START: 10:38:41 60 | STOP: 10:38:45 61 | SUBDIR ======> other/words, OUT=gk 62 | START: 10:38:45 63 | STOP: 10:39:36 64 | SUBDIR ======> other/puzzle, OUT=gk 65 | START: 10:39:36 66 | STOP: 10:41:12 67 | SUBDIR ======> imaginary/tak, OUT=gk 68 | START: 10:41:12 69 | STOP: 10:41:13 70 | SUBDIR ======> imaginary/exp3_8, OUT=gk 71 | START: 10:41:13 72 | STOP: 10:41:16 73 | SUBDIR ======> spectral/awards, OUT=gk 74 | START: 10:41:16 75 | STOP: 10:41:50 76 | SUBDIR ======> spectral/cichelli, OUT=gk 77 | START: 10:41:50 78 | STOP: 10:43:14 79 | SUBDIR ======> spectral/boyer2, OUT=gk 80 | START: 10:43:14 81 | STOP: 10:49:36 82 | SUBDIR ======> spectral/sorting, OUT=gk 83 | START: 10:49:36 84 | STOP: 10:51:54 85 | SUBDIR ======> spectral/clausify, OUT=gk 86 | START: 10:51:54 87 | STOP: 10:54:37 88 | SUBDIR ======> spectral/hartel/event, OUT=gk 89 | START: 10:54:37 90 | STOP: 10:58:25 91 | SUBDIR ======> spectral/hartel/ida, OUT=gk 92 | START: 10:58:25 93 | STOP: 11:01:45 94 | SUBDIR ======> spectral/hartel/typecheck, OUT=gk 95 | START: 11:01:45 96 | STOP: 11:19:23 97 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/spectral/boyer2/Rewritefns.hs: -------------------------------------------------------------------------------- 1 | {- 2 | Haskell version of ... 3 | 4 | ! rewrite functions for Boyer benchmark 5 | ! Started by Tony Kitto on 30 March 1988 6 | 7 | ! Changes Log 8 | ! 08-04-88 ADK bug fix = rewrite(Atom(x),A) returns Atom(x) not Nil 9 | ! 25-05-88 ADK added applysubst to this module and assoclist replaced by LUT 10 | 11 | Haskell version: 12 | 13 | 23-06-93 JSM initial version 14 | 15 | -} 16 | 17 | module Rewritefns (applysubst, rewrite) where 18 | 19 | import Lisplikefns 20 | 21 | applysubst :: Lisplist -> Lisplist -> Lisplist 22 | applysubst alist Nil = Nil 23 | applysubst alist term@(Atom x) = 24 | case assoc (term, alist) of 25 | Cons (yh, yt) -> yt 26 | _ -> term 27 | applysubst alist (Cons (x, y)) = Cons (x, applysubstlst alist y) 28 | 29 | applysubstlst :: Lisplist -> Lisplist -> Lisplist 30 | applysubstlst alist Nil = Nil 31 | applysubstlst alist (Atom x) = error "Malformed list" 32 | applysubstlst alist (Cons (x, y)) = 33 | Cons (applysubst alist x, applysubstlst alist y) 34 | 35 | 36 | rewrite :: Lisplist -> LUT -> Lisplist 37 | rewrite Nil term = Nil 38 | rewrite expr@(Atom x) term = expr 39 | rewrite (Cons (l1, l2)) term = 40 | rewritewithlemmas (Cons (l1, rewriteargs l2 term)) 41 | (getLUT (tv l1, term)) term 42 | 43 | rewriteargs :: Lisplist -> LUT -> Lisplist 44 | rewriteargs Nil term = Nil 45 | rewriteargs (Atom x) term = error "Malformed list" 46 | rewriteargs (Cons (x, y)) term = Cons (rewrite x term, rewriteargs y term) 47 | 48 | rewritewithlemmas :: Lisplist -> [Lisplist] -> LUT -> Lisplist 49 | rewritewithlemmas t [] term = t 50 | rewritewithlemmas t (lh:lt) term 51 | | b = rewrite (applysubst u (caddr lh)) term 52 | | otherwise = rewritewithlemmas t lt term 53 | where (b, u) = onewayunify t (cadr lh) 54 | 55 | 56 | onewayunify :: Lisplist -> Lisplist -> (Bool, Lisplist) 57 | onewayunify t1 t2 = onewayunify1 t1 t2 Nil 58 | 59 | onewayunify1 :: Lisplist -> Lisplist -> Lisplist -> (Bool, Lisplist) 60 | onewayunify1 t1 t2 u | atom t2 = case assoc (t2, u) of 61 | Cons (x, y) -> (t1 == y, u) 62 | _ -> (True, Cons (Cons (t2, t1), u)) 63 | | atom t1 = (False, u) 64 | | car t1 == car t2 = onewayunify1lst (cdr t1) (cdr t2) u 65 | | otherwise = (False, u) 66 | 67 | onewayunify1lst :: Lisplist -> Lisplist -> Lisplist -> (Bool, Lisplist) 68 | onewayunify1lst Nil _ u = (True, u) 69 | onewayunify1lst l1 l2 u 70 | | b = onewayunify1lst (cdr l1) (cdr l2) u1 71 | | otherwise = (False, u1) 72 | where (b, u1) = onewayunify1 (car l1) (car l2) u 73 | 74 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/results/errl.run_hgc: -------------------------------------------------------------------------------- 1 | SUBDIR ======> other/nfib 2 | ulimit -t 30; ./nfib -H5M > run.out && cat run.out && cmp -s hgc.out run.out 3 | 29860703 4 | SUBDIR ======> other/tsumupto 5 | ulimit -t 30; ./tsumupto -H5M > run.out && cat run.out && cmp -s hgc.out run.out 6 | -2004260032 7 | SUBDIR ======> other/sieve 8 | ulimit -t 30; ./sieve -H40M > run.out && cat run.out && cmp -s hgc.out run.out 9 | 121013308 10 | SUBDIR ======> other/queens 11 | ulimit -t 30; ./queens -H60M > run.out && cat run.out && cmp -s hgc.out run.out 12 | 14200 13 | SUBDIR ======> other/words 14 | ulimit -t 30; ./words -H60M > run.out && cat run.out && cmp -s hgc.out run.out 15 | 3276 96 4716 0 6300 0 696 5064 5196 84 480 1836 672 4188 348 0 0 11004 6072 6900 744 336 0 0 0 0 16 | SUBDIR ======> other/puzzle 17 | ulimit -t 30; ./puzzle -H60M > run.out && cat run.out && cmp -s hgc.out run.out 18 | 128 19 | SUBDIR ======> imaginary/tak 20 | ulimit -t 30; ./tak -H5M > run.out && cat run.out && cmp -s hgc.out run.out 21 | 9 22 | SUBDIR ======> imaginary/exp3_8 23 | ulimit -t 30; ./exp3_8 -H60M > run.out && cat run.out && cmp -s hgc.out run.out 24 | 6561 25 | SUBDIR ======> spectral/awards 26 | ulimit -t 30; ./awards -H5M > run.out && cat run.out && cmp -s hgc.out run.out 27 | SimonGold74 19 34 21 Gold102 35 27 40 HansGold70 45 17 8 Bronze52 23 19 10 PhilGold70 1 35 34 Silver60 18 21 21 Bronze55 20 19 16 KevinGold72 9 54 9 Gold72 17 41 14 Bronze59 23 18 18 28 | SUBDIR ======> spectral/sorting 29 | ulimit -t 30; ./sorting -H60M > run.out && cat run.out && cmp -s hgc.out run.out 30 | 3849600 31 | SUBDIR ======> spectral/cichelli 32 | ulimit -t 30; ./cichelli -H10M > run.out && cat run.out && cmp -s hgc.out run.out 33 | YesIts 16948 a5 i8 l8 c7 b8 y10 k3 t1 e1 j0 n0 34 | SUBDIR ======> spectral/hartel/event 35 | ulimit -t 30; ./event -H80M > run.out && cat run.out && cmp -s hgc.out run.out 36 | HHxLLHHLLHHLH 37 | 38 | SUBDIR ======> spectral/clausify 39 | ulimit -t 30; ./clausify -H20M > run.out && cat run.out && cmp -s hgc.out run.out 40 | a <= 41 | a <= 42 | a <= 43 | a <= 44 | a <= 45 | a <= 46 | a <= 47 | 48 | SUBDIR ======> spectral/hartel/ida 49 | ulimit -t 30; ./ida -H30M > run.out && cat run.out && cmp -s hgc.out run.out 50 | (4,4)((4,3)-(1,4))((3,4)-(2,4))((1,4)-(3,3))((1,1)-(1,2))((1,2)-(1,3))((2,1)-(3,1))((1,3)-(2,3))((2,4)-(2,2))((2,3)-(2,1))((2,2)-(4,2))((3,1)-(3,2))((3,2)-(4,3))((4,1)-(4,1))((3,3)-(3,4))((4,2)-(4,4)) 51 | 30 3163 52 | 53 | SUBDIR ======> spectral/hartel/typecheck 54 | ulimit -t 30; ./typecheck -H20M > run.out && cat run.out && cmp -s hgc.out run.out 55 | 2904400/47800 56 | 57 | SUBDIR ======> spectral/boyer2 58 | ulimit -t 30; ./boyer2 -H10M > run.out && cat run.out && cmp -s hgc.out run.out 59 | The term is a tautology 60 | 61 | -------------------------------------------------------------------------------- /lambda-grin/souffle-datalog/Check.dl: -------------------------------------------------------------------------------- 1 | ///// VALIDATION 2 | .decl Error(v:symbol, msg:symbol) 3 | .output Error 4 | 5 | // there is no lazy operation beside con and closure 6 | Error(v, "not closure or node") :- 7 | EvalMode(v, "lazy"), 8 | !(Node(v, _) ; IsClosure(v)). 9 | 10 | // there is no strict closure 11 | Error(v, "strict closure") :- 12 | EvalMode(v, "strict"), 13 | IsClosure(v). 14 | 15 | Error(v, "lazy app") :- 16 | EvalMode(v, "lazy"), 17 | Call(v,_,_). 18 | 19 | // SECTION: check for unknown names 20 | 21 | .decl DefName(n:symbol) 22 | 23 | DefName(n) :- // parameters 24 | ( AltParameter(_, _, n) 25 | ; FunctionParameter(_, _, n) 26 | ; ClosureParameter(_, _, n) 27 | ). 28 | 29 | DefName(n) :- // instructions 30 | ( EvalMode(n, _) 31 | ; Alt(_, n, _) 32 | ). 33 | 34 | DefName(n) :- // top level functions 35 | ( IsFunction(n) 36 | ; ExternalFunction(n, _, _) 37 | ). 38 | 39 | .decl UseName(n:symbol) 40 | 41 | UseName(n) :- // instructions 42 | ( Move(_,n) 43 | ; Call(_, n, _) 44 | ; Case(_, n) 45 | ; ReturnValue(_, n) 46 | ). 47 | 48 | UseName(n) :- // arguments 49 | ( (NodeArgument(r, _, n), NodeRole(r, "node")) // exclude literals 50 | ; CallArgument(_, _, n) 51 | ; ClosureVariable(_, _, n) 52 | ). 53 | 54 | 55 | Error(n, "unknown name") :- UseName(n), !DefName(n). 56 | 57 | // SECTION: debug 58 | 59 | .decl MissingValue(v:Variable) 60 | .output MissingValue 61 | 62 | MissingValue(v) :- 63 | HasInst(f, v), 64 | !DeadCode(f), 65 | !IsClosure(v), // if closure is always used fully saturated then it will not have a PNode nor an origin, because only nodes and external functions are value origins 66 | !(NodeOrigin(v, _) ; ExternalOrigin(v, _, _) ; PNode(v, _, _, _)). 67 | 68 | MissingValue(v) :- 69 | (FunctionParameter(f, _, v) ; AltParameter(f, _, v) ; ClosureParameter(f, _, v)), 70 | !DeadCode(f), 71 | !(NodeOrigin(v, _) ; ExternalOrigin(v, _, _); PNode(v, _, _, _)). 72 | 73 | // rule coverage 74 | .decl Used(rule_name:symbol) 75 | .output Used 76 | 77 | // SECTION: unmatching but reachable case expressions 78 | 79 | Error(case_result, "unmatching live case expression") :- 80 | REACHABLE(case_result) 81 | Case(case_result, scrut), 82 | !MatchedAlt(case_result, _), 83 | !MissingValue(scrut). 84 | 85 | Error(case_result, "live case expression with dead scrutinee") :- 86 | REACHABLE(case_result) 87 | Case(case_result, scrut), 88 | !MatchedAlt(case_result, _), 89 | MissingValue(scrut). 90 | 91 | // tagToEnum# 92 | Error(alt, "reachable but unhandled alt due to tagToEnum#") :- 93 | REACHABLE(case_result) 94 | Case(case_result, scrut), 95 | ExternalOrigin(scrut, ext_result, _), 96 | Call(ext_result, "tagToEnum#", _), 97 | Alt(case_result, alt, _), 98 | !MatchedAlt(_, alt). 99 | -------------------------------------------------------------------------------- /ghc-grin-benchmark/boquist-grin-bench/other/words/prel.hs: -------------------------------------------------------------------------------- 1 | -- $Id: prel.hs,v 1.3 1999/02/09 00:41:29 boquist Exp $ 2 | 3 | -- Applied to a predicate and a list, any determines if any element 4 | -- of the list satisfies the predicate. Similarly, for all. 5 | any :: (a -> Bool) -> [a] -> Bool 6 | any p [] = False 7 | any p (x:xs) = p x || any p xs 8 | all :: (a -> Bool) -> [a] -> Bool 9 | all p [] = True 10 | all p (x:xs) = p x && all p xs 11 | 12 | {-# SPECIALIZE elem :: Int -> [Int] -> Bool, Char -> [Char] -> Bool, String -> [String] -> Bool #-} 13 | elem :: (Eq a) => a -> [a] -> Bool 14 | elem _ [] = False 15 | elem x (y:ys) = x==y || elem x ys 16 | 17 | -- list concatenation (right-associative) 18 | {-# INLINE (++) #-} 19 | (++) :: [a] -> [a] -> [a] 20 | (++) = app 21 | where app [] ys = ys 22 | app (x:xs) ys = x : (app xs ys) 23 | 24 | -- concat, applied to a list of lists, returns their flattened concatenation. 25 | {-# INLINE concat #-} 26 | concat :: [[a]] -> [a] 27 | concat = conc 28 | where 29 | conc [] = [] 30 | conc ([]:xss) = conc xss -- for better stack behaviour! 31 | conc (xs:xss) = xs ++ conc xss 32 | 33 | {-# INLINE concatMap #-} 34 | concatMap :: (a -> [b]) -> [a] -> [b] 35 | concatMap f = concatMap' 36 | where concatMap' [] = [] 37 | concatMap' (x:xs) = f x ++ concatMap' xs 38 | 39 | {-# INLINE map #-} 40 | map :: (a -> b) -> [a] -> [b] 41 | map f = map' 42 | where map' [] = [] 43 | map' (x:xs) = f x : map' xs 44 | 45 | {-# INLINE filter #-} 46 | filter :: (a -> Bool) -> [a] -> [a] 47 | filter f = filter' 48 | where filter' [] = [] 49 | filter' (x:xs) = if f x then 50 | x : filter' xs 51 | else 52 | filter' xs 53 | 54 | {-# INLINE length #-} 55 | length :: [a] -> Int 56 | length l = len l 0 57 | where len :: [a]->Int->Int 58 | len [] a = a 59 | len (_:xs) a = len xs (a+1) 60 | 61 | {-# INLINE splitAt #-} 62 | splitAt :: Int -> [b] -> ([b],[b]) 63 | splitAt = isplitAt 64 | where isplitAt :: Int -> [b] -> ([b],[b]) 65 | isplitAt 0 xs = ([],xs) 66 | isplitAt _ [] = ([],[]) 67 | isplitAt n (x:xs) = (x:xs',xs'') where (xs',xs'') = isplitAt (n-1) xs 68 | 69 | {-# INLINE tail #-} 70 | tail :: [a] -> [a] 71 | tail (_:xs) = xs 72 | tail [] = error "tail" 73 | 74 | {-# INLINE drop #-} 75 | drop :: Int -> [b] -> [b] 76 | drop = idrop 77 | where idrop :: Int -> [b] -> [b] 78 | idrop 0 xs = xs 79 | idrop _ [] = [] 80 | idrop n (_:xs) = idrop (n-1) xs 81 | 82 | {-# INLINE fst #-} 83 | fst :: (a,b) -> a 84 | fst (x,y) = x 85 | 86 | {-# INLINE error #-} 87 | error :: String -> a 88 | error s = _error s 89 | 90 | #define print xprint 91 | -------------------------------------------------------------------------------- /lambda-grin/src/Lambda/TH.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | module Lambda.TH 3 | ( progConst 4 | , prog 5 | ) where 6 | 7 | import Data.List (sort) 8 | import Data.Char 9 | import Data.Data 10 | import Data.Maybe 11 | import Text.Megaparsec 12 | import NeatInterpolation 13 | 14 | import qualified Lambda.Parse as P 15 | import qualified Data.Text as T 16 | 17 | import Language.Haskell.TH 18 | import Language.Haskell.TH.Syntax 19 | import Language.Haskell.TH.Quote 20 | 21 | prog :: QuasiQuoter 22 | prog = text { quoteExp = applyParseProg . quoteExp text } 23 | 24 | applyParseProg :: Q Exp -> Q Exp 25 | applyParseProg q = appE [|P.parseProg|] q 26 | 27 | liftText :: T.Text -> Q Exp 28 | liftText txt = AppE (VarE 'T.pack) <$> lift (T.unpack txt) 29 | 30 | liftDataWithText :: Data a => a -> Q Exp 31 | liftDataWithText = dataToExpQ (\a -> liftText <$> cast a) 32 | 33 | -- NOTE: does not support metavariables 34 | 35 | progConst :: QuasiQuoter 36 | progConst = QuasiQuoter 37 | { quoteExp = \input -> do 38 | let src = T.pack $ normalizeQQInput input 39 | case P.parseLambda "" src of 40 | Left e -> fail $ errorBundlePretty e 41 | Right p -> liftDataWithText p 42 | , quotePat = undefined 43 | , quoteType = undefined 44 | , quoteDec = undefined 45 | } 46 | 47 | -- 48 | -- NOTE: copy-paste utility from NeatInterpolation.String hidden module 49 | -- 50 | normalizeQQInput :: [Char] -> [Char] 51 | normalizeQQInput = trim . unindent' . tabsToSpaces 52 | where 53 | unindent' :: [Char] -> [Char] 54 | unindent' s = 55 | case lines s of 56 | head:tail -> 57 | let 58 | unindentedHead = dropWhile (== ' ') head 59 | minimumTailIndent = minimumIndent . unlines $ tail 60 | unindentedTail = case minimumTailIndent of 61 | Just indent -> map (drop indent) tail 62 | Nothing -> tail 63 | in unlines $ unindentedHead : unindentedTail 64 | [] -> [] 65 | 66 | trim :: [Char] -> [Char] 67 | trim = dropWhileRev isSpace . dropWhile isSpace 68 | 69 | dropWhileRev :: (a -> Bool) -> [a] -> [a] 70 | dropWhileRev p = foldr (\x xs -> if p x && null xs then [] else x:xs) [] 71 | 72 | unindent :: [Char] -> [Char] 73 | unindent s = 74 | case minimumIndent s of 75 | Just indent -> unlines . map (drop indent) . lines $ s 76 | Nothing -> s 77 | 78 | tabsToSpaces :: [Char] -> [Char] 79 | tabsToSpaces ('\t':tail) = " " ++ tabsToSpaces tail 80 | tabsToSpaces (head:tail) = head : tabsToSpaces tail 81 | tabsToSpaces [] = [] 82 | 83 | minimumIndent :: [Char] -> Maybe Int 84 | minimumIndent = 85 | listToMaybe . sort . map lineIndent 86 | . filter (not . null . dropWhile isSpace) . lines 87 | 88 | -- | Amount of preceding spaces on first line 89 | lineIndent :: [Char] -> Int 90 | lineIndent = length . takeWhile (== ' ') 91 | --------------------------------------------------------------------------------