├── .gitignore ├── .travis.yml ├── LICENSE ├── Makefile ├── README.md ├── analyses.scm ├── array1.scm.scm ├── ast.scm ├── build-lib.scm ├── bytes-allocated.sh ├── codegen.scm ├── config-debug.scm ├── config-release.scm ├── copy-with-declare.sh ├── core.scm ├── ctx.scm ├── documents ├── 03-17-15 │ ├── table-size │ └── type-tests ├── 03-22-15 │ ├── graphs.ods │ ├── nb-versions │ ├── table-size │ └── type-tests ├── 03-30-15 │ ├── heuristic │ │ ├── %know-length │ │ ├── %known │ │ ├── length │ │ └── standard │ ├── lib-return-type │ ├── nb-closures │ ├── nb-versions-full │ ├── table-mem │ └── type-tests ├── 04-xx-15 │ ├── Tests1.pdf │ ├── Tests2.pdf │ ├── cl │ ├── codesize.pdf │ ├── lc-versions-without-ep.pdf │ └── lc-versions.pdf ├── 05-xx-15 │ ├── tests-3-pic.pdf │ ├── tests-5-inf.pdf │ └── tests-inf.pdf └── ImpactOpts │ └── call-max-len.ods ├── expand.scm ├── extern ├── Sort.scm └── copy-permanent.scm ├── fib.scm ├── float.scm ├── gdbseq ├── lazy-comp.template ├── lib ├── char.scm ├── fake.scm ├── fn.scm ├── io.scm ├── list.scm ├── num.scm ├── op.scm ├── print.scm ├── read.scm ├── string.scm ├── types.scm └── vector.scm ├── main.scm ├── mem.scm ├── native.scm ├── run-ut.scm ├── strat1.scm ├── strat2.scm ├── strat3.scm ├── strat4.scm ├── stratnomax.scm ├── stratprog-noheur.scm ├── stratprog.scm ├── stratprognoreg.scm ├── stratunified.scm ├── test.scm.json ├── tools ├── argscount.scm ├── benchtime.py ├── benchtimes │ ├── bench-sav │ │ ├── all.scm │ │ └── compiler.scm │ ├── bench │ │ ├── ack.scm │ │ ├── array1.scm │ │ ├── bib │ │ ├── boyer.scm │ │ ├── browse.scm │ │ ├── compiler.scm │ │ ├── conform.scm │ │ ├── cpstak.scm │ │ ├── dderiv.scm │ │ ├── deriv.scm │ │ ├── destruc.scm │ │ ├── diviter.scm │ │ ├── divrec.scm │ │ ├── earley.scm │ │ ├── fft.scm │ │ ├── fftrad4.scm │ │ ├── fib.scm │ │ ├── fibfp.scm │ │ ├── graphs.scm │ │ ├── lattice.scm │ │ ├── mazefun.scm │ │ ├── mbrot.scm │ │ ├── nbody.scm │ │ ├── nboyer.scm │ │ ├── nqueens.scm │ │ ├── nucleic.scm │ │ ├── paraffins.scm │ │ ├── perm9.scm │ │ ├── peval.scm │ │ ├── pnpoly.scm │ │ ├── primes.scm │ │ ├── sboyer.scm │ │ ├── simplex.scm │ │ ├── sum.scm │ │ ├── sumfp.scm │ │ ├── sumloop.scm │ │ ├── tak.scm │ │ ├── takl.scm │ │ └── triangl.scm │ ├── num-iters.scm │ ├── num-itersSAVE.scm │ ├── num-itersx10.scm │ ├── prefix │ │ ├── ChezScheme.scm │ │ ├── Gambit.scm │ │ ├── GambitBU.scm │ │ ├── GambitBUf64v.scm │ │ ├── Gambitf64v.scm │ │ ├── LC.scm │ │ ├── LCf64v.scm │ │ └── Pycket.scm │ ├── resultVMIL-lc-gsc-lc │ │ ├── LC5 │ │ │ ├── ack.scm.scm │ │ │ ├── array1.scm.scm │ │ │ ├── boyer.scm.scm │ │ │ ├── browse.scm.scm │ │ │ ├── compiler.scm.scm │ │ │ ├── conform.scm.scm │ │ │ ├── cpstak.scm.scm │ │ │ ├── dderiv.scm.scm │ │ │ ├── deriv.scm.scm │ │ │ ├── destruc.scm.scm │ │ │ ├── diviter.scm.scm │ │ │ ├── divrec.scm.scm │ │ │ ├── earley.scm.scm │ │ │ ├── fft.scm.scm │ │ │ ├── fftrad4.scm.scm │ │ │ ├── fib.scm.scm │ │ │ ├── fibfp.scm.scm │ │ │ ├── graphs.scm.scm │ │ │ ├── lattice.scm.scm │ │ │ ├── mazefun.scm.scm │ │ │ ├── mbrot.scm.scm │ │ │ ├── nbody.scm.scm │ │ │ ├── nboyer.scm.scm │ │ │ ├── nqueens.scm.scm │ │ │ ├── nucleic.scm.scm │ │ │ ├── paraffins.scm.scm │ │ │ ├── perm9.scm.scm │ │ │ ├── peval.scm.scm │ │ │ ├── pnpoly.scm.scm │ │ │ ├── primes.scm.scm │ │ │ ├── sboyer.scm.scm │ │ │ ├── simplex.scm.scm │ │ │ ├── sum.scm.scm │ │ │ ├── sumfp.scm.scm │ │ │ ├── sumloop.scm.scm │ │ │ ├── tak.scm.scm │ │ │ ├── takl.scm.scm │ │ │ └── triangl.scm.scm │ │ ├── LC5f64 │ │ │ ├── ack.scm.scm │ │ │ ├── array1.scm.scm │ │ │ ├── boyer.scm.scm │ │ │ ├── browse.scm.scm │ │ │ ├── compiler.scm.scm │ │ │ ├── conform.scm.scm │ │ │ ├── cpstak.scm.scm │ │ │ ├── dderiv.scm.scm │ │ │ ├── deriv.scm.scm │ │ │ ├── destruc.scm.scm │ │ │ ├── diviter.scm.scm │ │ │ ├── divrec.scm.scm │ │ │ ├── earley.scm.scm │ │ │ ├── fft.scm.scm │ │ │ ├── fftrad4.scm.scm │ │ │ ├── fib.scm.scm │ │ │ ├── fibfp.scm.scm │ │ │ ├── graphs.scm.scm │ │ │ ├── lattice.scm.scm │ │ │ ├── mazefun.scm.scm │ │ │ ├── mbrot.scm.scm │ │ │ ├── nbody.scm.scm │ │ │ ├── nboyer.scm.scm │ │ │ ├── nqueens.scm.scm │ │ │ ├── nucleic.scm.scm │ │ │ ├── paraffins.scm.scm │ │ │ ├── perm9.scm.scm │ │ │ ├── peval.scm.scm │ │ │ ├── pnpoly.scm.scm │ │ │ ├── primes.scm.scm │ │ │ ├── sboyer.scm.scm │ │ │ ├── simplex.scm.scm │ │ │ ├── sum.scm.scm │ │ │ ├── sumfp.scm.scm │ │ │ ├── sumloop.scm.scm │ │ │ ├── tak.scm.scm │ │ │ ├── takl.scm.scm │ │ │ └── triangl.scm.scm │ │ ├── LCf64naive │ │ │ ├── ack.scm.scm │ │ │ ├── array1.scm.scm │ │ │ ├── boyer.scm.scm │ │ │ ├── browse.scm.scm │ │ │ ├── compiler.scm.scm │ │ │ ├── conform.scm.scm │ │ │ ├── cpstak.scm.scm │ │ │ ├── dderiv.scm.scm │ │ │ ├── deriv.scm.scm │ │ │ ├── destruc.scm.scm │ │ │ ├── diviter.scm.scm │ │ │ ├── divrec.scm.scm │ │ │ ├── earley.scm.scm │ │ │ ├── fft.scm.scm │ │ │ ├── fftrad4.scm.scm │ │ │ ├── fib.scm.scm │ │ │ ├── fibfp.scm.scm │ │ │ ├── graphs.scm.scm │ │ │ ├── lattice.scm.scm │ │ │ ├── mazefun.scm.scm │ │ │ ├── mbrot.scm.scm │ │ │ ├── nbody.scm.scm │ │ │ ├── nboyer.scm.scm │ │ │ ├── nqueens.scm.scm │ │ │ ├── nucleic.scm.scm │ │ │ ├── paraffins.scm.scm │ │ │ ├── perm9.scm.scm │ │ │ ├── peval.scm.scm │ │ │ ├── pnpoly.scm.scm │ │ │ ├── primes.scm.scm │ │ │ ├── sboyer.scm.scm │ │ │ ├── simplex.scm.scm │ │ │ ├── sum.scm.scm │ │ │ ├── sumfp.scm.scm │ │ │ ├── sumloop.scm.scm │ │ │ ├── tak.scm.scm │ │ │ ├── takl.scm.scm │ │ │ └── triangl.scm.scm │ │ └── LCnaive │ │ │ ├── ack.scm.scm │ │ │ ├── array1.scm.scm │ │ │ ├── boyer.scm.scm │ │ │ ├── browse.scm.scm │ │ │ ├── compiler.scm.scm │ │ │ ├── conform.scm.scm │ │ │ ├── cpstak.scm.scm │ │ │ ├── dderiv.scm.scm │ │ │ ├── deriv.scm.scm │ │ │ ├── destruc.scm.scm │ │ │ ├── diviter.scm.scm │ │ │ ├── divrec.scm.scm │ │ │ ├── earley.scm.scm │ │ │ ├── fft.scm.scm │ │ │ ├── fftrad4.scm.scm │ │ │ ├── fib.scm.scm │ │ │ ├── fibfp.scm.scm │ │ │ ├── graphs.scm.scm │ │ │ ├── lattice.scm.scm │ │ │ ├── mazefun.scm.scm │ │ │ ├── mbrot.scm.scm │ │ │ ├── nbody.scm.scm │ │ │ ├── nboyer.scm.scm │ │ │ ├── nqueens.scm.scm │ │ │ ├── nucleic.scm.scm │ │ │ ├── paraffins.scm.scm │ │ │ ├── perm9.scm.scm │ │ │ ├── peval.scm.scm │ │ │ ├── pnpoly.scm.scm │ │ │ ├── primes.scm.scm │ │ │ ├── sboyer.scm.scm │ │ │ ├── simplex.scm.scm │ │ │ ├── sum.scm.scm │ │ │ ├── sumfp.scm.scm │ │ │ ├── sumloop.scm.scm │ │ │ ├── tak.scm.scm │ │ │ ├── takl.scm.scm │ │ │ └── triangl.scm.scm │ ├── resultbak │ │ ├── m5eponly │ │ │ ├── ack.scm.scm │ │ │ ├── all.scm.scm │ │ │ ├── array1.scm.scm │ │ │ ├── boyer.scm.scm │ │ │ ├── browse.scm.scm │ │ │ ├── compiler.scm.scm │ │ │ ├── conform.scm.scm │ │ │ ├── cpstak.scm.scm │ │ │ ├── dderiv.scm.scm │ │ │ ├── deriv.scm.scm │ │ │ ├── destruc.scm.scm │ │ │ ├── diviter.scm.scm │ │ │ ├── divrec.scm.scm │ │ │ ├── earley.scm.scm │ │ │ ├── fib.scm.scm │ │ │ ├── fibfp.scm.scm │ │ │ ├── graphs.scm.scm │ │ │ ├── lattice.scm.scm │ │ │ ├── mazefun.scm.scm │ │ │ ├── mbrot.scm.scm │ │ │ ├── nboyer.scm.scm │ │ │ ├── nqueens.scm.scm │ │ │ ├── paraffins.scm.scm │ │ │ ├── perm9.scm.scm │ │ │ ├── peval.scm.scm │ │ │ ├── pnpoly.scm.scm │ │ │ ├── primes.scm.scm │ │ │ ├── sboyer.scm.scm │ │ │ ├── simplex.scm.scm │ │ │ ├── sum.scm.scm │ │ │ ├── sumfp.scm.scm │ │ │ ├── sumloop.scm.scm │ │ │ ├── tak.scm.scm │ │ │ ├── takl.scm.scm │ │ │ └── triangl.scm.scm │ │ ├── m5inter │ │ │ ├── ack.scm.scm │ │ │ ├── all.scm.scm │ │ │ ├── array1.scm.scm │ │ │ ├── boyer.scm.scm │ │ │ ├── browse.scm.scm │ │ │ ├── compiler.scm.scm │ │ │ ├── conform.scm.scm │ │ │ ├── cpstak.scm.scm │ │ │ ├── dderiv.scm.scm │ │ │ ├── deriv.scm.scm │ │ │ ├── destruc.scm.scm │ │ │ ├── diviter.scm.scm │ │ │ ├── divrec.scm.scm │ │ │ ├── earley.scm.scm │ │ │ ├── fib.scm.scm │ │ │ ├── fibfp.scm.scm │ │ │ ├── graphs.scm.scm │ │ │ ├── lattice.scm.scm │ │ │ ├── mazefun.scm.scm │ │ │ ├── mbrot.scm.scm │ │ │ ├── nboyer.scm.scm │ │ │ ├── nqueens.scm.scm │ │ │ ├── paraffins.scm.scm │ │ │ ├── perm9.scm.scm │ │ │ ├── peval.scm.scm │ │ │ ├── pnpoly.scm.scm │ │ │ ├── primes.scm.scm │ │ │ ├── sboyer.scm.scm │ │ │ ├── simplex.scm.scm │ │ │ ├── sum.scm.scm │ │ │ ├── sumfp.scm.scm │ │ │ ├── sumloop.scm.scm │ │ │ ├── tak.scm.scm │ │ │ ├── takl.scm.scm │ │ │ └── triangl.scm.scm │ │ ├── m5intra │ │ │ ├── ack.scm.scm │ │ │ ├── all.scm.scm │ │ │ ├── array1.scm.scm │ │ │ ├── boyer.scm.scm │ │ │ ├── browse.scm.scm │ │ │ ├── compiler.scm.scm │ │ │ ├── conform.scm.scm │ │ │ ├── cpstak.scm.scm │ │ │ ├── dderiv.scm.scm │ │ │ ├── deriv.scm.scm │ │ │ ├── destruc.scm.scm │ │ │ ├── diviter.scm.scm │ │ │ ├── divrec.scm.scm │ │ │ ├── earley.scm.scm │ │ │ ├── fib.scm.scm │ │ │ ├── fibfp.scm.scm │ │ │ ├── graphs.scm.scm │ │ │ ├── lattice.scm.scm │ │ │ ├── mazefun.scm.scm │ │ │ ├── mbrot.scm.scm │ │ │ ├── nboyer.scm.scm │ │ │ ├── nqueens.scm.scm │ │ │ ├── paraffins.scm.scm │ │ │ ├── perm9.scm.scm │ │ │ ├── peval.scm.scm │ │ │ ├── pnpoly.scm.scm │ │ │ ├── primes.scm.scm │ │ │ ├── sboyer.scm.scm │ │ │ ├── simplex.scm.scm │ │ │ ├── sum.scm.scm │ │ │ ├── sumfp.scm.scm │ │ │ ├── sumloop.scm.scm │ │ │ ├── tak.scm.scm │ │ │ ├── takl.scm.scm │ │ │ └── triangl.scm.scm │ │ └── m5rponly │ │ │ ├── ack.scm.scm │ │ │ ├── all.scm.scm │ │ │ ├── array1.scm.scm │ │ │ ├── boyer.scm.scm │ │ │ ├── browse.scm.scm │ │ │ ├── compiler.scm.scm │ │ │ ├── conform.scm.scm │ │ │ ├── cpstak.scm.scm │ │ │ ├── dderiv.scm.scm │ │ │ ├── deriv.scm.scm │ │ │ ├── destruc.scm.scm │ │ │ ├── diviter.scm.scm │ │ │ ├── divrec.scm.scm │ │ │ ├── earley.scm.scm │ │ │ ├── fib.scm.scm │ │ │ ├── fibfp.scm.scm │ │ │ ├── graphs.scm.scm │ │ │ ├── lattice.scm.scm │ │ │ ├── mazefun.scm.scm │ │ │ ├── mbrot.scm.scm │ │ │ ├── nboyer.scm.scm │ │ │ ├── nqueens.scm.scm │ │ │ ├── paraffins.scm.scm │ │ │ ├── perm9.scm.scm │ │ │ ├── peval.scm.scm │ │ │ ├── pnpoly.scm.scm │ │ │ ├── primes.scm.scm │ │ │ ├── sboyer.scm.scm │ │ │ ├── simplex.scm.scm │ │ │ ├── sum.scm.scm │ │ │ ├── sumfp.scm.scm │ │ │ ├── sumloop.scm.scm │ │ │ ├── tak.scm.scm │ │ │ ├── takl.scm.scm │ │ │ └── triangl.scm.scm │ ├── run.py │ └── suffix │ │ ├── ChezScheme.scm │ │ ├── Gambit.scm │ │ ├── GambitBU.scm │ │ ├── GambitBUf64v.scm │ │ ├── Gambitf64v.scm │ │ ├── LC.scm │ │ ├── LCf64v.scm │ │ └── Pycket.scm ├── ecoop17-paper.sh ├── graphs.py ├── graphs │ ├── data_def.tar.xz │ ├── data_def │ │ ├── .~lock.res_def_tablesize_formattedbis.csv# │ │ ├── res_def_alltime.csv │ │ ├── res_def_alltime.pdf │ │ ├── res_def_codesize.csv │ │ ├── res_def_codesize.pdf │ │ ├── res_def_ctime.csv │ │ ├── res_def_ctime.pdf │ │ ├── res_def_exec.csv │ │ ├── res_def_exec1.pdf │ │ ├── res_def_exec2.pdf │ │ ├── res_def_ntests.csv │ │ ├── res_def_ntests.pdf │ │ ├── res_def_ntestsPAPER.csv │ │ ├── res_def_tablesize.csv │ │ └── res_def_tablesize_formatted.csv │ ├── debugntests.pdf │ ├── get_ctime.py │ ├── get_etime.py │ ├── get_time.py │ ├── get_ttime.py │ ├── graph.pdf │ ├── lckey_to_csv.py │ ├── rawcsv_example.csv │ ├── rawcsv_to_graph.py │ └── rawcsv_to_tgraph.py └── locatview │ ├── locat.html │ ├── sorttable.js │ └── warning.png ├── unit-tests ├── IFT3065 │ ├── 1 │ │ ├── etape1-add1.scm │ │ ├── etape1-add2.scm │ │ ├── etape1-eq1.scm │ │ ├── etape1-eq2.scm │ │ ├── etape1-if1.scm │ │ ├── etape1-if2.scm │ │ ├── etape1-if3.scm │ │ ├── etape1-let1.scm │ │ ├── etape1-let2.scm │ │ ├── etape1-let3.scm │ │ ├── etape1-let4.scm │ │ ├── etape1-lt1.scm │ │ ├── etape1-lt2.scm │ │ ├── etape1-modulo1.scm │ │ ├── etape1-modulo2.scm │ │ ├── etape1-mul1.scm │ │ ├── etape1-mul2.scm │ │ ├── etape1-println-bool.scm │ │ ├── etape1-println-int.scm │ │ ├── etape1-quotient1.scm │ │ ├── etape1-quotient2.scm │ │ ├── etape1-sub1.scm │ │ └── etape1-sub2.scm │ ├── 2 │ │ ├── etape2-adder.scm │ │ ├── etape2-append.scm │ │ ├── etape2-assoc.scm │ │ ├── etape2-booleanp.scm │ │ ├── etape2-car.scm │ │ ├── etape2-cdr.scm │ │ ├── etape2-char2integer.scm │ │ ├── etape2-chareq.scm │ │ ├── etape2-charlt.scm │ │ ├── etape2-charp.scm │ │ ├── etape2-cond.scm │ │ ├── etape2-cons.scm │ │ ├── etape2-eqp.scm │ │ ├── etape2-equalp.scm │ │ ├── etape2-eqvp.scm │ │ ├── etape2-fib.scm │ │ ├── etape2-integer2char.scm │ │ ├── etape2-length.scm │ │ ├── etape2-let.scm │ │ ├── etape2-letrec.scm │ │ ├── etape2-make-string.scm │ │ ├── etape2-map.scm │ │ ├── etape2-member.scm │ │ ├── etape2-not.scm │ │ ├── etape2-nqueens.scm │ │ ├── etape2-nullp.scm │ │ ├── etape2-numberp.scm │ │ ├── etape2-pairp.scm │ │ ├── etape2-procedurep.scm │ │ ├── etape2-reverse.scm │ │ ├── etape2-set-car.scm │ │ ├── etape2-set-cdr.scm │ │ ├── etape2-string-length.scm │ │ ├── etape2-string-ref.scm │ │ ├── etape2-string-set.scm │ │ ├── etape2-stringeq.scm │ │ ├── etape2-stringlt.scm │ │ ├── etape2-stringp.scm │ │ └── etape2-write-char.scm │ └── 3 │ │ ├── etape3-ack.scm │ │ ├── etape3-consfib.scm │ │ ├── etape3-cpstak.scm │ │ ├── etape3-make-vector.scm │ │ ├── etape3-tail-call.scm │ │ ├── etape3-triangle.scm │ │ ├── etape3-vector-length.scm │ │ ├── etape3-vector-ref.scm │ │ └── etape3-vector-set.scm ├── benchmarks │ ├── BST.scm │ ├── ack.scm │ ├── array1.scm │ ├── bib │ ├── boyer.scm │ ├── browse.scm │ ├── cat.scm │ ├── compiler.scm │ ├── conform.scm │ ├── cpstak.scm │ ├── dderiv.scm │ ├── deriv.scm │ ├── destruc.scm │ ├── diviter.scm │ ├── divrec.scm │ ├── earley.scm │ ├── fft-f64v.scm │ ├── fft.scm │ ├── fftrad4.scm │ ├── fib.scm │ ├── fibfp.scm │ ├── graphs.scm │ ├── lattice.scm │ ├── mazefun.scm │ ├── mbrot.scm │ ├── nbody.scm │ ├── nboyer.scm │ ├── nqueens.scm │ ├── nucleic-f64v.scm │ ├── nucleic.scm │ ├── paraffins.scm │ ├── perm9.scm │ ├── peval.scm │ ├── pnpoly-f64v.scm │ ├── pnpoly.scm │ ├── primes.scm │ ├── pyramid.scm │ ├── sboyer.scm │ ├── simplex-f64v.scm │ ├── simplex.scm │ ├── string.scm │ ├── sum.scm │ ├── sumfp.scm │ ├── sumloop.scm │ ├── tak.scm │ ├── takl.scm │ ├── triangl.scm │ └── wc.scm ├── chars.scm ├── do.scm ├── let.scm ├── lists.scm ├── macros.scm ├── mutable.scm ├── numbers.scm ├── operators │ ├── arith-simple.scm │ ├── comparison.scm │ ├── eq.scm │ └── not.scm ├── pp.scm ├── print.scm ├── procedure.scm ├── quote.scm ├── rest.scm ├── set.scm ├── strings.scm ├── symbol.scm ├── tail.scm ├── types.scm └── vectors.scm ├── utils.scm ├── values.scm └── x86-debug.scm /.gitignore: -------------------------------------------------------------------------------- 1 | *.o1 2 | config.scm 3 | /tools/benchtimes/result 4 | /tools/locatview/locat.js 5 | lc 6 | *~ 7 | tmp 8 | lib.scm 9 | unit-tests/benchmarks/foo 10 | unit-tests/mutable-out 11 | test.scm 12 | run.sh 13 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | 3 | install: 4 | - wget https://github.com/gambit/gambit/archive/v4.8.8.zip -O gambit.zip 5 | - unzip gambit.zip 6 | - mv gambit-4.8.8 gambit 7 | - cd gambit 8 | - mkdir build 9 | - ./configure --prefix=$TRAVIS_BUILD_DIR/gambit/build/ 10 | - make -j4 current-gsc-boot 11 | - ./configure --prefix=$TRAVIS_BUILD_DIR/gambit/build/ --enable-single-host 12 | - make -j4 from-scratch 13 | - make install 14 | - export PATH=$TRAVIS_BUILD_DIR/gambit/build/bin/:$PATH 15 | 16 | script: 17 | - cd $TRAVIS_BUILD_DIR 18 | - make && make full-test 19 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2017, bsaleil 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | * Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | GSC_FLAGS= -prelude "(declare (not safe))" 2 | CONFIG_FILE= config-release.scm 3 | LC_STRAT=strat1 4 | 5 | all: config values.o1 types.o1 analyses.o1 float.o1 utils.o1 main.o1 native.o1 mem.o1 codegen.o1 ast.o1 core.o1 expand.o1 ctx.o1 lib 6 | cp lazy-comp.template lc 7 | chmod u+x lc 8 | 9 | 10 | 11 | debug: GSC_FLAGS= -debug 12 | debug: CONFIG_FILE= config-debug.scm 13 | debug: all 14 | 15 | dummy: 16 | @: 17 | 18 | .PHONY: lib config dummy 19 | lib: 20 | gsi ./build-lib 21 | 22 | config: 23 | cp $(CONFIG_FILE) config.scm 24 | 25 | values.o1: values.scm 26 | gsc $(GSC_FLAGS) -o $@ $< 27 | 28 | types.o1: $(and $(LC_STRAT),dummy) 29 | gsc $(GSC_FLAGS) -o $@ $(LC_STRAT).scm 30 | 31 | ctx.o1: ctx.scm 32 | gsc $(GSC_FLAGS) -o $@ $< 33 | 34 | codegen.o1: codegen.scm 35 | gsc $(GSC_FLAGS) -o $@ $< 36 | 37 | float.o1: float.scm 38 | gsc $(GSC_FLAGS) -o $@ $< 39 | 40 | utils.o1: utils.scm 41 | gsc $(GSC_FLAGS) -o $@ $< 42 | 43 | main.o1: main.scm 44 | gsc $(GSC_FLAGS) -o $@ $< 45 | 46 | native.o1: native.scm 47 | gsc $(GSC_FLAGS) -o $@ $< 48 | 49 | mem.o1: mem.scm 50 | gsc $(GSC_FLAGS) -o $@ $< 51 | 52 | ast.o1: ast.scm 53 | gsc $(GSC_FLAGS) -o $@ $< 54 | 55 | core.o1: core.scm 56 | gsc $(GSC_FLAGS) -o $@ $< 57 | 58 | expand.o1: expand.scm 59 | gsc $(GSC_FLAGS) -o $@ $< 60 | 61 | analyses.o1: analyses.scm 62 | gsc $(GSC_FLAGS) -o $@ $< 63 | 64 | # Run unit tests 65 | test: 66 | rm ./unit-tests/mutable-out -rf 67 | ./run-ut.scm 68 | 69 | all-tests: 70 | rm ./unit-tests/mutable-out -rf 71 | ./run-ut.scm 72 | ./run-ut.scm --disable-inlined-call 73 | ./run-ut.scm --disable-entry-points --disable-return-points 74 | ./run-ut.scm --max-versions 5 75 | ./run-ut.scm --max-versions 5 --disable-regalloc-vers 76 | ./run-ut.scm --max-versions 0 --disable-float-unboxing 77 | 78 | # Run full unit tests with and without entry and return points 79 | ext-tests: 80 | rm ./unit-tests/mutable-out -rf 81 | 82 | ./run-ut.scm 83 | ./run-ut.scm --disable-inlined-call 84 | ./run-ut.scm --disable-entry-points --disable-inlined-call 85 | ./run-ut.scm --disable-entry-points 86 | ./run-ut.scm --disable-return-points 87 | ./run-ut.scm --disable-entry-points --disable-return-points 88 | ./run-ut.scm --max-versions 5 89 | ./run-ut.scm --max-versions 5 --enable-const-vers --enable-cxoverflow-fallback 90 | ./run-ut.scm --max-versions 1 91 | 92 | ./run-ut.scm --disable-regalloc-vers 93 | ./run-ut.scm --disable-inlined-call --disable-regalloc-vers 94 | ./run-ut.scm --disable-entry-points --disable-inlined-call --disable-regalloc-vers 95 | ./run-ut.scm --disable-entry-points --disable-regalloc-vers 96 | ./run-ut.scm --disable-return-points --disable-regalloc-vers 97 | ./run-ut.scm --disable-entry-points --disable-return-points --disable-regalloc-vers 98 | ./run-ut.scm --max-versions 5 --disable-regalloc-vers 99 | ./run-ut.scm --max-versions 5 --enable-const-vers --enable-cxoverflow-fallback --disable-regalloc-vers 100 | ./run-ut.scm --max-versions 1 --disable-regalloc-vers 101 | 102 | 103 | # Clean 104 | clean: 105 | rm -rf *~ *.o1* lc 106 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # lc 2 | 3 | [![Build Status](https://travis-ci.com/bsaleil/lc.svg?token=8gcbGkkhvfNySyut3swg&branch=master)](https://travis-ci.com/bsaleil/lc) 4 | 5 | JIT compiler for Scheme targeting Linux x86-64 platforms. 6 | 7 | * Baptiste Saleil and Marc Feeley. Interprocedural Specialization of Higher-Order Dynamic Languages Without Static Analysis. In European Conference on Object-Oriented Programming (ECOOP'17), 2017. 8 |
[[pdf](http://drops.dagstuhl.de/opus/volltexte/2017/7271/pdf/LIPIcs-ECOOP-2017-23.pdf)] 9 | * Baptiste Saleil and Marc Feeley. Type Check Removal Using Lazy Interprocedural Code Versioning. In Scheme and Functional Programming Workshop (SFPW'15), 2015.
[[pdf](http://www.schemeworkshop.org/2015/sfpw4-2015-saleil-feeley.pdf)] 10 | * Baptiste Saleil and Marc Feeley. Code Versioning and Extremely Lazy Compilation of Scheme. In Scheme and Functional Programming Workshop (SFPW'14), 2014.
[[pdf](http://www.schemeworkshop.org/2014/papers/Saleil2014.pdf)] 11 | 12 | ### Building 13 | 14 | LC depends on a modified version of the Gambit Scheme compiler that must be installed before building LC: 15 | 16 | ```bash 17 | # Build the modified version of Gambit 18 | git clone https://github.com/bsaleil/gambit 19 | cd gambit 20 | mkdir build 21 | ./configure --enable-single-host --prefix=$(pwd)/build 22 | make -j8 23 | make install 24 | ``` 25 | 26 | The ```gsc``` executable of the modified version of Gambit must be available in ```PATH``` both when building and running LC: 27 | 28 | ```bash 29 | # Make 'gsc' binary available in PATH 30 | export PATH=$(pwd)/build/bin:$PATH 31 | ``` 32 | 33 | Then, LC can be built: 34 | 35 | ```bash 36 | # Build LC 37 | git clone https://github.com/bsaleil/lc -b stable 38 | cd lc 39 | make debug -j8 40 | ``` 41 | 42 | ### Running 43 | 44 | Make sure the ```gsc``` binary of the modified version of gambit is also available in ```PATH``` when running lc. 45 | 46 | ```bash 47 | ./lc file.scm 48 | ``` 49 | 50 | ### Example 51 | 52 | To compute the 40th Fibonacci number: 53 | 54 | #### fib.scm: 55 | ```scheme 56 | (define (fib n) 57 | (if (< n 2) 58 | 1 59 | (+ (fib (- n 1)) 60 | (fib (- n 2))))) 61 | 62 | (println (fib 40)) 63 | ``` 64 | 65 | ```bash 66 | $ time ./lc fib.scm 67 | 165580141 68 | 69 | real 0m0,550s 70 | user 0m0,537s 71 | sys 0m0,010s 72 | 73 | ``` 74 | -------------------------------------------------------------------------------- /array1.scm.scm: -------------------------------------------------------------------------------- 1 | ;;------------------------------------------------------------------------------ 2 | ;; Macros 3 | 4 | (##define-macro (def-macro form . body) 5 | `(##define-macro ,form (let () ,@body))) 6 | 7 | ;;------------------------------------------------------------------------------ 8 | ;; Functions used by LC to get time info 9 | 10 | (def-macro (##lc-time expr) 11 | (let ((sym (gensym))) 12 | `(let ((r (##lc-exec-stats (lambda () ,expr)))) 13 | (##print-perm-string "CPU time: ") 14 | (##print-double (+ (cdr (assoc "User time" (cdr r))) 15 | (cdr (assoc "Sys time" (cdr r))))) 16 | (##print-perm-string "\n") 17 | (##print-perm-string "GC CPU time: ") 18 | (##print-double (+ (cdr (assoc "GC user time" (cdr r))) 19 | (cdr (assoc "GC sys time" (cdr r))))) 20 | (##print-perm-string "\n") 21 | 22 | (map (lambda (el) 23 | (##print-perm-string (car el)) 24 | (##print-perm-string ": ") 25 | (##print-double (cdr el)) 26 | (##print-perm-string "\n")) 27 | (cdr r)) 28 | r))) 29 | 30 | (define (##lc-exec-stats thunk) 31 | (let* ((at-start (##process-statistics)) 32 | (result (thunk)) 33 | (at-end (##process-statistics))) 34 | (define (get-info msg idx) 35 | (cons msg 36 | (- (f64vector-ref at-end idx) 37 | (f64vector-ref at-start idx)))) 38 | (list 39 | result 40 | (get-info "User time" 0) 41 | (get-info "Sys time" 1) 42 | (get-info "Real time" 2) 43 | (get-info "GC user time" 3) 44 | (get-info "GC sys time" 4) 45 | (get-info "GC real time" 5) 46 | (get-info "Nb gcs" 6)))) 47 | 48 | ;;------------------------------------------------------------------------------ 49 | 50 | (define (run-benchmark name count ok? run-maker . args) 51 | (let ((run (apply run-maker args))) 52 | (let ((result (car (##lc-time (run))))) 53 | result))) 54 | 55 | 56 | ;;; ARRAY1 -- One of the Kernighan and Van Wyk benchmarks. 57 | 58 | (define (create-x n) 59 | (define result (make-vector n)) 60 | (do ((i 0 (+ i 1))) 61 | ((>= i n) result) 62 | (vector-set! result i i))) 63 | 64 | (define (create-y x) 65 | (let* ((n (vector-length x)) 66 | (result (make-vector n))) 67 | (do ((i (- n 1) (- i 1))) 68 | ((< i 0) result) 69 | (vector-set! result i (vector-ref x i))))) 70 | 71 | (define (my-try n) 72 | (vector-length (create-y (create-x n)))) 73 | 74 | (define (go n) 75 | (let loop ((repeat 100) 76 | (result '())) 77 | (if (> repeat 0) 78 | (loop (- repeat 1) (my-try n)) 79 | result))) 80 | 81 | (define (main . args) 82 | (run-benchmark 83 | "array1" 84 | 1 85 | (lambda (result) (equal? result 200000)) 86 | (lambda (n) (lambda () (go n))) 87 | 200000)) 88 | 89 | (main) 90 | -------------------------------------------------------------------------------- /build-lib.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (include "expand.scm") 31 | 32 | (define LIB_FILES 33 | '("./lib/op.scm" 34 | "./lib/io.scm" 35 | "./lib/string.scm" 36 | "./lib/print.scm" 37 | "./lib/vector.scm" 38 | "./lib/types.scm" 39 | "./lib/char.scm" 40 | "./lib/list.scm" 41 | "./lib/fn.scm" 42 | "./lib/num.scm" 43 | "./lib/fake.scm" 44 | "./lib/read.scm")) 45 | 46 | (define (get-lib files) 47 | (if (null? files) 48 | '() 49 | (append (read-all (open-input-file (car files))) 50 | (get-lib (cdr files))))) 51 | 52 | (define (write-lib exprs) 53 | 54 | (define (write-lib-h exprs f) 55 | (if (not (null? exprs)) 56 | (begin (pretty-print (car exprs) f) 57 | (write-lib-h (cdr exprs) f)))) 58 | 59 | (let ((f (open-output-file "./lib.scm"))) 60 | (write-lib-h exprs f) 61 | (force-output f))) 62 | 63 | (let ((lib (get-lib LIB_FILES))) 64 | (write-lib lib)) 65 | -------------------------------------------------------------------------------- /bytes-allocated.sh: -------------------------------------------------------------------------------- 1 | 2 | #------------------------------------------------------------------------------ 3 | # Script params 4 | 5 | # Path of compiled benchmarks 6 | BENCH_PATH="./tools/benchtimes/result/tag-inter-opt/*.scm" 7 | 8 | # LC key to extract from --stats option 9 | LC_KEY="Bytes allocated" 10 | 11 | # Name of configurations used to extract lc key 12 | CONFIG_NAMES=( 13 | "tag-intra-noopt" 14 | "tag-inter-noopt" 15 | "nan-intra-noopt" 16 | "nan-inter-noopt" 17 | "nan-intra-opt" 18 | "nan-inter-opt" 19 | "tag-intra-opt" 20 | "tag-inter-opt" 21 | ) 22 | 23 | # Options of configurations used to extract lc key 24 | CONFIGS=( 25 | "--disable-float-unboxing --disable-entry-points --disable-return-points" 26 | "--disable-float-unboxing" 27 | "--disable-float-unboxing --disable-entry-points --disable-return-points --nan-boxing" 28 | "--disable-float-unboxing --nan-boxing" 29 | "--disable-entry-points --disable-return-points --nan-boxing" 30 | "--nan-boxing" 31 | "--disable-entry-points --disable-return-points" 32 | "" 33 | ) 34 | 35 | #------------------------------------------------------------------------------ 36 | 37 | # $1 benchmark 38 | # $2 lc options 39 | print_for_config() 40 | { 41 | result=$(./lc $1 $2 --disable-pair-tag --stats --max-versions 5 | grep "$LC_KEY") 42 | IFS=':' read -r -a result <<< "$result" 43 | result="${result[1]}" 44 | result="${result// /}" 45 | printf ":" 46 | printf "$result" 47 | } 48 | 49 | # Print CSV header 50 | printf "benchmark" 51 | for config_name in "${CONFIG_NAMES[@]}"; do printf ":" && printf $config_name; done 52 | printf "\n" 53 | 54 | # Extract and print key for each benchmark 55 | for bench in $BENCH_PATH 56 | do 57 | name=$(basename $bench) 58 | name=${name::-8} 59 | printf $name 60 | for config in "${CONFIGS[@]}"; do print_for_config $bench "$config"; done 61 | printf "\n" 62 | done 63 | -------------------------------------------------------------------------------- /config-debug.scm: -------------------------------------------------------------------------------- 1 | 2 | (define-macro (assert c err) 3 | `(if (not ,c) 4 | (begin 5 | (println "!!! ERROR : " ,err) 6 | (exit 1)))) 7 | -------------------------------------------------------------------------------- /config-release.scm: -------------------------------------------------------------------------------- 1 | 2 | (define-macro (assert c err) #t) 3 | -------------------------------------------------------------------------------- /copy-with-declare.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # Declarations 4 | echo "$4" > "$2" 5 | 6 | # Library 7 | if [[ "$3" == "lib" ]] 8 | then 9 | cat ./lib.scm >> "$2" 10 | fi 11 | 12 | # Code 13 | if [[ "$1" != "" ]] 14 | then 15 | cat "$1" >> "$2" 16 | fi 17 | -------------------------------------------------------------------------------- /documents/03-17-15/table-size: -------------------------------------------------------------------------------- 1 | Name Total 2 | ----------------- 3 | ack.scm 2 4 | array1.scm 4 5 | boyer.scm 15 6 | browse.scm 18 7 | cat.scm 2 8 | compiler.scm 226 9 | conform.scm 34 10 | cpstak.scm 3 11 | dderiv.scm 10 12 | deriv.scm 6 13 | destruc.scm 5 14 | diviter.scm 2 15 | divrec.scm 2 16 | earley.scm 51 17 | fib.scm 1 18 | graphs.scm 36 19 | mazefun.scm 30 20 | nboyer.scm 21 | nqueens.scm 15 22 | paraffins.scm 15 23 | perm9.scm 7 24 | peval.scm 25 25 | primes.scm 4 26 | sboyer.scm 22 27 | string.scm 8 28 | sumloop.scm 1 29 | sum.scm 2 30 | takl.scm 3 31 | tak.scm 5 32 | triangl.scm 6 33 | wc.scm 4 34 | -------------------------------------------------------------------------------- /documents/03-17-15/type-tests: -------------------------------------------------------------------------------- 1 | Name Total Nb executed %executed %deleted 2 | ------------------------------------------------------------- 3 | array1 280001804 20000702 7 93 4 | boyer 18158696 17902374 99 1 5 | browse 1344658 937219 70 30 6 | cat 548467 411350 75 25 7 | compiler 1980647 1100728 56 44 8 | conform 7855975 5829642 74 26 9 | cpstak 333947 63610 19 81 10 | dderiv 192 182 95 5 11 | deriv 86 76 88 12 12 | destruc 1562554 728105 47 53 13 | diviter 1204 402 33 67 14 | divrec 1304 502 39 62 15 | earley 1482167 1089807 74 26 16 | fib 179164215 59721405 33 67 17 | graphs 1315135 621278 47 53 18 | mazefun 535753 256813 48 52 19 | nqueens 300248 165052 55 45 20 | paraffins 2288833 1409162 62 38 21 | perm9 24297292 9966338 41 59 22 | peval 1213412 1034181 85 15 23 | primes 3839 1871 49 51 24 | sboyer 2250187122 1889201479 84 16 25 | string 702433074 36702072 5 95 26 | sumloop 600000003 100000001 17 83 27 | sum 70011 10003 14 86 28 | takl 1403463 1403313 100 0 29 | tak 286239 115149 40 60 30 | triangl 92481242 40178262 43 57 31 | wc 3296621 823695 25 75 32 | -------------------------------------------------------------------------------- /documents/03-22-15/graphs.ods: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/documents/03-22-15/graphs.ods -------------------------------------------------------------------------------- /documents/03-22-15/nb-versions: -------------------------------------------------------------------------------- 1 | Name Min Max 2 | -------------------------------------------------- 3 | ack.scm 0 2 4 | array1.scm 0 2 5 | boyer.scm 0 4 6 | browse.scm 0 7 7 | cat.scm 0 1 8 | compiler.scm 0 45 9 | conform.scm 0 6 10 | cpstak.scm 0 1 11 | dderiv.scm 0 3 12 | deriv.scm 0 2 13 | destruc.scm 0 2 14 | diviter.scm 0 2 15 | divrec.scm 0 2 16 | earley.scm 0 12 17 | fib.scm 0 2 18 | graphs.scm 0 6 19 | mazefun.scm 0 16 20 | nqueens.scm 0 6 21 | paraffins.scm 0 5 22 | perm9.scm 0 3 23 | peval.scm 0 15 24 | primes.scm 0 2 25 | sboyer.scm 0 4 26 | string.scm 0 2 27 | sum.scm 0 1 28 | sumloop.scm 0 1 29 | tak.scm 0 5 30 | takl.scm 0 2 31 | triangl.scm 0 2 32 | wc.scm 0 3 33 | -------------------------------------------------- 34 | Average min: 0 35 | Average max: 5 36 | -------------------------------------------------------------------------------- /documents/03-22-15/table-size: -------------------------------------------------------------------------------- 1 | Name Table size 2 | ------------------------------ 3 | ack.scm 2 4 | array1.scm 4 5 | boyer.scm 15 6 | browse.scm 18 7 | cat.scm 2 8 | compiler.scm 230 9 | conform.scm 36 10 | cpstak.scm 3 11 | dderiv.scm 10 12 | deriv.scm 5 13 | destruc.scm 5 14 | diviter.scm 2 15 | divrec.scm 2 16 | earley.scm 51 17 | fib.scm 1 18 | graphs.scm 36 19 | mazefun.scm 30 20 | nqueens.scm 15 21 | paraffins.scm 15 22 | perm9.scm 7 23 | peval.scm 25 24 | primes.scm 4 25 | sboyer.scm 23 26 | string.scm 8 27 | sum.scm 2 28 | sumloop.scm 1 29 | tak.scm 5 30 | takl.scm 3 31 | triangl.scm 6 32 | wc.scm 4 33 | ------------------------------ 34 | Average: 19 35 | -------------------------------------------------------------------------------- /documents/03-22-15/type-tests: -------------------------------------------------------------------------------- 1 | Name Total tests Executed tests % Removed 2 | ---------------------------------------------------------------------- 3 | ack.scm 78150588 5580143 92.86 4 | array1.scm 280001804 20000401 92.86 5 | boyer.scm 18587032 17017140 8.45 6 | browse.scm 1381052 853884 38.17 7 | cat.scm 548467 274233 50.00 8 | compiler.scm 2033254 731568 64.02 9 | conform.scm 7861678 3226853 58.95 10 | cpstak.scm 333947 63609 80.95 11 | dderiv.scm 205 130 36.59 12 | deriv.scm 99 48 51.52 13 | destruc.scm 1562554 486941 68.84 14 | diviter.scm 1204 300 75.08 15 | divrec.scm 1304 300 76.99 16 | earley.scm 1572396 1121532 28.67 17 | fib.scm 179164215 29860702 83.33 18 | graphs.scm 1375508 478154 65.24 19 | mazefun.scm 546848 161299 70.50 20 | nqueens.scm 300248 162995 45.71 21 | paraffins.scm 2288833 882614 61.44 22 | perm9.scm 24297292 6644228 72.65 23 | peval.scm 1465169 933291 36.30 24 | primes.scm 3839 1744 54.57 25 | sboyer.scm 2470222546 1982646410 19.74 26 | string.scm 702433074 26213771 96.27 27 | sum.scm 70011 10002 85.71 28 | sumloop.scm 600000003 100000000 83.33 29 | tak.scm 286239 51540 81.99 30 | takl.scm 1403463 866606 38.25 31 | triangl.scm 92481242 34362846 62.84 32 | wc.scm 2527235 301884 88.05 33 | ---------------------------------------------------------------------- 34 | Average: 62.33 35 | -------------------------------------------------------------------------------- /documents/03-30-15/lib-return-type: -------------------------------------------------------------------------------- 1 | Name | Total | Predicted | % 2 | ------------------------------------- 3 | ack.scm 5580144 0 0,00 4 | array1.scm 301 0 0,00 5 | boyer.scm 754284 1934 0,03 6 | browse.scm 151327 8151 0,15 7 | cat.scm 2 0 0,00 8 | compiler.scm 237098 58252 1,04 9 | conform.scm 2198402 14749 0,26 10 | cpstak.scm 1 0 0,00 11 | dderiv.scm 61 0 0,00 12 | deriv.scm 37 0 0,00 13 | destruc.scm 241164 240303 4,31 14 | diviter.scm 102 0 0,00 15 | divrec.scm 202 0 0,00 16 | earley.scm 235010 1535 0,03 17 | fib.scm 29860703 0 0,00 18 | graphs.scm 130332 739 0,01 19 | mazefun.scm 51559 22342 0,40 20 | nqueens.scm 24742 0 0,00 21 | paraffins.scm 377073 350955 6,29 22 | perm9.scm 5034277 3322107 59,53 23 | peval.scm 289248 19533 0,35 24 | primes.scm 488 0 0,00 25 | sboyer.scm 506291976 549 0,01 26 | string.scm 3011 600 0,01 27 | sumloop.scm 1 0 0,00 28 | sum.scm 1 0 0,00 29 | takl.scm 111355 0 0,00 30 | tak.scm 47707 0 0,00 31 | triangl.scm 5814495 297 0,01 32 | wc.scm 2 0 0,00 33 | -------------------------------------------------------------------------------- /documents/03-30-15/nb-closures: -------------------------------------------------------------------------------- 1 | Name NB closures 2 | -------------------------------------------------- 3 | ack.scm 108 4 | array1.scm 112 5 | boyer.scm 115848 6 | browse.scm 20421 7 | cat.scm 109 8 | compiler.scm 27383 9 | conform.scm 202053 10 | cpstak.scm 47816 11 | dderiv.scm 130 12 | deriv.scm 111 13 | destruc.scm 969 14 | diviter.scm 109 15 | divrec.scm 109 16 | earley.scm 87081 17 | fib.scm 108 18 | graphs.scm 104182 19 | mazefun.scm 3348 20 | nqueens.scm 4224 21 | paraffins.scm 1229 22 | perm9.scm 114 23 | peval.scm 21679 24 | primes.scm 136 25 | sboyer.scm 146 26 | string.scm 110 27 | sum.scm 109 28 | sumloop.scm 110 29 | tak.scm 108 30 | takl.scm 110 31 | triangl.scm 109 32 | wc.scm 109 -------------------------------------------------------------------------------- /documents/03-30-15/table-mem: -------------------------------------------------------------------------------- 1 | 2 | ------------------------- 3 | 4 | Compiler.scm : 5 | 6 | 59375704 allocated bytes 7 | 27383 closures 8 | 2000 byte/closure (250 * 8) 9 | 10 | 27383 * 2000 = 54766000 = 92.2 % of memory for cc-tables 11 | 12 | ------------------------- 13 | 14 | Boyer.scm : 15 | 16 | 243652712 allocated bytes 17 | 115848 closures 18 | 2000 byte/closure (250 * 8) 19 | 20 | 21 | 115848 * 2000 = 231696000 = 95.1 % of memory for cc-tables 22 | 23 | ------------------------- 24 | -------------------------------------------------------------------------------- /documents/03-30-15/type-tests: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/documents/03-30-15/type-tests -------------------------------------------------------------------------------- /documents/04-xx-15/Tests1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/documents/04-xx-15/Tests1.pdf -------------------------------------------------------------------------------- /documents/04-xx-15/Tests2.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/documents/04-xx-15/Tests2.pdf -------------------------------------------------------------------------------- /documents/04-xx-15/cl: -------------------------------------------------------------------------------- 1 | Nb tests without multiple entry points: 2 | 3 | ./graphs.py --exec="maxvers=1;--max-versions 1 --disable-entry-points" --exec="maxvers=5;--max-versions 5 --disable-entry-points" --exec="maxvers=inf; --disable-entry-points" --exec="maxvers=0;--max-versions 0 --disable-entry-points" --exec="maxvers=3;--max-versions 3 --disable-entry-points" 4 | 5 | Nb tests with multiple entry points: 6 | 7 | ./graphs.py --exec="maxvers=0;--max-versions 0 --disable-entry-points" --exec="maxvers=5;--max-versions 5 --disable-entry-points" --exec="maxvers=5+inter;--max-versions 5" --exec="maxvers=2+inter;--max-versions 2" --exec="maxvers=2;--max-versions 2 --disable-entry-points" 8 | 9 | Code size: 10 | 11 | ./graphs.py --exec="maxvers=0;--max-versions 0 --disable-entry-points" --exec="maxvers=2;--max-versions 2 --disable-entry-points" --exec="maxvers=5;--max-versions 5 --disable-entry-points" --exec="maxvers=2+inter;--max-versions 2" --exec="maxvers=5+inter;--max-versions 5" 12 | -------------------------------------------------------------------------------- /documents/04-xx-15/codesize.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/documents/04-xx-15/codesize.pdf -------------------------------------------------------------------------------- /documents/04-xx-15/lc-versions-without-ep.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/documents/04-xx-15/lc-versions-without-ep.pdf -------------------------------------------------------------------------------- /documents/04-xx-15/lc-versions.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/documents/04-xx-15/lc-versions.pdf -------------------------------------------------------------------------------- /documents/05-xx-15/tests-3-pic.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/documents/05-xx-15/tests-3-pic.pdf -------------------------------------------------------------------------------- /documents/05-xx-15/tests-5-inf.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/documents/05-xx-15/tests-5-inf.pdf -------------------------------------------------------------------------------- /documents/05-xx-15/tests-inf.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/documents/05-xx-15/tests-inf.pdf -------------------------------------------------------------------------------- /documents/ImpactOpts/call-max-len.ods: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/documents/ImpactOpts/call-max-len.ods -------------------------------------------------------------------------------- /extern/Sort.scm: -------------------------------------------------------------------------------- 1 | ;;;============================================================================ 2 | 3 | ;;; File: "Sort.scm", Time-stamp: <2008-03-18 15:21:35 feeley> 4 | 5 | ;;; Copyright (c) 2006-2008 by Marc Feeley, All Rights Reserved. 6 | 7 | ;;;============================================================================ 8 | 9 | ;;; (sort sequence less?) sorts a sequence (a list or vector) in a 10 | ;;; non-destructive way ordered using the comparison predicate less?. 11 | ;;; 12 | ;;; Sample use: 13 | ;;; 14 | ;;; (sort (vector 3 1 4 1 5) >) => #(5 4 3 1 1) 15 | 16 | ;;;============================================================================ 17 | 18 | (define (sort sequence less?) 19 | 20 | (declare (standard-bindings) (not safe)) 21 | 22 | (define (sort-list lst less?) 23 | 24 | (define (mergesort lst) 25 | 26 | (define (merge lst1 lst2) 27 | (cond ((not (pair? lst1)) 28 | lst2) 29 | ((not (pair? lst2)) 30 | lst1) 31 | (else 32 | (let ((e1 (car lst1)) (e2 (car lst2))) 33 | (if (less? e1 e2) 34 | (cons e1 (merge (cdr lst1) lst2)) 35 | (cons e2 (merge lst1 (cdr lst2)))))))) 36 | 37 | (define (split lst) 38 | (if (or (not (pair? lst)) (not (pair? (cdr lst)))) 39 | lst 40 | (cons (car lst) (split (cddr lst))))) 41 | 42 | (if (or (not (pair? lst)) (not (pair? (cdr lst)))) 43 | lst 44 | (let* ((lst1 (mergesort (split lst))) 45 | (lst2 (mergesort (split (cdr lst))))) 46 | (merge lst1 lst2)))) 47 | 48 | (mergesort lst)) 49 | 50 | (cond ((not (procedure? less?)) 51 | (error "procedure expected")) 52 | ((or (null? sequence) 53 | (pair? sequence)) 54 | (sort-list sequence less?)) 55 | ((vector? sequence) 56 | (list->vector (sort-list (vector->list sequence) less?))) 57 | (else 58 | (error "vector or list expected")))) 59 | 60 | ;;;============================================================================ 61 | -------------------------------------------------------------------------------- /fib.scm: -------------------------------------------------------------------------------- 1 | (define (fib n) 2 | (if (< n 2) 3 | 1 4 | (+ (fib (- n 1)) (fib (- n 2))))) 5 | 6 | (gambit$$println (fib 40)) 7 | -------------------------------------------------------------------------------- /gdbseq: -------------------------------------------------------------------------------- 1 | catch signal SIGTRAP 2 | set logging file out 3 | set logging on 4 | run 5 | quit 6 | -------------------------------------------------------------------------------- /lazy-comp.template: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | GSC="gsc" 4 | LC_FILES="values.o1 float.o1 utils.o1 ctx.o1 types.o1 core.o1 native.o1 mem.o1 codegen.o1 ast.o1 expand.o1 analyses.o1 main.o1" 5 | ARGS=() 6 | 7 | # GDB call, default is empty (do not use gdb) 8 | GDB="" 9 | # Minimum heap size, default is 512mb 10 | TRACE_HEAP="-:" 11 | #TRACE_HEAP="-:d2," 12 | HEAP="m512000" 13 | 14 | for (( i=1; i<="$#"; i++ )) 15 | do 16 | arg=${!i} 17 | # --gdb arg, set $GDB 18 | if [[ $arg == "--gdb" ]] ; then 19 | GDB="gdb -ex run --args" 20 | # --min-heap, set $HEAP 21 | elif [[ $arg == "--min-heap" ]] ; then 22 | pos=$i 23 | next=$((i+1)) 24 | HEAP="m${!next}" 25 | i=$((next)) 26 | # scm file, use realpath 27 | elif [[ ${!i} == *.scm ]] ; then 28 | ARGS+=($(readlink -f ${!i})) 29 | # else, keep unchanged 30 | else 31 | ARGS+=(${!i}) 32 | fi 33 | done 34 | 35 | # Chdir to script path 36 | cd "$(dirname "$0")" 37 | # Run 38 | $GDB $GSC "$TRACE_HEAP$HEAP" -i $LC_FILES ${ARGS[@]} 39 | -------------------------------------------------------------------------------- /lib/fake.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define (exact? n) (fixnum? n)) 31 | 32 | (define (exact->inexact n) 33 | (+ n 0.0)) 34 | 35 | ;(define call/cc (lambda (r) (r #f))) 36 | (define (call/cc . n) 37 | (let ((l (length n))) 38 | (cond ((= l 1) 39 | ((car n) #f)) 40 | ((= l 2) 41 | ((car n) #f (cadr n))) 42 | (else (error "call/cc"))))) 43 | 44 | (define abs (lambda (x) (if (< x 0) (- x) x))) 45 | -------------------------------------------------------------------------------- /lib/fn.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define (map fn lst) 31 | (if (null? lst) 32 | '() 33 | (cons (fn (car lst)) (map fn (cdr lst))))) 34 | 35 | (define (error msg . msgs) 36 | 37 | (define (print-msgs msgs) 38 | (if (null? msgs) 39 | (newline) 40 | (begin (print (car msgs)) 41 | (print " ") 42 | (print-msgs (cdr msgs))))) 43 | 44 | (print "!!! ERROR - ") 45 | (for-each pp (cons msg msgs)) 46 | (exit)) 47 | 48 | (define fatal-error 49 | (lambda (msg . msgs) 50 | (apply error (cons msg msgs)))) 51 | -------------------------------------------------------------------------------- /lib/io.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define (open-input-file path) 31 | (gambit$$open-input-file path)) 32 | 33 | (define (open-output-file path) 34 | (gambit$$open-output-file path)) 35 | 36 | (define (close-output-port port) 37 | (gambit$$close-output-port port)) 38 | 39 | (define (close-input-port port) 40 | (gambit$$close-input-port port)) 41 | 42 | (define (read-char port) 43 | (gambit$$read-char port)) 44 | 45 | (define (write-char c p) 46 | (gambit$$write-char c p)) 47 | -------------------------------------------------------------------------------- /lib/num.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define (integer? n) 31 | (fixnum? n)) ;; TODO flonum 32 | 33 | (define (positive? x) 34 | (> x 0)) 35 | 36 | (define (negative? x) 37 | (< x 0)) 38 | 39 | (define (expt n m) 40 | (if (= m 0) 41 | 1 42 | (* n (expt n (- m 1))))) 43 | 44 | (define (max a . l) 45 | (define (max-h els m) 46 | (if (null? els) 47 | m 48 | (let ((c (car els))) 49 | (if (> c m) 50 | (max-h (cdr els) c) 51 | (max-h (cdr els) m))))) 52 | (max-h l a)) 53 | 54 | (define (min a . l) 55 | (define (min-h els m) 56 | (if (null? els) 57 | m 58 | (let ((c (car els))) 59 | (if (< (car els) m) 60 | (min-h (cdr els) (car els)) 61 | (min-h (cdr els) m))))) 62 | (min-h l a)) 63 | 64 | (define (arithmetic-shift n s) 65 | (cond ((> s 0) (* n (expt 2 s))) 66 | (else 67 | (if (and (< n 0) (odd? n)) 68 | (error "NYI case shr") 69 | (quotient n (expt 2 (* -1 s))))))) 70 | -------------------------------------------------------------------------------- /lib/op.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define (equal? x y) 31 | (cond ((pair? x) (and (pair? y) 32 | (equal? (car x) (car y)) 33 | (equal? (cdr x) (cdr y)))) 34 | ((string? x) (and (string? y) 35 | (string=? x y))) 36 | ((vector? x) 37 | (and (vector? y) 38 | (eq? (vector-length x) 39 | (vector-length y)) 40 | (let loop ((idx (- (vector-length x) 1))) 41 | (if (< idx 0) 42 | #t 43 | (and (equal? (vector-ref x idx) 44 | (vector-ref y idx)) 45 | (loop (- idx 1))))))) 46 | (else (eqv? x y)))) 47 | -------------------------------------------------------------------------------- /lib/print.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define (print n) 31 | (gambit$$print n)) 32 | 33 | (define (println . n) 34 | (gambit$$println n)) 35 | 36 | (define (pp n) 37 | (gambit$$pp n)) 38 | 39 | (define write 40 | (lambda (n) 41 | (pp n))) 42 | 43 | (define (newline) 44 | (gambit$$newline)) 45 | -------------------------------------------------------------------------------- /lib/read.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define (read) 31 | (gambit$$read)) 32 | -------------------------------------------------------------------------------- /lib/vector.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define (vector-fill! v el) 31 | (let loop ((l (- (vector-length v) 1))) 32 | (if (= l -1) 33 | v 34 | (begin (vector-set! v l el) 35 | (loop (- l 1)))))) 36 | -------------------------------------------------------------------------------- /native.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (include "~~lib/_x86#.scm") 31 | (include "~~lib/_asm#.scm") 32 | 33 | (define C_CLOCK_MONOTONIC 1) 34 | (define C_SIZEOF_TIMESPEC 16) 35 | (define C_TIMESPEC_SEC_OFFSET 0) 36 | (define C_TIMESPEC_NSEC_OFFSET 8) 37 | 38 | (define LINUX_SYSCALL 39 | '((clock_gettime . 228))) 40 | 41 | ;;----------------------------------------------------------------------------- 42 | ;; WRITE-CHAR 43 | (define (gen-syscall-clock-gettime cgc) 44 | 45 | (x86-label cgc (asm-make-label #f (new-sym 'syscall_clock-gettime_))) 46 | 47 | ;; Save destroyed regs 48 | (x86-upush cgc (x86-rcx)) ;; Destroyed by kernel (System V Application Binary Interface AMD64 Architecture Processor Supplement section A.2) 49 | (x86-upush cgc (x86-r11)) ;; Destroyed by kernel (System V Application Binary Interface AMD64 Architecture Processor Supplement section A.2) 50 | (x86-upush cgc (x86-rdi)) 51 | (x86-upush cgc (x86-rsi)) 52 | 53 | ;; Clock in rdi 54 | (x86-mov cgc (x86-rdi) (x86-imm-int C_CLOCK_MONOTONIC)) 55 | 56 | ;; timespect struct address in rsi 57 | ;; alloc struct in pstack! 58 | (x86-sub cgc (x86-rsp) (x86-imm-int C_SIZEOF_TIMESPEC)) 59 | (x86-mov cgc (x86-rsi) (x86-rsp)) 60 | 61 | ;; syscall number (rax) 62 | (x86-mov cgc (x86-rax) (x86-imm-int (cdr (assoc 'clock_gettime LINUX_SYSCALL)))) 63 | 64 | (x86-syscall cgc) 65 | 66 | ;; 67 | (x86-mov cgc (x86-rax) (x86-mem C_TIMESPEC_SEC_OFFSET (x86-rsp))) 68 | (x86-mov cgc (x86-rcx) (x86-imm-int (expt 10 9))) 69 | (x86-imul cgc (x86-rax) (x86-rcx)) 70 | (x86-add cgc (x86-rax) (x86-mem C_TIMESPEC_NSEC_OFFSET (x86-rsp))) 71 | 72 | (x86-add cgc (x86-rsp) (x86-imm-int C_SIZEOF_TIMESPEC)) 73 | 74 | (x86-upop cgc (x86-rsi)) 75 | (x86-upop cgc (x86-rdi)) 76 | (x86-upop cgc (x86-r11)) 77 | (x86-upop cgc (x86-rcx))) 78 | -------------------------------------------------------------------------------- /test.scm.json: -------------------------------------------------------------------------------- 1 | {"config":{"exec-file":"/home/bapt/Bureau/testPycket/pycket/racket","init-file":"/home/bapt/.racketrc","collects-dir":"/home/bapt/Bureau/testPycket/collects","version":"7.0.0.20","run-file":"/home/bapt/Bureau/testPycket/pycket/racket","orig-dir":"/home/bapt/Bureau/testPycket/pycket","sys-dir":"/","pref-file":"/home/bapt/.racket/racket-prefs.rktd","bytecode-expand":"false","temp-dir":"/var/tmp","config-dir":"/home/bapt/Bureau/testPycket/etc","home-dir":"/home/bapt","doc-dir":"/home/bapt","pref-dir":"/home/bapt/.racket","init-dir":"/home/bapt","addon-dir":"/home/bapt/.racket"},"module-name":"test","body-forms":[{"module-name":"configure-runtime","body-forms":[{"module-name":"configure-runtime","body-forms":[{"require":[["/home/bapt/Bureau/testPycket/racket/racket/collects/racket/runtime-config.rkt"]]},{"operands":[{"quote":false}],"operator":{"source-name":"configure","source-module":["/home/bapt/Bureau/testPycket/racket/racket/collects/racket/runtime-config.rkt"]}}],"language":["#%kernel"]},{"require":[["/home/bapt/Bureau/testPycket/racket/racket/share/pkgs/r5rs-lib/r5rs/init.rkt"]]}],"language":["/home/bapt/Bureau/testPycket/racket/racket/collects/racket/base.rkt"]},{"require":[["/home/bapt/Bureau/testPycket/racket/racket/share/pkgs/compatibility-lib/compatibility/defmacro.rkt"]]},{"require":[["/home/bapt/Bureau/testPycket/racket/racket/collects/racket/base.rkt"]]},{"define-values-body":{"quote":{"number":{"integer":"0"}}},"define-values-names":["sum"],"define-values":["sum"]},{"define-values-body":{"body":[{"letrec-body":[{"let-body":[[{"source-name":"set!"},{"source-name":"sum","source-module":["/home/bapt/Bureau/these/lc/test.scm"]},{"quote":{"number":{"integer":"-199"}}}],{"operands":[{"quote":{"number":{"integer":"0"}}}],"operator":{"letrec-body":[{"lexical":"doloop"}],"letrec-bindings":[[["doloop"],{"body":[{"else":[{"source-name":"begin"},[{"source-name":"set!"},{"source-name":"sum","source-module":["/home/bapt/Bureau/these/lc/test.scm"]},{"operands":[{"source-name":"sum","source-module":["/home/bapt/Bureau/these/lc/test.scm"]},{"quote":{"number":{"integer":"4"}}}],"operator":{"source-name":"+"}}],{"operands":[{"operands":[{"lexical":"i"},{"quote":{"number":{"integer":"1"}}}],"operator":{"source-name":"+"}}],"operator":{"lexical":"doloop"}}],"then":[{"source-name":"begin"},{"operands":[],"operator":{"source-name":"void"}},{"source-name":"sum","source-module":["/home/bapt/Bureau/these/lc/test.scm"]}],"test":{"operands":[{"lexical":"i"},{"lexical":"n"}],"operator":{"source-name":">="}}}],"lambda":[{"lexical":"i"}]}]]}}],"let-bindings":[]}],"letrec-bindings":[[[],{"operands":[],"operator":{"source-name":"values"}}]]}],"lambda":[{"lexical":"n"}]},"define-values-names":["do-loop"],"define-values":["do-loop"]},{"define-values-body":{"quote":{"number":{"integer":"1000000000"}}},"define-values-names":["aaa"],"define-values":["aaa"]},{"let-body":[{"operands":[{"quote":{"string":"cpu time: ~s real time: ~s gc time: ~s\n"}},{"lexical":"cpu"},{"lexical":"user"},{"lexical":"gc"}],"operator":{"source-name":"printf"}},{"operands":[{"source-name":"values"},{"lexical":"v"}],"operator":{"source-name":"apply"}}],"let-bindings":[[["v","cpu","user","gc"],{"operands":[{"body":[{"operands":[{"source-name":"aaa","source-module":["/home/bapt/Bureau/these/lc/test.scm"]}],"operator":{"source-name":"do-loop","source-module":["/home/bapt/Bureau/these/lc/test.scm"]}}],"lambda":[]},{"source-name":"null"}],"operator":{"source-name":"time-apply"}}]]},{"operands":[],"operator":{"source-name":"newline"}}],"language":["/home/bapt/Bureau/testPycket/racket/racket/share/pkgs/r5rs-lib/r5rs/main.rkt"]} 2 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/ack.scm: -------------------------------------------------------------------------------- 1 | ;;; ACK -- One of the Kernighan and Van Wyk benchmarks. 2 | 3 | (define (ack m n) 4 | (cond ((= m 0) (+ n 1)) 5 | ((= n 0) (ack (- m 1) 1)) 6 | (else (ack (- m 1) (ack m (- n 1)))))) 7 | 8 | (define (main . args) 9 | (run-benchmark 10 | "ack" 11 | ack-iters 12 | (lambda (result) (equal? result 4093)) 13 | (lambda (m n) (lambda () (ack m n))) 14 | 3 15 | 9)) 16 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/array1.scm: -------------------------------------------------------------------------------- 1 | ;;; ARRAY1 -- One of the Kernighan and Van Wyk benchmarks. 2 | 3 | (define (create-x n) 4 | (define result (make-vector n)) 5 | (do ((i 0 (+ i 1))) 6 | ((>= i n) result) 7 | (vector-set! result i i))) 8 | 9 | (define (create-y x) 10 | (let* ((n (vector-length x)) 11 | (result (make-vector n))) 12 | (do ((i (- n 1) (- i 1))) 13 | ((< i 0) result) 14 | (vector-set! result i (vector-ref x i))))) 15 | 16 | (define (my-try n) 17 | (vector-length (create-y (create-x n)))) 18 | 19 | (define (go n) 20 | (let loop ((repeat 100) 21 | (result '())) 22 | (if (> repeat 0) 23 | (loop (- repeat 1) (my-try n)) 24 | result))) 25 | 26 | (define (main . args) 27 | (run-benchmark 28 | "array1" 29 | array1-iters 30 | (lambda (result) (equal? result 200000)) 31 | (lambda (n) (lambda () (go n))) 32 | 200000)) 33 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/cpstak.scm: -------------------------------------------------------------------------------- 1 | ;;; CPSTAK -- A continuation-passing version of the TAK benchmark. 2 | ;;; A good test of first class procedures and tail recursion. 3 | 4 | (define (cpstak x y z) 5 | 6 | (define (tak x y z k) 7 | (if (not (< y x)) 8 | (k z) 9 | (tak (- x 1) 10 | y 11 | z 12 | (lambda (v1) 13 | (tak (- y 1) 14 | z 15 | x 16 | (lambda (v2) 17 | (tak (- z 1) 18 | x 19 | y 20 | (lambda (v3) 21 | (tak v1 v2 v3 k))))))))) 22 | 23 | (tak x y z (lambda (a) a))) 24 | 25 | (define (main . args) 26 | (run-benchmark 27 | "cpstak" 28 | cpstak-iters 29 | (lambda (result) (equal? result 7)) 30 | (lambda (x y z) (lambda () (cpstak x y z))) 31 | 18 32 | 12 33 | 6)) 34 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/dderiv.scm: -------------------------------------------------------------------------------- 1 | ;;; DDERIV -- Table-driven symbolic derivation. 2 | 3 | ;;; Returns the wrong answer for quotients. 4 | ;;; Fortunately these aren't used in the benchmark. 5 | 6 | (define (lookup key table) 7 | (let loop ((x table)) 8 | (if (null? x) 9 | #f 10 | (let ((pair (car x))) 11 | (if (eq? (car pair) key) 12 | pair 13 | (loop (cdr x))))))) 14 | 15 | (define properties '()) 16 | 17 | (define (get key1 key2) 18 | (let ((x (lookup key1 properties))) 19 | (if x 20 | (let ((y (lookup key2 (cdr x)))) 21 | (if y 22 | (cdr y) 23 | #f)) 24 | #f))) 25 | 26 | (define (put key1 key2 val) 27 | (let ((x (lookup key1 properties))) 28 | (if x 29 | (let ((y (lookup key2 (cdr x)))) 30 | (if y 31 | (set-cdr! y val) 32 | (set-cdr! x (cons (cons key2 val) (cdr x))))) 33 | (set! properties 34 | (cons (list key1 (cons key2 val)) properties))))) 35 | 36 | (define (my+dderiv a) 37 | (cons '+ 38 | (map dderiv (cdr a)))) 39 | 40 | (define (my-dderiv a) 41 | (cons '- 42 | (map dderiv (cdr a)))) 43 | 44 | (define (*dderiv a) 45 | (list '* 46 | a 47 | (cons '+ 48 | (map (lambda (a) (list '/ (dderiv a) a)) (cdr a))))) 49 | 50 | (define (/dderiv a) 51 | (list '- 52 | (list '/ 53 | (dderiv (cadr a)) 54 | (caddr a)) 55 | (list '/ 56 | (cadr a) 57 | (list '* 58 | (caddr a) 59 | (caddr a) 60 | (dderiv (caddr a)))))) 61 | 62 | (put '+ 'dderiv my+dderiv) 63 | (put '- 'dderiv my-dderiv) 64 | (put '* 'dderiv *dderiv) 65 | (put '/ 'dderiv /dderiv) 66 | 67 | (define (dderiv a) 68 | (if (not (pair? a)) 69 | (if (eq? a 'x) 1 0) 70 | (let ((f (get (car a) 'dderiv))) 71 | (if f 72 | (f a) 73 | (fatal-error "No derivation method available"))))) 74 | 75 | (define (main . args) 76 | (run-benchmark 77 | "dderiv" 78 | dderiv-iters 79 | (lambda (result) 80 | (equal? result 81 | '(+ (* (* 3 x x) (+ (/ 0 3) (/ 1 x) (/ 1 x))) 82 | (* (* a x x) (+ (/ 0 a) (/ 1 x) (/ 1 x))) 83 | (* (* b x) (+ (/ 0 b) (/ 1 x))) 84 | 0))) 85 | (lambda (a) (lambda () (dderiv a))) 86 | '(+ (* 3 x x) (* a x x) (* b x) 5))) 87 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/deriv.scm: -------------------------------------------------------------------------------- 1 | ;;; DERIV -- Symbolic derivation. 2 | 3 | ;;; Returns the wrong answer for quotients. 4 | ;;; Fortunately these aren't used in the benchmark. 5 | 6 | (define (deriv a) 7 | (cond ((not (pair? a)) 8 | (if (eq? a 'x) 1 0)) 9 | ((eq? (car a) '+) 10 | (cons '+ 11 | (map deriv (cdr a)))) 12 | ((eq? (car a) '-) 13 | (cons '- 14 | (map deriv (cdr a)))) 15 | ((eq? (car a) '*) 16 | (list '* 17 | a 18 | (cons '+ 19 | (map (lambda (a) (list '/ (deriv a) a)) (cdr a))))) 20 | ((eq? (car a) '/) 21 | (list '- 22 | (list '/ 23 | (deriv (cadr a)) 24 | (caddr a)) 25 | (list '/ 26 | (cadr a) 27 | (list '* 28 | (caddr a) 29 | (caddr a) 30 | (deriv (caddr a)))))) 31 | (else 32 | (fatal-error "No derivation method available")))) 33 | 34 | (define (main . args) 35 | (run-benchmark 36 | "deriv" 37 | deriv-iters 38 | (lambda (result) 39 | (equal? result 40 | '(+ (* (* 3 x x) (+ (/ 0 3) (/ 1 x) (/ 1 x))) 41 | (* (* a x x) (+ (/ 0 a) (/ 1 x) (/ 1 x))) 42 | (* (* b x) (+ (/ 0 b) (/ 1 x))) 43 | 0))) 44 | (lambda (a) (lambda () (deriv a))) 45 | '(+ (* 3 x x) (* a x x) (* b x) 5))) 46 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/destruc.scm: -------------------------------------------------------------------------------- 1 | ;;; DESTRUC -- Destructive operation benchmark. 2 | 3 | (define (append-to-tail! x y) 4 | (if (null? x) 5 | y 6 | (let loop ((a x) (b (cdr x))) 7 | (if (null? b) 8 | (begin 9 | (set-cdr! a y) 10 | x) 11 | (loop b (cdr b)))))) 12 | 13 | (define (destructive n m) 14 | (let ((l (do ((i 10 (- i 1)) (a '() (cons '() a))) 15 | ((= i 0) a)))) 16 | (do ((i n (- i 1))) 17 | ((= i 0) l) 18 | (cond ((null? (car l)) 19 | (do ((l l (cdr l))) 20 | ((null? l)) 21 | (if (null? (car l)) (set-car! l (cons '() '()))) 22 | (append-to-tail! (car l) 23 | (do ((j m (- j 1)) (a '() (cons '() a))) 24 | ((= j 0) a))))) 25 | (else 26 | (do ((l1 l (cdr l1)) (l2 (cdr l) (cdr l2))) 27 | ((null? l2)) 28 | (set-cdr! (do ((j (quotient (length (car l2)) 2) (- j 1)) 29 | (a (car l2) (cdr a))) 30 | ((zero? j) a) 31 | (set-car! a i)) 32 | (let ((n (quotient (length (car l1)) 2))) 33 | (cond ((= n 0) 34 | (set-car! l1 '()) 35 | (car l1)) 36 | (else 37 | (do ((j n (- j 1)) (a (car l1) (cdr a))) 38 | ((= j 1) 39 | (let ((x (cdr a))) 40 | (set-cdr! a '()) 41 | x)) 42 | (set-car! a i)))))))))))) 43 | 44 | (define (main . args) 45 | (run-benchmark 46 | "destruc" 47 | destruc-iters 48 | (lambda (result) 49 | (equal? result 50 | '((1 1 2) 51 | (1 1 1) 52 | (1 1 1 2) 53 | (1 1 1 1) 54 | (1 1 1 1 2) 55 | (1 1 1 1 2) 56 | (1 1 1 1 2) 57 | (1 1 1 1 2) 58 | (1 1 1 1 2) 59 | (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 3)))) 60 | (lambda (n m) (lambda () (destructive n m))) 61 | 600 62 | 50)) 63 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/diviter.scm: -------------------------------------------------------------------------------- 1 | ;;; DIVITER -- Benchmark which divides by 2 using lists of n ()'s. 2 | 3 | (define (create-n n) 4 | (do ((n n (- n 1)) 5 | (a '() (cons '() a))) 6 | ((= n 0) a))) 7 | 8 | (define *ll* (create-n 200)) 9 | 10 | (define (iterative-div2 l) 11 | (do ((l l (cddr l)) 12 | (a '() (cons (car l) a))) 13 | ((null? l) a))) 14 | 15 | (define (main . args) 16 | (run-benchmark 17 | "diviter" 18 | diviter-iters 19 | (lambda (result) 20 | (equal? result 21 | '(() () () () () () () () () () () () () () () () () () () () 22 | () () () () () () () () () () () () () () () () () () () () 23 | () () () () () () () () () () () () () () () () () () () () 24 | () () () () () () () () () () () () () () () () () () () () 25 | () () () () () () () () () () () () () () () () () () () ()))) 26 | (lambda (l) (lambda () (iterative-div2 l))) 27 | *ll*)) 28 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/divrec.scm: -------------------------------------------------------------------------------- 1 | ;;; DIVREC -- Benchmark which divides by 2 using lists of n ()'s. 2 | 3 | (define (create-n n) 4 | (do ((n n (- n 1)) 5 | (a '() (cons '() a))) 6 | ((= n 0) a))) 7 | 8 | (define *ll* (create-n 200)) 9 | 10 | (define (recursive-div2 l) 11 | (cond ((null? l) '()) 12 | (else (cons (car l) (recursive-div2 (cddr l)))))) 13 | 14 | (define (main . args) 15 | (run-benchmark 16 | "divrec" 17 | divrec-iters 18 | (lambda (result) 19 | (equal? result 20 | '(() () () () () () () () () () () () () () () () () () () () 21 | () () () () () () () () () () () () () () () () () () () () 22 | () () () () () () () () () () () () () () () () () () () () 23 | () () () () () () () () () () () () () () () () () () () () 24 | () () () () () () () () () () () () () () () () () () () ()))) 25 | (lambda (l) (lambda () (recursive-div2 l))) 26 | *ll*)) 27 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/fft.scm: -------------------------------------------------------------------------------- 1 | ;;; FFT - Fast Fourier Transform, translated from "Numerical Recipes in C" 2 | 3 | (define (four1 data) 4 | (let ((n (FLOATvector-length data)) 5 | (pi*2 6.28318530717959)) ; to compute the inverse, negate this value 6 | 7 | ; bit-reversal section 8 | 9 | (let loop1 ((i 0) (j 0)) 10 | (if (< i n) 11 | (begin 12 | (if (< i j) 13 | (begin 14 | (let ((temp (FLOATvector-ref data i))) 15 | (FLOATvector-set! data i (FLOATvector-ref data j)) 16 | (FLOATvector-set! data j temp)) 17 | (let ((temp (FLOATvector-ref data (+ i 1)))) 18 | (FLOATvector-set! data (+ i 1) (FLOATvector-ref data (+ j 1))) 19 | (FLOATvector-set! data (+ j 1) temp)))) 20 | (let loop2 ((m (quotient n 2)) (j j)) 21 | (if (and (>= m 2) (>= j m)) 22 | (loop2 (quotient m 2) (- j m)) 23 | (loop1 (+ i 2) (+ j m))))))) 24 | 25 | ; Danielson-Lanczos section 26 | 27 | (let loop3 ((mmax 2)) 28 | (if (< mmax n) 29 | (let* ((theta 30 | (FLOAT/ pi*2 (exact->inexact mmax))) 31 | (wpr 32 | (let ((x (FLOATsin (FLOAT* 0.5 theta)))) 33 | (FLOAT* -2.0 (FLOAT* x x)))) 34 | (wpi 35 | (FLOATsin theta))) 36 | (let loop4 ((wr 1.0) (wi 0.0) (m 0)) 37 | (if (< m mmax) 38 | (begin 39 | (let loop5 ((i m)) 40 | (if (< i n) 41 | (let* ((j 42 | (+ i mmax)) 43 | (tempr 44 | (FLOAT- 45 | (FLOAT* wr (FLOATvector-ref data j)) 46 | (FLOAT* wi (FLOATvector-ref data (+ j 1))))) 47 | (tempi 48 | (FLOAT+ 49 | (FLOAT* wr (FLOATvector-ref data (+ j 1))) 50 | (FLOAT* wi (FLOATvector-ref data j))))) 51 | (FLOATvector-set! data j 52 | (FLOAT- (FLOATvector-ref data i) tempr)) 53 | (FLOATvector-set! data (+ j 1) 54 | (FLOAT- (FLOATvector-ref data (+ i 1)) tempi)) 55 | (FLOATvector-set! data i 56 | (FLOAT+ (FLOATvector-ref data i) tempr)) 57 | (FLOATvector-set! data (+ i 1) 58 | (FLOAT+ (FLOATvector-ref data (+ i 1)) tempi)) 59 | (loop5 (+ j mmax)));***)) 60 | (loop4 (FLOAT+ (FLOAT- (FLOAT* wr wpr) (FLOAT* wi wpi)) wr) 61 | (FLOAT+ (FLOAT+ (FLOAT* wi wpr) (FLOAT* wr wpi)) wi) 62 | (+ m 2))))) 63 | ));****** 64 | (loop3 (* mmax 2))))))) 65 | 66 | (define data 67 | (FLOATmake-vector 1024 0.0)) 68 | 69 | (define (run data) 70 | (four1 data) 71 | (FLOATvector-ref data 0)) 72 | 73 | (define (main . args) 74 | (run-benchmark 75 | "fft" 76 | fft-iters 77 | (lambda (result) (equal? result 0.0)) 78 | (lambda (data) (lambda () (run data))) 79 | data)) 80 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/fib.scm: -------------------------------------------------------------------------------- 1 | ;;; FIB -- A classic benchmark, computes fib(35) inefficiently. 2 | 3 | (define (fib n) 4 | (if (< n 2) 5 | n 6 | (+ (fib (- n 1)) 7 | (fib (- n 2))))) 8 | 9 | (define (main . args) 10 | (run-benchmark 11 | "fib" 12 | fib-iters 13 | (lambda (result) (equal? result 9227465)) 14 | (lambda (n) (lambda () (fib n))) 15 | 35)) 16 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/fibfp.scm: -------------------------------------------------------------------------------- 1 | ;;; FIBFP -- Computes fib(35) using floating point 2 | 3 | (define (fibfp n) 4 | (if (FLOAT< n 2.) 5 | n 6 | (FLOAT+ (fibfp (FLOAT- n 1.)) 7 | (fibfp (FLOAT- n 2.))))) 8 | 9 | (define (main . args) 10 | (run-benchmark 11 | "fibfp" 12 | fibfp-iters 13 | (lambda (result) (equal? result 9227465.)) 14 | (lambda (n) (lambda () (fibfp n))) 15 | 35.)) 16 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/mbrot.scm: -------------------------------------------------------------------------------- 1 | ;;; MBROT -- Generation of Mandelbrot set fractal. 2 | 3 | (define (count r i step x y) 4 | 5 | (let ((max-count 64) 6 | (radius^2 16.0)) 7 | 8 | (let ((cr (FLOAT+ r (FLOAT* (exact->inexact x) step))) 9 | (ci (FLOAT+ i (FLOAT* (exact->inexact y) step)))) 10 | 11 | (let loop ((zr cr) 12 | (zi ci) 13 | (c 0)) 14 | (if (= c max-count) 15 | c 16 | (let ((zr^2 (FLOAT* zr zr)) 17 | (zi^2 (FLOAT* zi zi))) 18 | (if (FLOAT> (FLOAT+ zr^2 zi^2) radius^2) 19 | c 20 | (let ((new-zr (FLOAT+ (FLOAT- zr^2 zi^2) cr)) 21 | (new-zi (FLOAT+ (FLOAT* 2.0 (FLOAT* zr zi)) ci))) 22 | (loop new-zr new-zi (+ c 1)))))))))) 23 | 24 | (define (mbrot matrix r i step n) 25 | (let loop1 ((y (- n 1))) 26 | (if (>= y 0) 27 | (let loop2 ((x (- n 1))) 28 | (if (>= x 0) 29 | (begin 30 | (vector-set! (vector-ref matrix x) y (count r i step x y)) 31 | (loop2 (- x 1))) 32 | (loop1 (- y 1))))))) 33 | 34 | (define (test n) 35 | (let ((matrix (make-vector n))) 36 | (let loop ((i (- n 1))) 37 | (if (>= i 0) 38 | (begin 39 | (vector-set! matrix i (make-vector n)) 40 | (loop (- i 1))))) 41 | (mbrot matrix -1.0 -0.5 0.005 n) 42 | (vector-ref (vector-ref matrix 0) 0))) 43 | 44 | (define (main . args) 45 | (run-benchmark 46 | "mbrot" 47 | mbrot-iters 48 | (lambda (result) (equal? result 5)) 49 | (lambda (n) (lambda () (test n))) 50 | 75)) 51 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/nqueens.scm: -------------------------------------------------------------------------------- 1 | ;;; NQUEENS -- Compute number of solutions to 8-queens problem. 2 | 3 | (define trace? #f) 4 | 5 | (define (nqueens n) 6 | 7 | (define (_1-to n) 8 | (let loop ((i n) (l '())) 9 | (if (= i 0) l (loop (- i 1) (cons i l))))) 10 | 11 | (define (my-try x y z) 12 | (if (null? x) 13 | (if (null? y) 14 | (begin (if trace? (begin (write z) (newline))) 1) 15 | 0) 16 | (+ (if (ok? (car x) 1 z) 17 | (my-try (append (cdr x) y) '() (cons (car x) z)) 18 | 0) 19 | (my-try (cdr x) (cons (car x) y) z)))) 20 | 21 | (define (ok? row dist placed) 22 | (if (null? placed) 23 | #t 24 | (and (not (= (car placed) (+ row dist))) 25 | (not (= (car placed) (- row dist))) 26 | (ok? row (+ dist 1) (cdr placed))))) 27 | 28 | (my-try (_1-to n) '() '())) 29 | 30 | (define (main) 31 | (run-benchmark 32 | "nqueens" 33 | nqueens-iters 34 | (lambda (result) (equal? result 92)) 35 | (lambda (n) (lambda () (nqueens n))) 36 | 8)) 37 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/pnpoly.scm: -------------------------------------------------------------------------------- 1 | ;;; PNPOLY - Test if a point is contained in a 2D polygon. 2 | 3 | (define (pt-in-poly2 xp yp x y) 4 | (let loop ((c #f) (i (- (FLOATvector-length xp) 1)) (j 0)) 5 | (if (< i 0) 6 | c 7 | (if (or (and (or (FLOAT> (FLOATvector-ref yp i) y) 8 | (FLOAT>= y (FLOATvector-ref yp j))) 9 | (or (FLOAT> (FLOATvector-ref yp j) y) 10 | (FLOAT>= y (FLOATvector-ref yp i)))) 11 | (FLOAT>= x 12 | (FLOAT+ (FLOATvector-ref xp i) 13 | (FLOAT/ (FLOAT* 14 | (FLOAT- (FLOATvector-ref xp j) 15 | (FLOATvector-ref xp i)) 16 | (FLOAT- y (FLOATvector-ref yp i))) 17 | (FLOAT- (FLOATvector-ref yp j) 18 | (FLOATvector-ref yp i)))))) 19 | (loop c (- i 1) i) 20 | (loop (not c) (- i 1) i))))) 21 | 22 | (define (run) 23 | (let ((count 0) 24 | (xp (FLOATvector-const 0. 1. 1. 0. 0. 1. -.5 -1. -1. -2. -2.5 25 | -2. -1.5 -.5 1. 1. 0. -.5 -1. -.5)) 26 | (yp (FLOATvector-const 0. 0. 1. 1. 2. 3. 2. 3. 0. -.5 -1. 27 | -1.5 -2. -2. -1.5 -1. -.5 -1. -1. -.5))) 28 | (if (pt-in-poly2 xp yp .5 .5) (set! count (+ count 1))) 29 | (if (pt-in-poly2 xp yp .5 1.5) (set! count (+ count 1))) 30 | (if (pt-in-poly2 xp yp -.5 1.5) (set! count (+ count 1))) 31 | (if (pt-in-poly2 xp yp .75 2.25) (set! count (+ count 1))) 32 | (if (pt-in-poly2 xp yp 0. 2.01) (set! count (+ count 1))) 33 | (if (pt-in-poly2 xp yp -.5 2.5) (set! count (+ count 1))) 34 | (if (pt-in-poly2 xp yp -1. -.5) (set! count (+ count 1))) 35 | (if (pt-in-poly2 xp yp -1.5 .5) (set! count (+ count 1))) 36 | (if (pt-in-poly2 xp yp -2.25 -1.) (set! count (+ count 1))) 37 | (if (pt-in-poly2 xp yp .5 -.25) (set! count (+ count 1))) 38 | (if (pt-in-poly2 xp yp .5 -1.25) (set! count (+ count 1))) 39 | (if (pt-in-poly2 xp yp -.5 -2.5) (set! count (+ count 1))) 40 | count)) 41 | 42 | (define (main . args) 43 | (run-benchmark 44 | "pnpoly" 45 | pnpoly-iters 46 | (lambda (result) 47 | (and (number? result) (= result 6))) 48 | (lambda () (lambda () (run))))) 49 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/primes.scm: -------------------------------------------------------------------------------- 1 | ;;; PRIMES -- Compute primes less than 100, written by Eric Mohr. 2 | 3 | (define (interval-list m n) 4 | (if (> m n) 5 | '() 6 | (cons m (interval-list (+ 1 m) n)))) 7 | 8 | (define (sieve l) 9 | (letrec ((remove-multiples 10 | (lambda (n l) 11 | (if (null? l) 12 | '() 13 | (if (= (modulo (car l) n) 0) 14 | (remove-multiples n (cdr l)) 15 | (cons (car l) 16 | (remove-multiples n (cdr l)))))))) 17 | (if (null? l) 18 | '() 19 | (cons (car l) 20 | (sieve (remove-multiples (car l) (cdr l))))))) 21 | 22 | (define (primes<= n) 23 | (sieve (interval-list 2 n))) 24 | 25 | (define (main) 26 | (run-benchmark 27 | "primes" 28 | primes-iters 29 | (lambda (result) 30 | (equal? result 31 | '(2 3 5 7 11 13 17 19 23 29 31 37 41 32 | 43 47 53 59 61 67 71 73 79 83 89 97))) 33 | (lambda (n) (lambda () (primes<= n))) 34 | 100)) 35 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/sum.scm: -------------------------------------------------------------------------------- 1 | ;;; SUM -- Compute sum of integers from 0 to 10000 2 | 3 | (define (run n) 4 | (let loop ((i n) (sum 0)) 5 | (if (< i 0) 6 | sum 7 | (loop (- i 1) (+ i sum))))) 8 | 9 | (define (main . args) 10 | (run-benchmark 11 | "sum" 12 | sum-iters 13 | (lambda (result) (equal? result 50005000)) 14 | (lambda (n) (lambda () (run n))) 15 | 10000)) 16 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/sumfp.scm: -------------------------------------------------------------------------------- 1 | ;;; SUMFP -- Compute sum of integers from 0 to 10000 using floating point 2 | 3 | (define (run n) 4 | (let loop ((i n) (sum 0.)) 5 | (if (FLOAT< i 0.) 6 | sum 7 | (loop (FLOAT- i 1.) (FLOAT+ i sum))))) 8 | 9 | (define (main . args) 10 | (run-benchmark 11 | "sumfp" 12 | sumfp-iters 13 | (lambda (result) (equal? result 50005000.)) 14 | (lambda (n) (lambda () (run n))) 15 | 10000.)) 16 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/sumloop.scm: -------------------------------------------------------------------------------- 1 | ;;; SUMLOOP -- One of the Kernighan and Van Wyk benchmarks. 2 | 3 | (define sum 0) 4 | 5 | (define (tail-rec-aux i n) 6 | (if (< i n) 7 | (begin (set! sum (+ sum 1)) (tail-rec-aux (+ i 1) n)) 8 | sum)) 9 | 10 | (define (tail-rec-loop n) 11 | (set! sum 0) 12 | (tail-rec-aux 0 n) 13 | sum) 14 | 15 | (define (do-loop n) 16 | (set! sum 0) 17 | (do ((i 0 (+ i 1))) 18 | ((>= i n) sum) 19 | (set! sum (+ sum 1)))) 20 | 21 | (define (main . args) 22 | (run-benchmark 23 | "sumloop" 24 | sumloop-iters 25 | (lambda (result) (equal? result 100000000)) 26 | (lambda (n) (lambda () (do-loop n))) 27 | 100000000)) 28 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/tak.scm: -------------------------------------------------------------------------------- 1 | ;;; TAK -- A vanilla version of the TAKeuchi function. 2 | 3 | (define (tak x y z) 4 | (if (not (< y x)) 5 | z 6 | (tak (tak (- x 1) y z) 7 | (tak (- y 1) z x) 8 | (tak (- z 1) x y)))) 9 | 10 | (define (main . args) 11 | (run-benchmark 12 | "tak" 13 | tak-iters 14 | (lambda (result) (equal? result 7)) 15 | (lambda (x y z) (lambda () (tak x y z))) 16 | 18 17 | 12 18 | 6)) 19 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/takl.scm: -------------------------------------------------------------------------------- 1 | ;;; TAKL -- The TAKeuchi function using lists as counters. 2 | 3 | (define (listn n) 4 | (if (= n 0) 5 | '() 6 | (cons n (listn (- n 1))))) 7 | 8 | (define l18 (listn 18)) 9 | (define l12 (listn 12)) 10 | (define l6 (listn 6)) 11 | 12 | (define (mas x y z) 13 | (if (not (shorterp y x)) 14 | z 15 | (mas (mas (cdr x) y z) 16 | (mas (cdr y) z x) 17 | (mas (cdr z) x y)))) 18 | 19 | (define (shorterp x y) 20 | (and (not (null? y)) 21 | (or (null? x) 22 | (shorterp (cdr x) 23 | (cdr y))))) 24 | 25 | (define (main . args) 26 | (run-benchmark 27 | "takl" 28 | takl-iters 29 | (lambda (result) (equal? result '(7 6 5 4 3 2 1))) 30 | (lambda (x y z) (lambda () (mas x y z))) 31 | l18 32 | l12 33 | l6)) 34 | -------------------------------------------------------------------------------- /tools/benchtimes/bench/triangl.scm: -------------------------------------------------------------------------------- 1 | ;;; TRIANGL -- Board game benchmark. 2 | 3 | (define *board* 4 | (list->vector '(1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1))) 5 | 6 | (define *sequence* 7 | (list->vector '(0 0 0 0 0 0 0 0 0 0 0 0 0 0))) 8 | 9 | (define *a* 10 | (list->vector '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 11 | 13 7 8 4 4 7 11 8 12 13 6 10 12 | 15 9 14 13 13 14 15 9 10 13 | 6 6))) 14 | 15 | (define *b* 16 | (list->vector '(2 4 7 5 8 9 3 6 10 5 9 8 17 | 12 13 14 8 9 5 2 4 7 5 8 18 | 9 3 6 10 5 9 8 12 13 14 19 | 8 9 5 5))) 20 | 21 | (define *c* 22 | (list->vector '(4 7 11 8 12 13 6 10 15 9 14 13 23 | 13 14 15 9 10 6 1 2 4 3 5 6 1 24 | 3 6 2 5 4 11 12 13 7 8 4 4))) 25 | 26 | (define *answer* '()) 27 | 28 | (define (attempt i depth) 29 | (cond ((= depth 14) 30 | (set! *answer* 31 | (cons (cdr (vector->list *sequence*)) *answer*)) 32 | #t) 33 | ((and (= 1 (vector-ref *board* (vector-ref *a* i))) 34 | (= 1 (vector-ref *board* (vector-ref *b* i))) 35 | (= 0 (vector-ref *board* (vector-ref *c* i)))) 36 | (vector-set! *board* (vector-ref *a* i) 0) 37 | (vector-set! *board* (vector-ref *b* i) 0) 38 | (vector-set! *board* (vector-ref *c* i) 1) 39 | (vector-set! *sequence* depth i) 40 | (do ((j 0 (+ j 1)) 41 | (depth (+ depth 1))) 42 | ((or (= j 36) (attempt j depth)) #f)) 43 | (vector-set! *board* (vector-ref *a* i) 1) 44 | (vector-set! *board* (vector-ref *b* i) 1) 45 | (vector-set! *board* (vector-ref *c* i) 0) #f) 46 | (else #f))) 47 | 48 | (define (test i depth) 49 | (set! *answer* '()) 50 | (attempt i depth) 51 | (car *answer*)) 52 | 53 | (define (main . args) 54 | (run-benchmark 55 | "triangl" 56 | triangl-iters 57 | (lambda (result) (equal? result '(22 34 31 15 7 1 20 17 25 6 5 13 32))) 58 | (lambda (i depth) (lambda () (test i depth))) 59 | 22 60 | 1)) 61 | -------------------------------------------------------------------------------- /tools/benchtimes/num-iters.scm: -------------------------------------------------------------------------------- 1 | ; Gabriel benchmarks 2 | (define boyer-iters 20) 3 | (define browse-iters 600) 4 | (define cpstak-iters 1000) 5 | (define ctak-iters 100) 6 | (define dderiv-iters 2000000) 7 | (define deriv-iters 2000000) 8 | (define destruc-iters 500) 9 | (define diviter-iters 1000000) 10 | (define divrec-iters 1000000) 11 | (define puzzle-iters 100) 12 | (define tak-iters 2000) 13 | (define takl-iters 300) 14 | (define trav1-iters 100) 15 | (define trav2-iters 20) 16 | (define triangl-iters 10) 17 | 18 | ; Kernighan and Van Wyk benchmarks 19 | (define ack-iters 10) 20 | (define array1-iters 1) 21 | (define cat-iters 1) 22 | (define string-iters 10) 23 | (define sum1-iters 10) 24 | (define sumloop-iters 10) 25 | (define tail-iters 1) 26 | (define wc-iters 1) 27 | 28 | ; C benchmarks 29 | (define fft-iters 2000) 30 | (define fib-iters 5) 31 | (define fibfp-iters 2) 32 | (define mbrot-iters 100) 33 | (define nucleic-iters 5) 34 | (define pnpoly-iters 100000) 35 | (define sum-iters 20000) 36 | (define sumfp-iters 20000) 37 | (define tfib-iters 20) 38 | 39 | ; Other benchmarks 40 | (define conform-iters 40) 41 | (define dynamic-iters 20) 42 | (define earley-iters 200) 43 | (define fibc-iters 500) 44 | (define graphs-iters 300) 45 | (define lattice-iters 1) 46 | (define matrix-iters 400) 47 | (define maze-iters 4000) 48 | (define mazefun-iters 1000) 49 | (define nqueens-iters 2000) 50 | (define paraffins-iters 1000) 51 | (define peval-iters 200) 52 | (define pi-iters 2) 53 | (define primes-iters 100000) 54 | (define ray-iters 5) 55 | (define scheme-iters 20000) 56 | (define simplex-iters 100000) 57 | (define slatex-iters 20) 58 | (define perm9-iters 10) 59 | (define nboyer-iters 100) 60 | (define sboyer-iters 100) 61 | (define gcbench-iters 1) 62 | (define compiler-iters 300) 63 | (define nbody-iters 1) 64 | (define fftrad4-iters 4) 65 | -------------------------------------------------------------------------------- /tools/benchtimes/num-itersSAVE.scm: -------------------------------------------------------------------------------- 1 | ; Gabriel benchmarks 2 | (define boyer-iters 20) 3 | (define browse-iters 600) 4 | (define cpstak-iters 1000) 5 | (define ctak-iters 100) 6 | (define dderiv-iters 2000000) 7 | (define deriv-iters 2000000) 8 | (define destruc-iters 500) 9 | (define diviter-iters 1000000) 10 | (define divrec-iters 1000000) 11 | (define puzzle-iters 100) 12 | (define tak-iters 2000) 13 | (define takl-iters 300) 14 | (define trav1-iters 100) 15 | (define trav2-iters 20) 16 | (define triangl-iters 10) 17 | 18 | ; Kernighan and Van Wyk benchmarks 19 | (define ack-iters 10) 20 | (define array1-iters 1) 21 | (define cat-iters 1) 22 | (define string-iters 10) 23 | (define sum1-iters 10) 24 | (define sumloop-iters 10) 25 | (define tail-iters 1) 26 | (define wc-iters 1) 27 | 28 | ; C benchmarks 29 | (define fft-iters 2000) 30 | (define fib-iters 5) 31 | (define fibfp-iters 2) 32 | (define mbrot-iters 100) 33 | (define nucleic-iters 5) 34 | (define pnpoly-iters 100000) 35 | (define sum-iters 20000) 36 | (define sumfp-iters 20000) 37 | (define tfib-iters 20) 38 | 39 | ; Other benchmarks 40 | (define conform-iters 40) 41 | (define dynamic-iters 20) 42 | (define earley-iters 200) 43 | (define fibc-iters 500) 44 | (define graphs-iters 300) 45 | (define lattice-iters 1) 46 | (define matrix-iters 400) 47 | (define maze-iters 4000) 48 | (define mazefun-iters 1000) 49 | (define nqueens-iters 2000) 50 | (define paraffins-iters 1000) 51 | (define peval-iters 200) 52 | (define pi-iters 2) 53 | (define primes-iters 100000) 54 | (define ray-iters 5) 55 | (define scheme-iters 20000) 56 | (define simplex-iters 100000) 57 | (define slatex-iters 20) 58 | (define perm9-iters 10) 59 | (define nboyer-iters 100) 60 | (define sboyer-iters 100) 61 | (define gcbench-iters 1) 62 | (define compiler-iters 300) 63 | -------------------------------------------------------------------------------- /tools/benchtimes/num-itersx10.scm: -------------------------------------------------------------------------------- 1 | ; Gabriel benchmarks 2 | (define boyer-iters 200) 3 | (define browse-iters 6000) 4 | (define cpstak-iters 10000) 5 | (define ctak-iters 1000) 6 | (define dderiv-iters 20000000) 7 | (define deriv-iters 20000000) 8 | (define destruc-iters 5000) 9 | (define diviter-iters 10000000) 10 | (define divrec-iters 10000000) 11 | (define puzzle-iters 1000) 12 | (define tak-iters 20000) 13 | (define takl-iters 3000) 14 | (define trav1-iters 1000) 15 | (define trav2-iters 200) 16 | (define triangl-iters 100) 17 | 18 | ; Kernighan and Van Wyk benchmarks 19 | (define ack-iters 100) 20 | (define array1-iters 10) 21 | (define cat-iters 10) 22 | (define string-iters 100) 23 | (define sum1-iters 100) 24 | (define sumloop-iters 100) 25 | (define tail-iters 10) 26 | (define wc-iters 10) 27 | 28 | ; C benchmarks 29 | (define fft-iters 20000) 30 | (define fib-iters 50) 31 | (define fibfp-iters 20) 32 | (define mbrot-iters 1000) 33 | (define nucleic-iters 50) 34 | (define pnpoly-iters 1000000) 35 | (define sum-iters 200000) 36 | (define sumfp-iters 200000) 37 | (define tfib-iters 200) 38 | 39 | ; Other benchmarks 40 | (define conform-iters 400) 41 | (define dynamic-iters 200) 42 | (define earley-iters 2000) 43 | (define fibc-iters 5000) 44 | (define graphs-iters 3000) 45 | (define lattice-iters 10) 46 | (define matrix-iters 4000) 47 | (define maze-iters 40000) 48 | (define mazefun-iters 10000) 49 | (define nqueens-iters 20000) 50 | (define paraffins-iters 10000) 51 | (define peval-iters 2000) 52 | (define pi-iters 20) 53 | (define primes-iters 1000000) 54 | (define ray-iters 50) 55 | (define scheme-iters 200000) 56 | (define simplex-iters 1000000) 57 | (define slatex-iters 200) 58 | (define perm9-iters 100) 59 | (define nboyer-iters 1000) 60 | (define sboyer-iters 1000) 61 | (define gcbench-iters 10) 62 | (define compiler-iters 3000) 63 | (define nbody-iters 10) 64 | (define fftrad4-iters 40) 65 | -------------------------------------------------------------------------------- /tools/benchtimes/suffix/ChezScheme.scm: -------------------------------------------------------------------------------- 1 | (main) 2 | -------------------------------------------------------------------------------- /tools/benchtimes/suffix/Gambit.scm: -------------------------------------------------------------------------------- 1 | (main) 2 | -------------------------------------------------------------------------------- /tools/benchtimes/suffix/GambitBU.scm: -------------------------------------------------------------------------------- 1 | (main) 2 | -------------------------------------------------------------------------------- /tools/benchtimes/suffix/GambitBUf64v.scm: -------------------------------------------------------------------------------- 1 | (main) 2 | -------------------------------------------------------------------------------- /tools/benchtimes/suffix/Gambitf64v.scm: -------------------------------------------------------------------------------- 1 | (main) 2 | -------------------------------------------------------------------------------- /tools/benchtimes/suffix/LC.scm: -------------------------------------------------------------------------------- 1 | (main) 2 | -------------------------------------------------------------------------------- /tools/benchtimes/suffix/LCf64v.scm: -------------------------------------------------------------------------------- 1 | (main) 2 | -------------------------------------------------------------------------------- /tools/benchtimes/suffix/Pycket.scm: -------------------------------------------------------------------------------- 1 | (main) 2 | -------------------------------------------------------------------------------- /tools/graphs/data_def.tar.xz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/tools/graphs/data_def.tar.xz -------------------------------------------------------------------------------- /tools/graphs/data_def/.~lock.res_def_tablesize_formattedbis.csv#: -------------------------------------------------------------------------------- 1 | ,bapt,bapt-laptop,14.05.2017 01:04,file:///home/bapt/.config/libreoffice/4; -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_alltime.csv: -------------------------------------------------------------------------------- 1 | benchmark;m5intra;m5rponly;m5eponly;m5inter;mIinter 2 | ack;0.21791674999999996;0.210416625;0.17374999999999996;0.16666662499999998;0.166666625 3 | all;38.50207975;38.3699965;35.52499675;35.199163000000006;35.252496375 4 | array1;0.3550002499999999;0.353333125;0.32333312499999994;0.323749625;0.32541637500000004 5 | boyer;0.354166625;0.36666624999999997;0.36208324999999997;0.35458325;0.35833299999999996 6 | browse;1.3424998750000001;1.3083333750000001;1.3174998750000002;1.2845831250000002;1.297916375 7 | compiler;2.7320828749999997;2.959166625;3.421666;3.630833125;3.638749625 8 | conform;0.5858335;0.6095831250000001;0.574166875;0.582500125;0.5833330000000001 9 | cpstak;1.8245832499999999;1.8262498749999998;1.66958325;1.68083325;1.6808331250000001 10 | dderiv;2.0291665;1.944583;1.8475;1.9454164999999999;1.9458333749999999 11 | deriv;2.00249975;2.0124999999999997;1.8612497500000003;1.8299997500000003;1.8275000000000001 12 | destruc;0.788749625;0.768333;0.6970829999999999;0.69625;0.69791675 13 | diviter;1.92624975;1.9237496249999997;1.8633333749999998;1.809166625;1.8087499999999999 14 | divrec;2.173749875;2.19333325;1.9012498750000002;2.0366665;2.037083125 15 | earley;0.8370833750000001;0.830832875;1.016666875;0.9829166249999999;0.9824997499999999 16 | fib;0.30999987500000004;0.28625;0.23875;0.22874999999999998;0.22916662499999998 17 | fibfp;0.9370828749999999;0.53874975;0.50666675;0.12916662499999998;0.12916662499999998 18 | graphs;1.133333125;1.1174996250000002;1.1858331250000003;1.1824993750000004;1.1841666249999998 19 | lattice;1.127083125;1.0062496250000001;1.103333375;0.9704166249999999;0.9654165 20 | mazefun;0.7074999999999999;0.714583;0.66666625;0.67833325;0.715833 21 | mbrot;1.0275001249999998;1.009583125;0.233333375;0.218333375;0.21916675 22 | nboyer;0.7341663749999998;0.778749625;0.7654163749999999;0.790833;0.77125 23 | nqueens;0.76541625;0.778749875;0.681250375;0.695833125;0.6779163750000001 24 | paraffins;1.5479162499999999;1.5379167500000002;1.6241664999999998;1.7254163750000002;1.719166375 25 | perm9;0.42624975;0.41125;0.42333325;0.50541675;0.50375 26 | peval;0.9362498750000001;0.9899998750000001;0.9808331249999999;1.0029166250000001;0.9987501250000002 27 | pnpoly;0.722499875;0.723333;0.277500125;0.27333325;0.27208312500000004 28 | primes;1.77;1.7916667499999999;1.68874975;1.683750125;1.683333 29 | sboyer;0.5025000000000001;0.514166625;0.51083325;0.5295834999999999;0.5308331249999999 30 | simplex;0.6116664999999999;0.614999875;0.49541650000000004;0.4924995;0.49458325000000003 31 | sum;0.349166625;0.31250000000000006;0.20666625;0.20583324999999997;0.20624987499999997 32 | sumfp;2.09749975;2.1016667499999997;0.47916675;0.479583375;0.48 33 | sumloop;1.7683333749999997;1.770416625;1.636666875;1.6404166250000003;1.6412498750000002 34 | tak;0.34333299999999994;0.34291687499999995;0.25666674999999994;0.21625;0.21666687499999998 35 | takl;0.39666662499999994;0.39666662499999994;0.38875012500000006;0.3845835;0.383333625 36 | triangl;0.614166625;0.6216665;0.55500025;0.547083375;0.548333375 37 | -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_alltime.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/tools/graphs/data_def/res_def_alltime.pdf -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_codesize.csv: -------------------------------------------------------------------------------- 1 | X;m5intra;m5rponly;m5eponly;m5inter;mIinter 2 | ack;14717.0;14741.0;14085.0;13965.0;13965.0 3 | all;832189.0;878057.0;1067553.0;1095945.0;1102217.0 4 | array1;15717.0;15849.0;14521.0;14477.0;14477.0 5 | boyer;24053.0;25921.0;27825.0;29157.0;29657.0 6 | browse;31089.0;32081.0;36293.0;37769.0;36993.0 7 | compiler;486565.0;509605.0;582185.0;596693.0;597417.0 8 | conform;48925.0;51005.0;48661.0;49761.0;49953.0 9 | cpstak;16189.0;16293.0;17193.0;17237.0;17237.0 10 | dderiv;16649.0;16969.0;16029.0;15997.0;15997.0 11 | deriv;15193.0;15629.0;14513.0;14585.0;14585.0 12 | destruc;19041.0;19237.0;20433.0;19405.0;19405.0 13 | diviter;15461.0;15561.0;15653.0;15397.0;15397.0 14 | divrec;15265.0;15441.0;14837.0;14653.0;14653.0 15 | earley;51517.0;52917.0;91281.0;82513.0;82513.0 16 | fib;14809.0;14769.0;13961.0;13869.0;13869.0 17 | fibfp;15705.0;15285.0;15417.0;14481.0;14481.0 18 | graphs;37857.0;38173.0;54817.0;58397.0;58397.0 19 | lattice;29969.0;30981.0;35605.0;34445.0;34429.0 20 | mazefun;35209.0;37269.0;37565.0;38973.0;44793.0 21 | mbrot;18385.0;18277.0;15805.0;15633.0;15633.0 22 | nboyer;34725.0;38573.0;43009.0;46753.0;47177.0 23 | nqueens;16801.0;16857.0;20457.0;20513.0;18669.0 24 | paraffins;28489.0;31197.0;62225.0;81169.0;81169.0 25 | perm9;23853.0;24093.0;25245.0;22685.0;22685.0 26 | peval;64097.0;70533.0;77405.0;74693.0;74677.0 27 | pnpoly;19805.0;19869.0;17365.0;17373.0;17373.0 28 | primes;15461.0;15769.0;15101.0;14977.0;14977.0 29 | sboyer;34249.0;37809.0;42509.0;46021.0;46445.0 30 | simplex;41781.0;42053.0;35433.0;35373.0;35373.0 31 | sum;14445.0;14549.0;13669.0;13717.0;13717.0 32 | sumfp;14917.0;15081.0;14217.0;14297.0;14297.0 33 | sumloop;14549.0;14649.0;13781.0;13825.0;13825.0 34 | tak;15061.0;15157.0;15209.0;14325.0;14325.0 35 | takl;16749.0;16949.0;19697.0;19361.0;19361.0 36 | triangl;19537.0;19781.0;18669.0;18769.0;18769.0 37 | -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_codesize.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/tools/graphs/data_def/res_def_codesize.pdf -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_ctime.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/tools/graphs/data_def/res_def_ctime.pdf -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_exec.csv: -------------------------------------------------------------------------------- 1 | benchmark;m5intra;m5eponly;m5rponly;m5inter;GambitS;GambitNS 2 | ack;213.5412096977234;168.02704334259033;205.95505833625793;160.0496470928192;228.75;150.0 3 | all;14662.239402532578;12953.447133302689;14550.19760131836;12856.713056564331;17553.375;11467.625 4 | array1;169.60254311561584;136.36645674705505;168.16407442092896;136.62761449813843;188.75;76.5 5 | boyer;220.20921111106873;215.60269594192505;230.4319143295288;206.54630661010742;233.5;158.5 6 | browse;442.2650933265686;437.78786063194275;444.9533522129059;441.6629672050476;906.25;669.0 7 | compiler;481.52607679367065;465.47800302505493;523.2680141925812;495.6679344177246;479.625;350.0 8 | conform;286.0702872276306;246.7535436153412;293.0871844291687;252.16373801231384;283.125;226.875 9 | cpstak;257.20831751823425;194.53412294387817;256.2081515789032;200.3476917743683;279.375;219.25 10 | dderiv;380.3315758705139;343.2484567165375;365.1983141899109;331.407755613327;337.625;292.875 11 | deriv;272.82747626304626;268.3865427970886;273.47081899642944;270.09010314941406;264.5;260.625 12 | destruc;390.35654067993164;331.9139778614044;373.47733974456787;330.64356446266174;361.75;287.5 13 | diviter;310.9332323074341;276.6241729259491;311.54388189315796;279.62157130241394;296.875;277.0 14 | divrec;399.4070291519165;399.6754586696625;408.9559316635132;401.54165029525757;393.0;367.25 15 | earley;322.1486210823059;280.2146077156067;313.74266743659973;283.6568057537079;238.625;166.125 16 | fib;305.856853723526;231.19860887527466;283.12182426452637;222.4447727203369;499.5;188.75 17 | fibfp;238.44051361083984;170.54396867752075;182.4249029159546;119.12104487419128;342.0;144.125 18 | graphs;353.301078081131;295.152485370636;330.08456230163574;274.0480899810791;365.0;271.875 19 | lattice;959.0140879154205;898.7323343753815;823.7399160861969;762.8729343414307;707.875;427.25 20 | mazefun;304.51491475105286;261.2713575363159;312.5001788139343;270.7570195198059;365.625;247.5 21 | mbrot;220.81619501113892;195.38530707359314;212.14136481285095;195.7038938999176;308.25;133.125 22 | nboyer;274.5662033557892;286.33230924606323;281.4352512359619;282.7259600162506;314.625;210.875 23 | nqueens;356.30959272384644;318.1384801864624;360.22916436195374;327.6863992214203;477.125;300.875 24 | paraffins;319.6517527103424;313.53774666786194;316.3484036922455;317.9738223552704;299.875;315.375 25 | perm9;142.19173789024353;123.33160638809204;142.3187553882599;130.9075951576233;120.25;51.125 26 | peval;368.7596321105957;337.4609053134918;389.6619379520416;362.6668453216553;305.125;241.375 27 | pnpoly;363.8254702091217;252.80022621154785;364.30829763412476;247.90185689926147;410.25;63.5 28 | primes;858.660489320755;849.832683801651;877.1836161613464;846.7932641506195;689.0;506.25 29 | sboyer;292.87248849868774;276.4585316181183;298.5319793224335;290.3851568698883;349.0;213.5 30 | simplex;258.0588459968567;201.09716057777405;258.4383189678192;201.65717601776123;348.625;97.5 31 | sum;344.21271085739136;199.57247376441956;308.2093298435211;199.4783878326416;364.625;111.625 32 | sumfp;552.1982610225677;470.69257497787476;553.8005232810974;470.68798542022705;800.75;589.625 33 | sumloop;1763.6674344539642;1630.9007704257965;1764.2010152339935;1631.184607744217;2443.5;970.125 34 | tak;337.09412813186646;246.57344818115234;337.2587263584137;209.10027623176575;362.5;217.25 35 | takl;384.3230605125427;361.6757094860077;383.386492729187;361.0028326511383;308.75;136.625 36 | triangl;602.6561558246613;532.0144593715668;602.1530330181122;536.1460745334625;599.375;312.5 37 | -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_exec1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/tools/graphs/data_def/res_def_exec1.pdf -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_exec2.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/tools/graphs/data_def/res_def_exec2.pdf -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_ntests.csv: -------------------------------------------------------------------------------- 1 | X;m5intra;m5rponly;m5eponly;m5inter;mIinter 2 | ack;167526748.0;111765937.0;55801524.0;92.0;92.0 3 | all;9893285989.0;9468238960.0;6458068853.0;5903887522.0;5833253927.0 4 | array1;90000786.0;90000785.0;374.0;172.0;172.0 5 | boyer;263178681.0;261793452.0;261699130.0;260295580.0;260286880.0 6 | browse;398457387.0;398094233.0;331449361.0;315346180.0;306346180.0 7 | compiler;169861539.0;168549447.0;136441125.0;129276566.0;127065566.0 8 | conform;170287217.0;167158386.0;152712287.0;148398547.0;148398547.0 9 | cpstak;159625818.0;159625817.0;15074.0;15072.0;15072.0 10 | dderiv;223333926.0;207333925.0;190000516.0;174000514.0;174000514.0 11 | deriv;107333904.0;107333903.0;82000494.0;82000492.0;82000492.0 12 | destruc;338486974.0;336989973.0;248319064.0;243692562.0;243692562.0 13 | diviter;301667585.0;301667584.0;301000774.0;301000772.0;301000772.0 14 | divrec;301667585.0;301667584.0;301000774.0;301000772.0;301000772.0 15 | earley;124147084.0;124128483.0;64250874.0;58984672.0;58984672.0 16 | fib;149303659.0;74651908.0;74651829.0;77.0;77.0 17 | fibfp;119442958.0;59721557.0;59721479.0;77.0;77.0 18 | graphs;218484642.0;181462241.0;115264267.0;67915561.0;67915561.0 19 | lattice;700208078.0;542270443.0;683521024.0;507553678.0;507553678.0 20 | mazefun;194086742.0;193936741.0;145257998.0;137680996.0;134075996.0 21 | mbrot;161027718.0;158777717.0;2812774.0;562772.0;562772.0 22 | nboyer;213473868.0;213473067.0;205311541.0;205213333.0;205174733.0 23 | nqueens;273619484.0;258491483.0;182276074.0;201082072.0;159076072.0 24 | paraffins;189626818.0;189625817.0;102471074.0;102433072.0;102433072.0 25 | perm9;57435127.0;57435120.0;30977613.0;30614704.0;30614704.0 26 | peval;160804126.0;160457125.0;131407101.0;128002698.0;128002698.0 27 | pnpoly;320266814.0;320266813.0;188800071.0;188800069.0;188800069.0 28 | primes;182066993.0;182066992.0;133400249.0;128300247.0;128300247.0 29 | sboyer;213473868.0;213473067.0;205311541.0;205213333.0;205174733.0 30 | simplex;219566890.0;219566889.0;138700126.0;138700124.0;138700124.0 31 | sum;133373484.0;133373483.0;20074.0;20072.0;20072.0 32 | sumfp;266733486.0;266733485.0;40075.0;40073.0;40073.0 33 | sumloop;2000000178.0;2000000177.0;1000000084.0;1000000082.0;1000000082.0 34 | tak;286241484.0;286241483.0;77362074.0;6072.0;6072.0 35 | takl;528007321.0;528007320.0;502632423.0;490399621.0;490399621.0 36 | triangl;490471833.0;490464079.0;343621171.0;343613414.0;343613414.0 37 | -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_ntests.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/tools/graphs/data_def/res_def_ntests.pdf -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_ntestsPAPER.csv: -------------------------------------------------------------------------------- 1 | X;m5intra;m5rponly;m5eponly;m5inter;mIinter 2 | ack;167526748.0;111765937.0;55801524.0;8.0;92.0 3 | all;9893285989.0;9468238960.0;6458068853.0;5903887522.0;5833253927.0 4 | array1;90000786.0;90000785.0;374.0;1.0;172.0 5 | boyer;263178681.0;261793452.0;261699130.0;260295580.0;260286880.0 6 | browse;398457387.0;398094233.0;331449361.0;315346180.0;306346180.0 7 | compiler;169861539.0;168549447.0;136441125.0;129276566.0;127065566.0 8 | conform;170287217.0;167158386.0;152712287.0;148398547.0;148398547.0 9 | cpstak;159625818.0;159625817.0;15074.0;1.0;15072.0 10 | dderiv;223333926.0;207333925.0;190000516.0;174000514.0;174000514.0 11 | deriv;107333904.0;107333903.0;82000494.0;82000492.0;82000492.0 12 | destruc;338486974.0;336989973.0;248319064.0;243692562.0;243692562.0 13 | diviter;301667585.0;301667584.0;301000774.0;301000772.0;301000772.0 14 | divrec;301667585.0;301667584.0;301000774.0;301000772.0;301000772.0 15 | earley;124147084.0;124128483.0;64250874.0;58984672.0;58984672.0 16 | fib;149303659.0;74651908.0;74651829.0;77.0;77.0 17 | fibfp;119442958.0;59721557.0;59721479.0;77.0;77.0 18 | graphs;218484642.0;181462241.0;115264267.0;67915561.0;67915561.0 19 | lattice;700208078.0;542270443.0;683521024.0;507553678.0;507553678.0 20 | mazefun;194086742.0;193936741.0;145257998.0;137680996.0;134075996.0 21 | mbrot;161027718.0;158777717.0;2812774.0;2.0;562772.0 22 | nboyer;213473868.0;213473067.0;205311541.0;205213333.0;205174733.0 23 | nqueens;273619484.0;258491483.0;182276074.0;201082072.0;159076072.0 24 | paraffins;189626818.0;189625817.0;102471074.0;102433072.0;102433072.0 25 | perm9;57435127.0;57435120.0;30977613.0;30614704.0;30614704.0 26 | peval;160804126.0;160457125.0;131407101.0;128002698.0;128002698.0 27 | pnpoly;320266814.0;320266813.0;188800071.0;188800069.0;188800069.0 28 | primes;182066993.0;182066992.0;133400249.0;128300247.0;128300247.0 29 | sboyer;213473868.0;213473067.0;205311541.0;205213333.0;205174733.0 30 | simplex;219566890.0;219566889.0;138700126.0;138700124.0;138700124.0 31 | sum;133373484.0;133373483.0;20074.0;1.0;20072.0 32 | sumfp;266733486.0;266733485.0;40075.0;1.0;40073.0 33 | sumloop;2000000178.0;2000000177.0;1000000084.0;1000000082.0;1000000082.0 34 | tak;286241484.0;286241483.0;77362074.0;5.0;6072.0 35 | takl;528007321.0;528007320.0;502632423.0;490399621.0;490399621.0 36 | triangl;490471833.0;490464079.0;343621171.0;343613414.0;343613414.0 37 | -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_tablesize.csv: -------------------------------------------------------------------------------- 1 | X;ccm5inter;ccm5eponly;X;crm5inter;crm5rponly 2 | ack;12.416;13.192;ack;2.56;2.176 3 | all;14097.056;12347.79999;all;618.624;481.27999 4 | array1;14.832;14.00799;array1;2.688;2.30399 5 | boyer;28.55999;26.65599;boyer;12.032;8.32 6 | browse;65.424;57.408;browse;12.928;9.34399 7 | compiler;5097.8;4374.488;compiler;398.07999;323.83999 8 | conform;87.808;79.152;conform;23.16799;23.67999 9 | cpstak;19.48799;19.48799;cpstak;2.30399;1.91999 10 | dderiv;15.40799;16.26399;dderiv;3.712;3.712 11 | deriv;10.976;11.75999;deriv;2.688;2.688 12 | destruc;20.928;22.19999;destruc;3.712;3.45599 13 | diviter;14.4;15.19999;diviter;2.176;2.176 14 | divrec;13.464;14.256;divrec;2.30399;2.30399 15 | earley;155.8;161.68;earley;17.408;10.752 16 | fib;11.64;11.64;fib;2.688;2.43199 17 | fibfp;10.864;10.864;fibfp;2.81599;2.30399 18 | graphs;101.376;89.95999;graphs;13.31199;8.192 19 | lattice;52.56;46.71999;lattice;10.752;8.192 20 | mazefun;59.97599;53.728;mazefun;16.768;16.256 21 | mbrot;17.30399;17.30399;mbrot;2.94399;2.56 22 | nboyer;87.608;76.424;nboyer;18.68799;13.05599 23 | nqueens;30.52799;28.832;nqueens;5.248;2.688 24 | paraffins;72.92799;46.904;paraffins;22.52799;5.63199 25 | perm9;31.23199;27.77599;perm9;5.12;4.73599 26 | peval;76.83199;63.84;peval;31.87199;30.46399 27 | pnpoly;11.08799;11.88;pnpoly;3.83999;3.45599 28 | primes;14.544;13.59999;primes;2.81599;2.81599 29 | sboyer;87.98399;76.75199;sboyer;18.17599;12.416 30 | simplex;38.0;40.0;simplex;5.376;5.376 31 | sum;11.75999;11.75999;sum;2.30399;1.91999 32 | sumfp;11.75999;11.75999;sumfp;2.30399;1.91999 33 | sumloop;12.0;12.0;sumloop;2.30399;1.91999 34 | tak;12.416;13.96799;tak;3.072;2.688 35 | takl;17.42399;16.632;takl;5.376;3.584 36 | triangl;17.6;17.6;triangl;4.096;3.712 37 | -------------------------------------------------------------------------------- /tools/graphs/data_def/res_def_tablesize_formatted.csv: -------------------------------------------------------------------------------- 1 | \begin{figure}[H] 2 | \centering 3 | \begin{tabular}{|l|C{1.9cm}|C{1.9cm}||l|C{1.9cm}|C{1.9cm}|} 4 | \hline 5 | Benchmark & Function & \begin{tabular}{@{}c@{}}Function \\ (E.P only)\end{tabular} & Benchmark & Continuation & \begin{tabular}{@{}c@{}}Continuation \\ (R.P. only)\end{tabular} \\ \hline 6 | all & 14097.06 & 12347.80 & all & 618.62 & 481.28 \\ 7 | compiler & 5097.80 & 4374.49 & compiler & 398.08 & 323.84 \\ 8 | earley & 155.80 & 161.68 & peval & 31.87 & 30.46 \\ 9 | graphs & 101.38 & 89.96 & conform & 23.17 & 23.68 \\ 10 | sboyer & 87.98 & 76.75 & paraffins & 22.53 & 5.63 \\ 11 | conform & 87.81 & 79.15 & nboyer & 18.69 & 13.06 \\ 12 | nboyer & 87.61 & 76.42 & sboyer & 18.18 & 12.42 \\ 13 | peval & 76.83 & 63.84 & earley & 17.41 & 10.75 \\ 14 | paraffins & 72.93 & 46.90 & mazefun & 16.77 & 16.26 \\ 15 | browse & 65.42 & 57.41 & graphs & 13.31 & 8.19 \\ 16 | mazefun & 59.98 & 53.73 & browse & 12.93 & 9.34 \\ 17 | lattice & 52.56 & 46.72 & boyer & 12.03 & 8.32 \\ 18 | simplex & 38.00 & 40.00 & lattice & 10.75 & 8.19 \\ 19 | perm9 & 31.23 & 27.78 & simplex & 5.38 & 5.38 \\ 20 | nqueens & 30.53 & 28.83 & takl & 5.38 & 3.58 \\ 21 | boyer & 28.56 & 26.66 & nqueens & 5.25 & 2.69 \\ 22 | destruc & 20.93 & 22.20 & perm9 & 5.12 & 4.74 \\ 23 | \textit{others} & < 20.00 & < 20.00 & \textit{others} & < 4.50 & < 4.50 \\ 24 | \hline 25 | \end{tabular} 26 | \caption{TODO: move to xp section} 27 | \label{fig:00} 28 | \end{figure} 29 | -------------------------------------------------------------------------------- /tools/graphs/debugntests.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/tools/graphs/debugntests.pdf -------------------------------------------------------------------------------- /tools/graphs/get_ctime.py: -------------------------------------------------------------------------------- 1 | 2 | # example: 3 | #python get_time.py 4 /home/bapt/Bureau/lc-ECOOP/tools/benchtimes/result/LC/ /home/bapt/Bureau/lc-ECOOP/lazy-comp "test;--max-versions 5;--ctime" "other;--max-versions 5;--disable-entry-points;--ctime" 4 | 5 | 6 | import re 7 | import os 8 | import sys 9 | import glob 10 | import subprocess 11 | 12 | # COMPILATION TIME 13 | def get(result): 14 | m = re.findall('Compilation time \(user time\):(.+)\n', result) 15 | assert len(m) == 1, 'Invalid regexp' 16 | result = float(m[0]) 17 | return result 18 | 19 | # Check cmd line args 20 | if len(sys.argv) < 5: 21 | print("Invalid arguments") 22 | print("Usage:") 23 | print(' python thisscript.py nb_iters bench_path lc_path [execs]') 24 | print('Each exec has the form:') 25 | print('exec_name;arg1;arg2;...;argn') 26 | sys.exit(0) 27 | 28 | NITERS = int(sys.argv[1]) 29 | BENCH_PATH = os.path.abspath(sys.argv[2]) + '/' # Benchmarks path (contains .scm files) 30 | LC_PATH = os.path.abspath(sys.argv[3]) # LC path executable path 31 | EXECS = [] 32 | 33 | for i in range(4,len(sys.argv)): 34 | els = sys.argv[i].split(';') 35 | name = els[0] 36 | args = els[1:] 37 | EXECS.append([name,args]) 38 | 39 | if NITERS < 3: 40 | print('ERROR: niters is too small') 41 | sys.exit(0) 42 | 43 | benchmarks = sorted(glob.glob(BENCH_PATH + '*.scm')) 44 | 45 | def run_and_get(cmd): 46 | result = subprocess.run(cmd,stdout=subprocess.PIPE) 47 | strresult = result.stdout.decode("utf-8") 48 | return get(strresult) 49 | 50 | RESULT = [] 51 | 52 | # For each benchmark 53 | bench_i=1 54 | for benchmark in benchmarks: 55 | 56 | bench_name = os.path.basename(benchmark).replace('.scm','') 57 | bench_res = [bench_name] 58 | 59 | # Handle cpt 60 | bench_istr = str(bench_i) if bench_i >=10 else '0' + str(bench_i) 61 | print('(' + str(bench_istr) + '/' + str(len(benchmarks)) + ') Running benchmark ' + bench_name + '...') 62 | 63 | # For each exec 64 | for exec in EXECS: 65 | 66 | print(' exec ' + exec[0], end='') 67 | sys.stdout.flush() 68 | ex_args = exec[1] 69 | ex_cmd = [LC_PATH,benchmark] + exec[1] 70 | ex_res = [] 71 | 72 | for i in range(0,NITERS): 73 | print('.',end='') 74 | sys.stdout.flush() 75 | ex_res += [run_and_get(ex_cmd)] 76 | print('') 77 | 78 | ex_res.remove(max(ex_res)) 79 | ex_res.remove(min(ex_res)) 80 | mean = sum(ex_res) / float(len(ex_res)) 81 | 82 | bench_res += [mean] 83 | 84 | print('') 85 | bench_i += 1 86 | 87 | # Update global result 88 | RESULT.append(bench_res) 89 | 90 | # Pretty print csv 91 | names = list(map(lambda x:str(x[0]),EXECS)) 92 | print('benchmark;'+';'.join(names)) 93 | for res in RESULT: 94 | strs = list(map(lambda x:str(x),res)) 95 | print(';'.join(strs)) 96 | -------------------------------------------------------------------------------- /tools/graphs/get_etime.py: -------------------------------------------------------------------------------- 1 | 2 | # example: 3 | #python get_time.py 4 /path/to/benchs /path/to/lc "test;--max-versions 5;..." "other;--max-versions 10;..." 4 | 5 | import re 6 | import os 7 | import sys 8 | import glob 9 | import subprocess 10 | 11 | # EXEC TIME 12 | def get(result): 13 | m = re.findall('CPU time: ([0-9]*.[0-9]*\n)',result) 14 | assert len(m) == 2, 'Invalid regexp' 15 | result = float(m[1]) 16 | return result 17 | 18 | # Check cmd line args 19 | if len(sys.argv) < 5: 20 | print("Invalid arguments") 21 | print("Usage:") 22 | print(' python thisscript.py nb_iters bench_path lc_path [execs]') 23 | print('Each exec has the form:') 24 | print('exec_name;arg1;arg2;...;argn') 25 | sys.exit(0) 26 | 27 | NITERS = int(sys.argv[1]) 28 | BENCH_PATH = os.path.abspath(sys.argv[2]) + '/' # Benchmarks path (contains .scm files) 29 | LC_PATH = os.path.abspath(sys.argv[3]) # LC path executable path 30 | BASE_CMD = ["--time"] 31 | EXECS = [] 32 | 33 | for i in range(4,len(sys.argv)): 34 | els = sys.argv[i].split(';') 35 | name = els[0] 36 | args = els[1:] + BASE_CMD 37 | EXECS.append([name,args]) 38 | 39 | if NITERS < 3: 40 | print('ERROR: niters is too small') 41 | sys.exit(0) 42 | 43 | benchmarks = sorted(glob.glob(BENCH_PATH + '*.scm')) 44 | 45 | def run_and_get(cmd): 46 | result = subprocess.run(cmd,stdout=subprocess.PIPE) 47 | strresult = result.stdout.decode("utf-8") 48 | return get(strresult) 49 | 50 | RESULT = [] 51 | 52 | # For each benchmark 53 | bench_i=1 54 | for benchmark in benchmarks: 55 | 56 | bench_name = os.path.basename(benchmark).replace('.scm','') 57 | bench_res = [bench_name] 58 | 59 | # Handle cpt 60 | bench_istr = str(bench_i) if bench_i >=10 else '0' + str(bench_i) 61 | print('(' + str(bench_istr) + '/' + str(len(benchmarks)) + ') Running benchmark ' + bench_name + '...') 62 | 63 | # For each exec 64 | for exec in EXECS: 65 | 66 | print(' exec ' + exec[0], end='') 67 | sys.stdout.flush() 68 | ex_args = exec[1] 69 | ex_cmd = [LC_PATH,benchmark] + exec[1] 70 | ex_res = [] 71 | 72 | for i in range(0,NITERS): 73 | print('.',end='') 74 | sys.stdout.flush() 75 | ex_res += [run_and_get(ex_cmd)] 76 | print('') 77 | 78 | ex_res.remove(max(ex_res)) 79 | ex_res.remove(min(ex_res)) 80 | mean = sum(ex_res) / float(len(ex_res)) 81 | 82 | bench_res += [mean] 83 | 84 | print('') 85 | bench_i += 1 86 | 87 | # Update global result 88 | RESULT.append(bench_res) 89 | 90 | # Pretty print csv 91 | names = list(map(lambda x:str(x[0]),EXECS)) 92 | print('benchmark;'+';'.join(names)) 93 | for res in RESULT: 94 | strs = list(map(lambda x:str(x),res)) 95 | print(';'.join(strs)) 96 | -------------------------------------------------------------------------------- /tools/graphs/get_ttime.py: -------------------------------------------------------------------------------- 1 | 2 | # example: 3 | #python get_time.py 4 /home/bapt/Bureau/lc-ECOOP/tools/benchtimes/result/LC/ /home/bapt/Bureau/lc-ECOOP/lazy-comp "test;--max-versions 5;--ctime" "other;--max-versions 5;--disable-entry-points;--ctime" 4 | 5 | 6 | import re 7 | import os 8 | import sys 9 | import glob 10 | import subprocess 11 | 12 | # TOTAL TIME 13 | def get(result): 14 | m = re.findall('CPU time: ([0-9]*.[0-9]*\n)',result) 15 | assert len(m) == 1, 'Invalid regexp' 16 | result = float(m[0]) 17 | return result 18 | 19 | # Check cmd line args 20 | if len(sys.argv) < 5: 21 | print("Invalid arguments") 22 | print("Usage:") 23 | print(' python thisscript.py nb_iters bench_path lc_path [execs]') 24 | print('Each exec has the form:') 25 | print('exec_name;arg1;arg2;...;argn') 26 | sys.exit(0) 27 | 28 | NITERS = int(sys.argv[1]) 29 | BENCH_PATH = os.path.abspath(sys.argv[2]) + '/' # Benchmarks path (contains .scm files) 30 | LC_PATH = os.path.abspath(sys.argv[3]) # LC path executable path 31 | EXECS = [] 32 | 33 | for i in range(4,len(sys.argv)): 34 | els = sys.argv[i].split(';') 35 | name = els[0] 36 | args = els[1:] 37 | EXECS.append([name,args]) 38 | 39 | if NITERS < 3: 40 | print('ERROR: niters is too small') 41 | sys.exit(0) 42 | 43 | benchmarks = sorted(glob.glob(BENCH_PATH + '*.scm')) 44 | 45 | def run_and_get(cmd): 46 | result = subprocess.run(cmd,stdout=subprocess.PIPE) 47 | strresult = result.stdout.decode("utf-8") 48 | return get(strresult) 49 | 50 | RESULT = [] 51 | 52 | # For each benchmark 53 | bench_i=1 54 | for benchmark in benchmarks: 55 | 56 | bench_name = os.path.basename(benchmark).replace('.scm','') 57 | bench_res = [bench_name] 58 | 59 | # Handle cpt 60 | bench_istr = str(bench_i) if bench_i >=10 else '0' + str(bench_i) 61 | print('(' + str(bench_istr) + '/' + str(len(benchmarks)) + ') Running benchmark ' + bench_name + '...') 62 | 63 | # For each exec 64 | for exec in EXECS: 65 | 66 | print(' exec ' + exec[0], end='') 67 | sys.stdout.flush() 68 | ex_args = exec[1] 69 | ex_cmd = [LC_PATH,benchmark] + exec[1] 70 | ex_res = [] 71 | 72 | for i in range(0,NITERS): 73 | print('.',end='') 74 | sys.stdout.flush() 75 | ex_res += [run_and_get(ex_cmd)] 76 | print('') 77 | 78 | ex_res.remove(max(ex_res)) 79 | ex_res.remove(min(ex_res)) 80 | mean = sum(ex_res) / float(len(ex_res)) 81 | 82 | bench_res += [mean] 83 | 84 | print('') 85 | bench_i += 1 86 | 87 | # Update global result 88 | RESULT.append(bench_res) 89 | 90 | # Pretty print csv 91 | names = list(map(lambda x:str(x[0]),EXECS)) 92 | print('benchmark;'+';'.join(names)) 93 | for res in RESULT: 94 | strs = list(map(lambda x:str(x),res)) 95 | print(';'.join(strs)) 96 | -------------------------------------------------------------------------------- /tools/graphs/graph.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bsaleil/lc/ee7867fd2bdbbe88924300e10b14ea717ee6434b/tools/graphs/graph.pdf -------------------------------------------------------------------------------- /tools/graphs/lckey_to_csv.py: -------------------------------------------------------------------------------- 1 | import os 2 | import sys 3 | import glob 4 | import subprocess 5 | 6 | # Parse execs from command line arguments 7 | def parse_execs(): 8 | exs = [] 9 | i=4 10 | while iinteger p))) 5 | 6 | (try t1) 7 | (try t2) 8 | 9 | ;120 10 | ;121 11 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-chareq.scm: -------------------------------------------------------------------------------- 1 | (define a #\a) 2 | (define b #\b) 3 | 4 | (define (try p1 p2) (println (char=? p1 p2))) 5 | 6 | (try a a) 7 | (try a b) 8 | (try b a) 9 | 10 | ;#t 11 | ;#f 12 | ;#f 13 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-charlt.scm: -------------------------------------------------------------------------------- 1 | (define a #\a) 2 | (define b #\b) 3 | 4 | (define (try p1 p2) (println (charchar p1) p2))) 5 | 6 | (try t1 #\@) 7 | (try t2 #\!) 8 | (try t2 #\x) 9 | 10 | ;#t 11 | ;#t 12 | ;#f 13 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-length.scm: -------------------------------------------------------------------------------- 1 | (define t1 '(11 22 33)) 2 | (define t2 '()) 3 | 4 | (define (try p) (println (length p))) 5 | 6 | (try t1) 7 | (try t2) 8 | 9 | ;3 10 | ;0 11 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-let.scm: -------------------------------------------------------------------------------- 1 | (define (f x) 2 | (let ((y (* x x))) 3 | (+ x y))) 4 | 5 | (println (f 1)) 6 | (println (f 2)) 7 | (println (f 3)) 8 | (println (f 4)) 9 | 10 | ;2 11 | ;6 12 | ;12 13 | ;20 14 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-letrec.scm: -------------------------------------------------------------------------------- 1 | (define (f x) 2 | (letrec ((fact (lambda (n) 3 | (if (= n 0) 4 | 1 5 | (* n (fact (- n 1))))))) 6 | (fact x))) 7 | 8 | (println (f 1)) 9 | (println (f 2)) 10 | (println (f 3)) 11 | (println (f 4)) 12 | 13 | ;1 14 | ;2 15 | ;6 16 | ;24 17 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-make-string.scm: -------------------------------------------------------------------------------- 1 | (println (string? (make-string 0))) 2 | (println (string-length (make-string 0))) 3 | (println (string? (make-string 5))) 4 | (println (string-length (make-string 5))) 5 | 6 | ;#t 7 | ;0 8 | ;#t 9 | ;5 10 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-map.scm: -------------------------------------------------------------------------------- 1 | (define a '((1 . 11) (2 . 22) (3 . 33))) 2 | 3 | (println (length (map cdr a))) 4 | (println (car (map cdr a))) 5 | 6 | ;3 7 | ;11 8 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-member.scm: -------------------------------------------------------------------------------- 1 | (define a '((1 . 11) (2 . 22) (3 . 33))) 2 | 3 | (println (member 99 a)) 4 | (println (length (member (cons 2 22) a))) 5 | 6 | ;#f 7 | ;2 8 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-not.scm: -------------------------------------------------------------------------------- 1 | (define t1 42) 2 | (define t2 #f) 3 | (define t3 #\x) 4 | (define t4 "abc") 5 | (define t5 '(1 2 3)) 6 | (define t6 '()) 7 | (define t7 cons) 8 | 9 | (define (try p) (println (not p))) 10 | 11 | (try t1) 12 | (try t2) 13 | (try t3) 14 | (try t4) 15 | (try t5) 16 | (try t6) 17 | (try t7) 18 | 19 | ;#f 20 | ;#t 21 | ;#f 22 | ;#f 23 | ;#f 24 | ;#f 25 | ;#f 26 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-nqueens.scm: -------------------------------------------------------------------------------- 1 | (define (iota i lst) 2 | (if (= i 0) 3 | lst 4 | (iota (- i 1) (cons i lst)))) 5 | 6 | (define (try x y z) 7 | (if (null? x) 8 | (if (null? y) 9 | 1 10 | 0) 11 | (+ (if (ok? (car x) 1 z) 12 | (try (append (cdr x) y) '() (cons (car x) z)) 13 | 0) 14 | (try (cdr x) (cons (car x) y) z)))) 15 | 16 | (define (ok? row dist placed) 17 | (if (null? placed) 18 | #t 19 | (and (not (= (car placed) (+ row dist))) 20 | (not (= (car placed) (- row dist))) 21 | (ok? row (+ dist 1) (cdr placed))))) 22 | 23 | (define (nqueens n) 24 | (try (iota n '()) '() '())) 25 | 26 | (println (nqueens 8)) 27 | 28 | ;92 29 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-nullp.scm: -------------------------------------------------------------------------------- 1 | (define t1 42) 2 | (define t2 #f) 3 | (define t3 #\x) 4 | (define t4 "abc") 5 | (define t5 '(1 2 3)) 6 | (define t6 '()) 7 | (define t7 cons) 8 | 9 | (define (try p) (println (null? p))) 10 | 11 | (try t1) 12 | (try t2) 13 | (try t3) 14 | (try t4) 15 | (try t5) 16 | (try t6) 17 | (try t7) 18 | 19 | ;#f 20 | ;#f 21 | ;#f 22 | ;#f 23 | ;#f 24 | ;#t 25 | ;#f 26 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-numberp.scm: -------------------------------------------------------------------------------- 1 | (define t1 42) 2 | (define t2 #f) 3 | (define t3 #\x) 4 | (define t4 "abc") 5 | (define t5 '(1 2 3)) 6 | (define t6 '()) 7 | (define t7 cons) 8 | 9 | (define (try p) (println (number? p))) 10 | 11 | (try t1) 12 | (try t2) 13 | (try t3) 14 | (try t4) 15 | (try t5) 16 | (try t6) 17 | (try t7) 18 | 19 | ;#t 20 | ;#f 21 | ;#f 22 | ;#f 23 | ;#f 24 | ;#f 25 | ;#f 26 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-pairp.scm: -------------------------------------------------------------------------------- 1 | (define t1 42) 2 | (define t2 #f) 3 | (define t3 #\x) 4 | (define t4 "abc") 5 | (define t5 '(1 2 3)) 6 | (define t6 '()) 7 | (define t7 cons) 8 | 9 | (define (try p) (println (pair? p))) 10 | 11 | (try t1) 12 | (try t2) 13 | (try t3) 14 | (try t4) 15 | (try t5) 16 | (try t6) 17 | (try t7) 18 | 19 | ;#f 20 | ;#f 21 | ;#f 22 | ;#f 23 | ;#t 24 | ;#f 25 | ;#f 26 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-procedurep.scm: -------------------------------------------------------------------------------- 1 | (define t1 42) 2 | (define t2 #f) 3 | (define t3 #\x) 4 | (define t4 "abc") 5 | (define t5 '(1 2 3)) 6 | (define t6 '()) 7 | (define t7 cons) 8 | 9 | (define (try p) (println (procedure? p))) 10 | 11 | (try t1) 12 | (try t2) 13 | (try t3) 14 | (try t4) 15 | (try t5) 16 | (try t6) 17 | (try t7) 18 | 19 | ;#f 20 | ;#f 21 | ;#f 22 | ;#f 23 | ;#f 24 | ;#f 25 | ;#t 26 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-reverse.scm: -------------------------------------------------------------------------------- 1 | (define t1 '(11 22 33)) 2 | 3 | (define (try p) (println (car (reverse p)))) 4 | 5 | (try t1) 6 | 7 | ;33 8 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-set-car.scm: -------------------------------------------------------------------------------- 1 | (define a (cons 11 22)) 2 | 3 | (set-car! a 33) 4 | 5 | (println (car a)) 6 | (println (cdr a)) 7 | 8 | ;33 9 | ;22 10 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-set-cdr.scm: -------------------------------------------------------------------------------- 1 | (define a (cons 11 22)) 2 | 3 | (set-cdr! a 33) 4 | 5 | (println (car a)) 6 | (println (cdr a)) 7 | 8 | ;11 9 | ;33 10 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-string-length.scm: -------------------------------------------------------------------------------- 1 | (define a "abcde") 2 | 3 | (println (string-length a)) 4 | 5 | ;5 6 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-string-ref.scm: -------------------------------------------------------------------------------- 1 | (define a "abcde") 2 | 3 | (println (char->integer (string-ref a 0))) 4 | (println (char->integer (string-ref a 1))) 5 | 6 | ;97 7 | ;98 8 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-string-set.scm: -------------------------------------------------------------------------------- 1 | (define a (make-string 5)) 2 | 3 | (string-set! a 0 #\b) 4 | (string-set! a 1 #\a) 5 | 6 | (println (char->integer (string-ref a 0))) 7 | (println (char->integer (string-ref a 1))) 8 | 9 | ;98 10 | ;97 11 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-stringeq.scm: -------------------------------------------------------------------------------- 1 | (define a "a") 2 | (define b "b") 3 | (define c "ab") 4 | 5 | (define (try p1 p2) (println (string=? p1 p2))) 6 | 7 | (try a a) 8 | (try a b) 9 | (try a c) 10 | 11 | (try b a) 12 | (try b b) 13 | (try b c) 14 | 15 | (try c a) 16 | (try c b) 17 | (try c c) 18 | 19 | ;#t 20 | ;#f 21 | ;#f 22 | ;#f 23 | ;#t 24 | ;#f 25 | ;#f 26 | ;#f 27 | ;#t 28 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/2/etape2-stringlt.scm: -------------------------------------------------------------------------------- 1 | (define a "a") 2 | (define b "b") 3 | (define c "ab") 4 | 5 | (define (try p1 p2) (println (stringlist *sequence*)) *answer*)) 39 | (set! *answer* (cons 999 *answer*)) 40 | #t) 41 | ((and (= 1 (vector-ref *board* (vector-ref *a* i))) 42 | (= 1 (vector-ref *board* (vector-ref *b* i))) 43 | (= 0 (vector-ref *board* (vector-ref *c* i)))) 44 | (vector-set! *board* (vector-ref *a* i) 0) 45 | (vector-set! *board* (vector-ref *b* i) 0) 46 | (vector-set! *board* (vector-ref *c* i) 1) 47 | (vector-set! *sequence* depth i) 48 | (search 0 (+ depth 1)) 49 | (vector-set! *board* (vector-ref *a* i) 1) 50 | (vector-set! *board* (vector-ref *b* i) 1) 51 | (vector-set! *board* (vector-ref *c* i) 0) #f) 52 | (else 53 | #f))) 54 | 55 | (define (search j depth) 56 | (if (or (= j 36) (attempt j depth)) 57 | #f 58 | (search (+ j 1) depth))) 59 | 60 | (define (test i depth) 61 | (set! *answer* '()) 62 | (attempt i depth) 63 | *answer*) 64 | 65 | (println (length (test 22 1))) 66 | 67 | ;775 68 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/3/etape3-vector-length.scm: -------------------------------------------------------------------------------- 1 | (define a '#(11 22 33 44 55)) 2 | 3 | (println (vector-length a)) 4 | 5 | ;5 6 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/3/etape3-vector-ref.scm: -------------------------------------------------------------------------------- 1 | (define a '#(11 22 33 44 55)) 2 | 3 | (println (vector-ref a 0)) 4 | (println (vector-ref a 1)) 5 | 6 | ;11 7 | ;22 8 | -------------------------------------------------------------------------------- /unit-tests/IFT3065/3/etape3-vector-set.scm: -------------------------------------------------------------------------------- 1 | (define a (make-vector 5)) 2 | 3 | (vector-set! a 0 11) 4 | (vector-set! a 1 22) 5 | 6 | (println (vector-ref a 0)) 7 | (println (vector-ref a 1)) 8 | 9 | ;11 10 | ;22 11 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/ack.scm: -------------------------------------------------------------------------------- 1 | ;;; ACK -- One of the Kernighan and Van Wyk benchmarks. 2 | 3 | (define (ack m n) 4 | (cond ((= m 0) (+ n 1)) 5 | ((= n 0) (ack (- m 1) 1)) 6 | (else (ack (- m 1) (ack m (- n 1)))))) 7 | 8 | (println (ack 0 0)) 9 | (println (ack 1 2)) 10 | (println (ack 3 4)) 11 | (println (ack 4 0)) 12 | (println (ack 3 9)) 13 | 14 | ;1 15 | ;4 16 | ;125 17 | ;13 18 | ;4093 19 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/array1.scm: -------------------------------------------------------------------------------- 1 | ;;; ARRAY1 -- One of the Kernighan and Van Wyk benchmarks. 2 | 3 | (define (create-x n) 4 | (define result (make-vector n)) 5 | (do ((i 0 (+ i 1))) 6 | ((>= i n) result) 7 | (vector-set! result i i))) 8 | 9 | (define (create-y x) 10 | (let* ((n (vector-length x)) 11 | (result (make-vector n))) 12 | (do ((i (- n 1) (- i 1))) 13 | ((< i 0) result) 14 | (vector-set! result i (vector-ref x i))))) 15 | 16 | (define (my-try n) 17 | (vector-length (create-y (create-x n)))) 18 | 19 | (define (go n) 20 | (let loop ((repeat 100) 21 | (result '())) 22 | (if (> repeat 0) 23 | (loop (- repeat 1) (my-try n)) 24 | result))) 25 | 26 | (println (go 5)) 27 | 28 | ;5 29 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/cat.scm: -------------------------------------------------------------------------------- 1 | ;;; CAT -- One of the Kernighan and Van Wyk benchmarks. 2 | 3 | (define inport #f) 4 | (define outport #f) 5 | 6 | (define (catport port) 7 | (let ((x (read-char port))) 8 | (if (eof-object? x) 9 | (close-output-port outport) 10 | (begin 11 | (write-char x outport) 12 | (catport port))))) 13 | 14 | (define (go) 15 | (set! inport (open-input-file "./unit-tests/benchmarks/bib")) 16 | (set! outport (open-output-file "./unit-tests/benchmarks/foo")) 17 | (catport inport) 18 | (close-input-port inport)) 19 | 20 | (go) 21 | (println "END") 22 | 23 | ;END 24 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/cpstak.scm: -------------------------------------------------------------------------------- 1 | ;;; CPSTAK -- A continuation-passing version of the TAK benchmark. 2 | ;;; A good test of first class procedures and tail recursion. 3 | 4 | (define (cpstak x y z) 5 | 6 | (define (tak x y z k) 7 | (if (not (< y x)) 8 | (k z) 9 | (tak (- x 1) 10 | y 11 | z 12 | (lambda (v1) 13 | (tak (- y 1) 14 | z 15 | x 16 | (lambda (v2) 17 | (tak (- z 1) 18 | x 19 | y 20 | (lambda (v3) 21 | (tak v1 v2 v3 k))))))))) 22 | 23 | (tak x y z (lambda (a) a))) 24 | 25 | (pp (cpstak 9 6 3)) 26 | 27 | ;6 28 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/dderiv.scm: -------------------------------------------------------------------------------- 1 | ;; DDERIV -- Table-driven symbolic derivation. 2 | 3 | ;;; Returns the wrong answer for quotients. 4 | ;;; Fortunately these aren't used in the benchmark. 5 | 6 | (define (lookup key table) 7 | (let loop ((x table)) 8 | (if (null? x) 9 | #f 10 | (let ((pair (car x))) 11 | (if (eq? (car pair) key) 12 | pair 13 | (loop (cdr x))))))) 14 | 15 | (define properties '()) 16 | 17 | (define (get key1 key2) 18 | (let ((x (lookup key1 properties))) 19 | (if x 20 | (let ((y (lookup key2 (cdr x)))) 21 | (if y 22 | (cdr y) 23 | #f)) 24 | #f))) 25 | 26 | (define (put key1 key2 val) 27 | (let ((x (lookup key1 properties))) 28 | (if x 29 | (let ((y (lookup key2 (cdr x)))) 30 | (if y 31 | (set-cdr! y val) 32 | (set-cdr! x (cons (cons key2 val) (cdr x))))) 33 | (set! properties 34 | (cons (list key1 (cons key2 val)) properties))))) 35 | 36 | (define (my+dderiv a) 37 | (cons '+ 38 | (map dderiv (cdr a)))) 39 | 40 | (define (my-dderiv a) 41 | (cons '- 42 | (map dderiv (cdr a)))) 43 | 44 | (define (*dderiv a) 45 | (list '* 46 | a 47 | (cons '+ 48 | (map (lambda (a) (list '/ (dderiv a) a)) (cdr a))))) 49 | 50 | (define (/dderiv a) 51 | (list '- 52 | (list '/ 53 | (dderiv (cadr a)) 54 | (caddr a)) 55 | (list '/ 56 | (cadr a) 57 | (list '* 58 | (caddr a) 59 | (caddr a) 60 | (dderiv (caddr a)))))) 61 | 62 | (put '+ 'dderiv my+dderiv) 63 | (put '- 'dderiv my-dderiv) 64 | (put '* 'dderiv *dderiv) 65 | (put '/ 'dderiv /dderiv) 66 | 67 | (define (dderiv a) 68 | (if (not (pair? a)) 69 | (if (eq? a 'x) 1 0) 70 | (let ((f (get (car a) 'dderiv))) 71 | (if f 72 | (f a) 73 | (fatal-error "No derivation method available"))))) 74 | 75 | (println (dderiv '(+ (* 3 x x) (* a x x) (* b x) 5))) 76 | 77 | ;+**3xx+/03/1x/1x**axx+/0a/1x/1x**bx+/0b/1x0 78 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/deriv.scm: -------------------------------------------------------------------------------- 1 | ;;; DERIV -- Symbolic derivation. 2 | 3 | ;;; Returns the wrong answer for quotients. 4 | ;;; Fortunately these aren't used in the benchmark. 5 | 6 | (define (deriv a) 7 | (cond ((not (pair? a)) 8 | (if (eq? a 'x) 1 0)) 9 | ((eq? (car a) '+) 10 | (cons '+ 11 | (map deriv (cdr a)))) 12 | ((eq? (car a) '-) 13 | (cons '- 14 | (map deriv (cdr a)))) 15 | ((eq? (car a) '*) 16 | (list '* 17 | a 18 | (cons '+ 19 | (map (lambda (a) (list '/ (deriv a) a)) (cdr a))))) 20 | ((eq? (car a) '/) 21 | (list '- 22 | (list '/ 23 | (deriv (cadr a)) 24 | (caddr a)) 25 | (list '/ 26 | (cadr a) 27 | (list '* 28 | (caddr a) 29 | (caddr a) 30 | (deriv (caddr a)))))) 31 | (else 32 | (fatal-error "No derivation method available")))) 33 | 34 | (println (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))) 35 | 36 | ;+**3xx+/03/1x/1x**axx+/0a/1x/1x**bx+/0b/1x0 37 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/destruc.scm: -------------------------------------------------------------------------------- 1 | ;;; DESTRUC -- Destructive operation benchmark. 2 | 3 | (define (append-to-tail! x y) 4 | (if (null? x) 5 | y 6 | (let loop ((a x) (b (cdr x))) 7 | (if (null? b) 8 | (begin 9 | (set-cdr! a y) 10 | x) 11 | (loop b (cdr b)))))) 12 | 13 | (define (destructive n m) 14 | (let ((l (do ((i 10 (- i 1)) (a '() (cons '() a))) 15 | ((= i 0) a)))) 16 | (do ((i n (- i 1))) 17 | ((= i 0) l) 18 | (cond ((null? (car l)) 19 | (do ((l l (cdr l))) 20 | ((null? l)) 21 | (if (null? (car l)) (set-car! l (cons '() '()))) 22 | (append-to-tail! (car l) 23 | (do ((j m (- j 1)) (a '() (cons '() a))) 24 | ((= j 0) a))))) 25 | (else 26 | (do ((l1 l (cdr l1)) (l2 (cdr l) (cdr l2))) 27 | ((null? l2)) 28 | (set-cdr! (do ((j (quotient (length (car l2)) 2) (- j 1)) 29 | (a (car l2) (cdr a))) 30 | ((zero? j) a) 31 | (set-car! a i)) 32 | (let ((n (quotient (length (car l1)) 2))) 33 | (cond ((= n 0) 34 | (set-car! l1 '()) 35 | (car l1)) 36 | (else 37 | (do ((j n (- j 1)) (a (car l1) (cdr a))) 38 | ((= j 1) 39 | (let ((x (cdr a))) 40 | (set-cdr! a '()) 41 | x)) 42 | (set-car! a i)))))))))))) 43 | 44 | ;----- 45 | 46 | (let ((r (destructive 600 50))) 47 | (println (length r)) 48 | (println r)) 49 | 50 | ;10 51 | ;112111111211111111211112111121111211112111111111111111222223 52 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/diviter.scm: -------------------------------------------------------------------------------- 1 | ;;; DIVITER -- Benchmark which divides by 2 using lists of n ()'s. 2 | 3 | ;;; LC NOTE : Can't compute more because of heap/stack overflow 4 | 5 | (define (create-n n) 6 | (do ((n n (- n 1)) 7 | (a '() (cons '() a))) 8 | ((= n 0) a))) 9 | 10 | (define *ll* (create-n 200)) 11 | 12 | (define (iterative-div2 l) 13 | (do ((l l (cddr l)) 14 | (a '() (cons (car l) a))) 15 | ((null? l) a))) 16 | 17 | (pp (length (iterative-div2 (create-n 0)))) 18 | (pp (length (iterative-div2 (create-n 2)))) 19 | (pp (length (iterative-div2 (create-n 20)))) 20 | (pp (length (iterative-div2 (create-n 40)))) 21 | (pp (length (iterative-div2 (create-n 100)))) 22 | 23 | (pp (iterative-div2 (create-n 0))) 24 | (pp (iterative-div2 (create-n 10))) 25 | 26 | ;0 27 | ;1 28 | ;10 29 | ;20 30 | ;50 31 | ;() 32 | ;(() () () () ()) 33 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/divrec.scm: -------------------------------------------------------------------------------- 1 | ;;; DIVREC -- Benchmark which divides by 2 using lists of n ()'s. 2 | 3 | ;;; LC NOTE : Can't compute more because of heap/stack overflow 4 | 5 | (define (create-n n) 6 | (do ((n n (- n 1)) 7 | (a '() (cons '() a))) 8 | ((= n 0) a))) 9 | 10 | (define *ll* (create-n 200)) 11 | 12 | (define (recursive-div2 l) 13 | (cond ((null? l) '()) 14 | (else (cons (car l) (recursive-div2 (cddr l)))))) 15 | 16 | (pp (length (recursive-div2 (create-n 0)))) 17 | (pp (length (recursive-div2 (create-n 2)))) 18 | (pp (length (recursive-div2 (create-n 20)))) 19 | (pp (length (recursive-div2 (create-n 40)))) 20 | (pp (length (recursive-div2 (create-n 100)))) 21 | (pp (length (recursive-div2 (create-n 1000)))) 22 | 23 | (pp (recursive-div2 (create-n 0))) 24 | (pp (recursive-div2 (create-n 10))) 25 | 26 | ;0 27 | ;1 28 | ;10 29 | ;20 30 | ;50 31 | ;500 32 | ;() 33 | ;(() () () () ()) 34 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/fib.scm: -------------------------------------------------------------------------------- 1 | ;;; FIB -- A classic benchmark 2 | 3 | (define (fib n) 4 | (if (< n 2) 5 | n 6 | (+ (fib (- n 1)) 7 | (fib (- n 2))))) 8 | 9 | (pp (fib 0)) 10 | (pp (fib 1)) 11 | (pp (fib 10)) 12 | (pp (fib 20)) 13 | (pp (fib 30)) 14 | (pp (fib 35)) 15 | 16 | ;0 17 | ;1 18 | ;55 19 | ;6765 20 | ;832040 21 | ;9227465 22 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/fibfp.scm: -------------------------------------------------------------------------------- 1 | ;;; FIBFP -- Computes fib(35) using floating point 2 | 3 | (##define-macro (def-macro form . body) 4 | `(##define-macro ,form (let () ,@body))) 5 | 6 | (def-macro (FLOAT> . lst) `(> ,@lst)) 7 | (def-macro (FLOAT>= . lst) `(>= ,@lst)) 8 | (def-macro (FLOAT< . lst) `(< ,@lst)) 9 | (def-macro (FLOAT<= . lst) `(<= ,@lst)) 10 | (def-macro (FLOAT+ . lst) `(+ ,@lst)) 11 | (def-macro (FLOAT- . lst) `(- ,@lst)) 12 | (def-macro (FLOAT* . lst) `(* ,@lst)) 13 | (def-macro (FLOAT/ . lst) `(/ ,@lst)) 14 | 15 | (define (fibfp n) 16 | (if (FLOAT< n 2.) 17 | n 18 | (FLOAT+ (fibfp (FLOAT- n 1.)) 19 | (fibfp (FLOAT- n 2.))))) 20 | 21 | (let ((result (fibfp 35.))) 22 | (println (= result 9227465.))) 23 | 24 | ;#t 25 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/mbrot.scm: -------------------------------------------------------------------------------- 1 | ;;; MBROT -- Generation of Mandelbrot set fractal. 2 | 3 | (##define-macro (def-macro form . body) 4 | `(##define-macro ,form (let () ,@body))) 5 | 6 | (def-macro (FLOAT> . lst) `(> ,@lst)) 7 | (def-macro (FLOAT>= . lst) `(>= ,@lst)) 8 | (def-macro (FLOAT< . lst) `(< ,@lst)) 9 | (def-macro (FLOAT<= . lst) `(<= ,@lst)) 10 | (def-macro (FLOAT+ . lst) `(+ ,@lst)) 11 | (def-macro (FLOAT- . lst) `(- ,@lst)) 12 | (def-macro (FLOAT* . lst) `(* ,@lst)) 13 | (def-macro (FLOAT/ . lst) `(/ ,@lst)) 14 | 15 | (define (count r i step x y) 16 | 17 | (let ((max-count 64) 18 | (radius^2 16.0)) 19 | 20 | (let ((cr (FLOAT+ r (FLOAT* (exact->inexact x) step))) 21 | (ci (FLOAT+ i (FLOAT* (exact->inexact y) step)))) 22 | 23 | (let loop ((zr cr) 24 | (zi ci) 25 | (c 0)) 26 | (if (= c max-count) 27 | c 28 | (let ((zr^2 (FLOAT* zr zr)) 29 | (zi^2 (FLOAT* zi zi))) 30 | (if (FLOAT> (FLOAT+ zr^2 zi^2) radius^2) 31 | c 32 | (let ((new-zr (FLOAT+ (FLOAT- zr^2 zi^2) cr)) 33 | (new-zi (FLOAT+ (FLOAT* 2.0 (FLOAT* zr zi)) ci))) 34 | (loop new-zr new-zi (+ c 1)))))))))) 35 | 36 | (define (mbrot matrix r i step n) 37 | (let loop1 ((y (- n 1))) 38 | (if (>= y 0) 39 | (let loop2 ((x (- n 1))) 40 | (if (>= x 0) 41 | (begin 42 | (vector-set! (vector-ref matrix x) y (count r i step x y)) 43 | (loop2 (- x 1))) 44 | (loop1 (- y 1))))))) 45 | 46 | (define (test n) 47 | (let ((matrix (make-vector n))) 48 | (let loop ((i (- n 1))) 49 | (if (>= i 0) 50 | (begin 51 | (vector-set! matrix i (make-vector n)) 52 | (loop (- i 1))))) 53 | (mbrot matrix -1.0 -0.5 0.005 n) 54 | (vector-ref (vector-ref matrix 0) 0))) 55 | 56 | (println (test 75)) 57 | 58 | ;5 59 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/nqueens.scm: -------------------------------------------------------------------------------- 1 | ;;; NQUEENS -- Compute number of solutions to 8-queens problem. 2 | 3 | (define trace? #f) 4 | 5 | (define (nqueens n) 6 | 7 | (define (_1-to n) 8 | (let loop ((i n) (l '())) 9 | (if (= i 0) l (loop (- i 1) (cons i l))))) 10 | 11 | (define (my-try x y z) 12 | (if (null? x) 13 | (if (null? y) 14 | (begin (if trace? (begin (write z) (newline))) 1) 15 | 0) 16 | (+ (if (ok? (car x) 1 z) 17 | (my-try (append (cdr x) y) '() (cons (car x) z)) 18 | 0) 19 | (my-try (cdr x) (cons (car x) y) z)))) 20 | 21 | (define (ok? row dist placed) 22 | (if (null? placed) 23 | #t 24 | (and (not (= (car placed) (+ row dist))) 25 | (not (= (car placed) (- row dist))) 26 | (ok? row (+ dist 1) (cdr placed))))) 27 | 28 | (my-try (_1-to n) '() '())) 29 | 30 | (println (nqueens 8)) 31 | 32 | ;92 33 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/perm9.scm: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ; File: perm9.sch 3 | ; Description: memory system benchmark using Zaks's permutation generator 4 | ; Author: Lars Hansen, Will Clinger, and Gene Luks 5 | ; Created: 18-Mar-94 6 | ; Language: Scheme 7 | ; Status: Public Domain 8 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 9 | 10 | ; 940720 / lth Added some more benchmarks for the thesis paper. 11 | ; 970215 / wdc Increased problem size from 8 to 9; improved tenperm9-benchmark. 12 | ; 970531 / wdc Cleaned up for public release. 13 | ; 981116 / wdc Simplified to fit in with Feeley's benchmark suite. 14 | 15 | ; The perm9 benchmark generates a list of all 362880 permutations of 16 | ; the first 9 integers, allocating 1349288 pairs (typically 10,794,304 17 | ; bytes), all of which goes into the generated list. (That is, the 18 | ; perm9 benchmark generates absolutely no garbage.) This represents 19 | ; a savings of about 63% over the storage that would be required by 20 | ; an unshared list of permutations. The generated permutations are 21 | ; in order of a grey code that bears no obvious relationship to a 22 | ; lexicographic order. 23 | ; 24 | ; The 10perm9 benchmark repeats the perm9 benchmark 10 times, so it 25 | ; allocates and reclaims 13492880 pairs (typically 107,943,040 bytes). 26 | ; The live storage peaks at twice the storage that is allocated by the 27 | ; perm9 benchmark. At the end of each iteration, the oldest half of 28 | ; the live storage becomes garbage. Object lifetimes are distributed 29 | ; uniformly between 10.3 and 20.6 megabytes. 30 | 31 | ; Date: Thu, 17 Mar 94 19:43:32 -0800 32 | ; From: luks@sisters.cs.uoregon.edu 33 | ; To: will 34 | ; Subject: Pancake flips 35 | ; 36 | ; Procedure P_n generates a grey code of all perms of n elements 37 | ; on top of stack ending with reversal of starting sequence 38 | ; 39 | ; F_n is flip of top n elements. 40 | ; 41 | ; 42 | ; procedure P_n 43 | ; 44 | ; if n>1 then 45 | ; begin 46 | ; repeat P_{n-1},F_n n-1 times; 47 | ; P_{n-1} 48 | ; end 49 | ; 50 | 51 | (define (permutations x) 52 | (let ((x x) 53 | (perms (list x))) 54 | (define (P n) 55 | (if (> n 1) 56 | (do ((j (- n 1) (- j 1))) 57 | ((zero? j) 58 | (P (- n 1))) 59 | (P (- n 1)) 60 | (F n)))) 61 | (define (F n) 62 | (set! x (revloop x n (list-tail x n))) 63 | (set! perms (cons x perms))) 64 | (define (revloop x n y) 65 | (if (zero? n) 66 | y 67 | (revloop (cdr x) 68 | (- n 1) 69 | (cons (car x) y)))) 70 | (define (list-tail x n) 71 | (if (zero? n) 72 | x 73 | (list-tail (cdr x) (- n 1)))) 74 | (P (length x)) 75 | perms)) 76 | 77 | ; Given a list of lists of numbers, returns the sum of the sums 78 | ; of those lists. 79 | ; 80 | ; for (; x != NULL; x = x->rest) 81 | ; for (y = x->first; y != NULL; y = y->rest) 82 | ; sum = sum + y->first; 83 | 84 | (define (sumlists x) 85 | (do ((x x (cdr x)) 86 | (sum 0 (do ((y (car x) (cdr y)) 87 | (sum sum (+ sum (car y)))) 88 | ((null? y) sum)))) 89 | ((null? x) sum))) 90 | 91 | (define (one..n n) 92 | (do ((n n (- n 1)) 93 | (p '() (cons n p))) 94 | ((zero? n) p))) 95 | 96 | ;----- 97 | 98 | (println (sumlists (permutations (one..n 9)))) 99 | 100 | ;16329600 101 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/pnpoly-f64v.scm: -------------------------------------------------------------------------------- 1 | ;;; PNPOLY - Test if a point is contained in a 2D polygon. 2 | 3 | (##define-macro (def-macro form . body) 4 | `(##define-macro ,form (let () ,@body))) 5 | 6 | (def-macro (FLOATvector-const . lst) `',(list->f64vector lst)) 7 | (def-macro (FLOATvector-ref v i) `(f64vector-ref ,v ,i)) 8 | (def-macro (FLOATvector-length v) `(f64vector-length ,v)) 9 | (def-macro (FLOAT> . lst) `(> ,@lst)) 10 | (def-macro (FLOAT>= . lst) `(>= ,@lst)) 11 | (def-macro (FLOAT< . lst) `(< ,@lst)) 12 | (def-macro (FLOAT<= . lst) `(<= ,@lst)) 13 | (def-macro (FLOAT+ . lst) `(+ ,@lst)) 14 | (def-macro (FLOAT- . lst) `(- ,@lst)) 15 | (def-macro (FLOAT* . lst) `(* ,@lst)) 16 | (def-macro (FLOAT/ . lst) `(/ ,@lst)) 17 | 18 | ;;------------------------------------------------------------------------------ 19 | 20 | (define (pt-in-poly2 xp yp x y) 21 | (let loop ((c #f) (i (- (FLOATvector-length xp) 1)) (j 0)) 22 | (if (< i 0) 23 | c 24 | (if (or (and (or (FLOAT> (FLOATvector-ref yp i) y) 25 | (FLOAT>= y (FLOATvector-ref yp j))) 26 | (or (FLOAT> (FLOATvector-ref yp j) y) 27 | (FLOAT>= y (FLOATvector-ref yp i)))) 28 | (FLOAT>= x 29 | (FLOAT+ (FLOATvector-ref xp i) 30 | (FLOAT/ (FLOAT* 31 | (FLOAT- (FLOATvector-ref xp j) 32 | (FLOATvector-ref xp i)) 33 | (FLOAT- y (FLOATvector-ref yp i))) 34 | (FLOAT- (FLOATvector-ref yp j) 35 | (FLOATvector-ref yp i)))))) 36 | (loop c (- i 1) i) 37 | (loop (not c) (- i 1) i))))) 38 | 39 | (define (run) 40 | (let ((count 0) 41 | (xp (FLOATvector-const 0. 1. 1. 0. 0. 1. -.5 -1. -1. -2. -2.5 42 | -2. -1.5 -.5 1. 1. 0. -.5 -1. -.5)) 43 | (yp (FLOATvector-const 0. 0. 1. 1. 2. 3. 2. 3. 0. -.5 -1. 44 | -1.5 -2. -2. -1.5 -1. -.5 -1. -1. -.5))) 45 | (if (pt-in-poly2 xp yp .5 .5) (set! count (+ count 1))) 46 | (if (pt-in-poly2 xp yp .5 1.5) (set! count (+ count 1))) 47 | (if (pt-in-poly2 xp yp -.5 1.5) (set! count (+ count 1))) 48 | (if (pt-in-poly2 xp yp .75 2.25) (set! count (+ count 1))) 49 | (if (pt-in-poly2 xp yp 0. 2.01) (set! count (+ count 1))) 50 | (if (pt-in-poly2 xp yp -.5 2.5) (set! count (+ count 1))) 51 | (if (pt-in-poly2 xp yp -1. -.5) (set! count (+ count 1))) 52 | (if (pt-in-poly2 xp yp -1.5 .5) (set! count (+ count 1))) 53 | (if (pt-in-poly2 xp yp -2.25 -1.) (set! count (+ count 1))) 54 | (if (pt-in-poly2 xp yp .5 -.25) (set! count (+ count 1))) 55 | (if (pt-in-poly2 xp yp .5 -1.25) (set! count (+ count 1))) 56 | (if (pt-in-poly2 xp yp -.5 -2.5) (set! count (+ count 1))) 57 | count)) 58 | 59 | (println (run)) 60 | 61 | ;6 62 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/pnpoly.scm: -------------------------------------------------------------------------------- 1 | ;;; PNPOLY - Test if a point is contained in a 2D polygon. 2 | 3 | (##define-macro (def-macro form . body) 4 | `(##define-macro ,form (let () ,@body))) 5 | 6 | (def-macro (FLOATvector-const . lst) `',(list->vector lst)) 7 | (def-macro (FLOATvector-ref v i) `(vector-ref ,v ,i)) 8 | (def-macro (FLOATvector-length v) `(vector-length ,v)) 9 | (def-macro (FLOAT= . lst) `(= ,@lst)) 10 | (def-macro (FLOAT> . lst) `(> ,@lst)) 11 | (def-macro (FLOAT>= . lst) `(>= ,@lst)) 12 | (def-macro (FLOAT< . lst) `(< ,@lst)) 13 | (def-macro (FLOAT<= . lst) `(<= ,@lst)) 14 | (def-macro (FLOAT+ . lst) `(+ ,@lst)) 15 | (def-macro (FLOAT- . lst) `(- ,@lst)) 16 | (def-macro (FLOAT* . lst) `(* ,@lst)) 17 | (def-macro (FLOAT/ . lst) `(/ ,@lst)) 18 | 19 | ;;------------------------------------------------------------------------------ 20 | 21 | (define (pt-in-poly2 xp yp x y) 22 | (let loop ((c #f) (i (- (FLOATvector-length xp) 1)) (j 0)) 23 | (if (< i 0) 24 | c 25 | (if (or (and (or (FLOAT> (FLOATvector-ref yp i) y) 26 | (FLOAT>= y (FLOATvector-ref yp j))) 27 | (or (FLOAT> (FLOATvector-ref yp j) y) 28 | (FLOAT>= y (FLOATvector-ref yp i)))) 29 | (FLOAT>= x 30 | (FLOAT+ (FLOATvector-ref xp i) 31 | (FLOAT/ (FLOAT* 32 | (FLOAT- (FLOATvector-ref xp j) 33 | (FLOATvector-ref xp i)) 34 | (FLOAT- y (FLOATvector-ref yp i))) 35 | (FLOAT- (FLOATvector-ref yp j) 36 | (FLOATvector-ref yp i)))))) 37 | (loop c (- i 1) i) 38 | (loop (not c) (- i 1) i))))) 39 | 40 | (define (run) 41 | (let ((count 0) 42 | (xp (FLOATvector-const 0. 1. 1. 0. 0. 1. -.5 -1. -1. -2. -2.5 43 | -2. -1.5 -.5 1. 1. 0. -.5 -1. -.5)) 44 | (yp (FLOATvector-const 0. 0. 1. 1. 2. 3. 2. 3. 0. -.5 -1. 45 | -1.5 -2. -2. -1.5 -1. -.5 -1. -1. -.5))) 46 | (if (pt-in-poly2 xp yp .5 .5) (set! count (+ count 1))) 47 | (if (pt-in-poly2 xp yp .5 1.5) (set! count (+ count 1))) 48 | (if (pt-in-poly2 xp yp -.5 1.5) (set! count (+ count 1))) 49 | (if (pt-in-poly2 xp yp .75 2.25) (set! count (+ count 1))) 50 | (if (pt-in-poly2 xp yp 0. 2.01) (set! count (+ count 1))) 51 | (if (pt-in-poly2 xp yp -.5 2.5) (set! count (+ count 1))) 52 | (if (pt-in-poly2 xp yp -1. -.5) (set! count (+ count 1))) 53 | (if (pt-in-poly2 xp yp -1.5 .5) (set! count (+ count 1))) 54 | (if (pt-in-poly2 xp yp -2.25 -1.) (set! count (+ count 1))) 55 | (if (pt-in-poly2 xp yp .5 -.25) (set! count (+ count 1))) 56 | (if (pt-in-poly2 xp yp .5 -1.25) (set! count (+ count 1))) 57 | (if (pt-in-poly2 xp yp -.5 -2.5) (set! count (+ count 1))) 58 | count)) 59 | 60 | (println (run)) 61 | 62 | ;6 63 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/primes.scm: -------------------------------------------------------------------------------- 1 | ;;; PRIMES -- Compute primes less than 100, written by Eric Mohr. 2 | 3 | ;;; LC NOTE : Can't compute more primes because of heap/stack overflow 4 | 5 | (define (interval-list m n) 6 | (if (> m n) 7 | '() 8 | (cons m (interval-list (+ 1 m) n)))) 9 | 10 | (define (sieve l) 11 | (letrec ((remove-multiples 12 | (lambda (n l) 13 | (if (null? l) 14 | '() 15 | (if (= (modulo (car l) n) 0) 16 | (remove-multiples n (cdr l)) 17 | (cons (car l) 18 | (remove-multiples n (cdr l)))))))) 19 | (if (null? l) 20 | '() 21 | (cons (car l) 22 | (sieve (remove-multiples (car l) (cdr l))))))) 23 | 24 | (define (primes<= n) 25 | (sieve (interval-list 2 n))) 26 | 27 | (pp (primes<= 0)) 28 | (pp (primes<= 1)) 29 | (pp (primes<= 50)) 30 | (pp (primes<= 80)) 31 | 32 | ;() 33 | ;() 34 | ;(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47) 35 | ;(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79) 36 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/string.scm: -------------------------------------------------------------------------------- 1 | ;;; STRING -- One of the Kernighan and Van Wyk benchmarks. 2 | 3 | ;;; LC NOTE : Can't compute more because of heap/stack overflow 4 | 5 | (define s "abcdef") 6 | 7 | (define (grow) 8 | (set! s (string-append "123" s "456" s "789")) 9 | (set! s (string-append 10 | (substring s (quotient (string-length s) 2) (string-length s)) 11 | (substring s 0 (+ 1 (quotient (string-length s) 2))))) 12 | s) 13 | 14 | (define (trial n) 15 | (do ((i 0 (+ i 1))) 16 | ((> (string-length s) n) (string-length s)) 17 | (grow))) 18 | 19 | (define (my-try n) 20 | (do ((i 0 (+ i 1))) 21 | ((>= i 10) (string-length s)) 22 | (set! s "abcdef") 23 | (trial n))) 24 | 25 | (println (my-try 0)) 26 | (println (my-try 1)) 27 | (println (my-try 5)) 28 | (println (my-try 10)) 29 | 30 | ;6 31 | ;6 32 | ;6 33 | ;22 34 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/sum.scm: -------------------------------------------------------------------------------- 1 | ;;; SUM -- Compute sum of integers from 0 to n 2 | 3 | (define (run n) 4 | (let loop ((i n) (sum 0)) 5 | (if (< i 0) 6 | sum 7 | (loop (- i 1) (+ i sum))))) 8 | 9 | (pp (run 0)) 10 | (pp (run 1)) 11 | (pp (run 10)) 12 | (pp (run 100)) 13 | (pp (run 1000)) 14 | (pp (run 10000)) 15 | (pp (run 100000)) 16 | 17 | ;0 18 | ;1 19 | ;55 20 | ;5050 21 | ;500500 22 | ;50005000 23 | ;5000050000 24 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/sumfp.scm: -------------------------------------------------------------------------------- 1 | ;;; SUMFP -- Compute sum of integers from 0 to 10000 using floating point 2 | 3 | (##define-macro (def-macro form . body) 4 | `(##define-macro ,form (let () ,@body))) 5 | 6 | (def-macro (FLOAT> . lst) `(> ,@lst)) 7 | (def-macro (FLOAT>= . lst) `(>= ,@lst)) 8 | (def-macro (FLOAT< . lst) `(< ,@lst)) 9 | (def-macro (FLOAT<= . lst) `(<= ,@lst)) 10 | (def-macro (FLOAT+ . lst) `(+ ,@lst)) 11 | (def-macro (FLOAT- . lst) `(- ,@lst)) 12 | (def-macro (FLOAT* . lst) `(* ,@lst)) 13 | (def-macro (FLOAT/ . lst) `(/ ,@lst)) 14 | 15 | (define (run n) 16 | (let loop ((i n) (sum 0.)) 17 | (if (FLOAT< i 0.) 18 | sum 19 | (loop (FLOAT- i 1.) (FLOAT+ i sum))))) 20 | 21 | (let ((result (run 10000.))) 22 | (println (= result 50005000.))) 23 | 24 | ;#t 25 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/sumloop.scm: -------------------------------------------------------------------------------- 1 | ;;; SUMLOOP -- One of the Kernighan and Van Wyk benchmarks. 2 | 3 | ;;; LC NOTE : Can't compute more because of heap/stack overflow 4 | 5 | (define sum 0) 6 | 7 | (define (tail-rec-aux i n) 8 | (if (< i n) 9 | (begin (set! sum (+ sum 1)) (tail-rec-aux (+ i 1) n)) 10 | sum)) 11 | 12 | (define (tail-rec-loop n) 13 | (set! sum 0) 14 | (tail-rec-aux 0 n) 15 | sum) 16 | 17 | (define (do-loop n) 18 | (set! sum 0) 19 | (do ((i 0 (+ i 1))) 20 | ((>= i n) sum) 21 | (set! sum (+ sum 1)))) 22 | 23 | (pp (do-loop 0)) 24 | (pp (do-loop 1)) 25 | (pp (do-loop 10)) 26 | (pp (do-loop 50)) 27 | (pp (do-loop 100)) 28 | 29 | ;0 30 | ;1 31 | ;10 32 | ;50 33 | ;100 34 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/tak.scm: -------------------------------------------------------------------------------- 1 | ;;; TAK -- A vanilla version of the TAKeuchi function. 2 | 3 | (define (tak x y z) 4 | (if (not (< y x)) 5 | z 6 | (tak (tak (- x 1) y z) 7 | (tak (- y 1) z x) 8 | (tak (- z 1) x y)))) 9 | 10 | (pp (tak 9 6 3)) 11 | (pp (tak 18 12 6)) 12 | (pp (tak 27 18 9)) 13 | 14 | 15 | ;6 16 | ;7 17 | ;18 18 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/takl.scm: -------------------------------------------------------------------------------- 1 | ;;; TAKL -- The TAKeuchi function using lists as counters. 2 | 3 | (define (listn n) 4 | (if (= n 0) 5 | '() 6 | (cons n (listn (- n 1))))) 7 | 8 | (define l18 (listn 18)) 9 | (define l12 (listn 12)) 10 | (define l6 (listn 6)) 11 | 12 | (define (shorterp x y) 13 | (and (not (null? y)) 14 | (or (null? x) 15 | (shorterp (cdr x) 16 | (cdr y))))) 17 | 18 | (define (mas x y z) 19 | (if (not (shorterp y x)) 20 | z 21 | (mas (mas (cdr x) y z) 22 | (mas (cdr y) z x) 23 | (mas (cdr z) x y)))) 24 | 25 | ;;; RUN TEST 26 | 27 | (define l9 (listn 9)) 28 | (define l3 (listn 3)) 29 | (define l21 (listn 21)) 30 | (define l15 (listn 15)) 31 | 32 | (pp (mas l9 l6 l3)) 33 | (pp (mas l18 l12 l6)) 34 | (pp (mas l21 l15 l9)) 35 | 36 | ;(6 5 4 3 2 1) 37 | ;(7 6 5 4 3 2 1) 38 | ;(10 9 8 7 6 5 4 3 2 1) 39 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/triangl.scm: -------------------------------------------------------------------------------- 1 | ;;; TRIANGL -- Board game benchmark. 2 | 3 | (define *board* 4 | (list->vector '(1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1))) 5 | 6 | (define *sequence* 7 | (list->vector '(0 0 0 0 0 0 0 0 0 0 0 0 0 0))) 8 | 9 | (define *a* 10 | (list->vector '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 11 | 13 7 8 4 4 7 11 8 12 13 6 10 12 | 15 9 14 13 13 14 15 9 10 13 | 6 6))) 14 | 15 | (define *b* 16 | (list->vector '(2 4 7 5 8 9 3 6 10 5 9 8 17 | 12 13 14 8 9 5 2 4 7 5 8 18 | 9 3 6 10 5 9 8 12 13 14 19 | 8 9 5 5))) 20 | 21 | (define *c* 22 | (list->vector '(4 7 11 8 12 13 6 10 15 9 14 13 23 | 13 14 15 9 10 6 1 2 4 3 5 6 1 24 | 3 6 2 5 4 11 12 13 7 8 4 4))) 25 | 26 | (define *answer* '()) 27 | 28 | (define (attempt i depth) 29 | (cond ((= depth 14) 30 | (set! *answer* 31 | (cons (cdr (vector->list *sequence*)) *answer*)) 32 | #t) 33 | ((and (= 1 (vector-ref *board* (vector-ref *a* i))) 34 | (= 1 (vector-ref *board* (vector-ref *b* i))) 35 | (= 0 (vector-ref *board* (vector-ref *c* i)))) 36 | (vector-set! *board* (vector-ref *a* i) 0) 37 | (vector-set! *board* (vector-ref *b* i) 0) 38 | (vector-set! *board* (vector-ref *c* i) 1) 39 | (vector-set! *sequence* depth i) 40 | (do ((j 0 (+ j 1)) 41 | (depth (+ depth 1))) 42 | ((or (= j 36) (attempt j depth)) #f)) 43 | (vector-set! *board* (vector-ref *a* i) 1) 44 | (vector-set! *board* (vector-ref *b* i) 1) 45 | (vector-set! *board* (vector-ref *c* i) 0) #f) 46 | (else #f))) 47 | 48 | (define (test i depth) 49 | (set! *answer* '()) 50 | (attempt i depth) 51 | (car *answer*)) 52 | 53 | ;----- 54 | 55 | (pp (test 22 1)) 56 | 57 | ;(22 34 31 15 7 1 20 17 25 6 5 13 32) 58 | -------------------------------------------------------------------------------- /unit-tests/benchmarks/wc.scm: -------------------------------------------------------------------------------- 1 | ;;; WC -- One of the Kernighan and Van Wyk benchmarks. 2 | 3 | (define inport #f) 4 | 5 | (define nl #f) 6 | (define nw #f) 7 | (define nc #f) 8 | (define inword #f) 9 | 10 | (define (wcport port) 11 | (let ((x (read-char port))) 12 | (if (eof-object? x) 13 | (begin 14 | (list nl nw nc)) 15 | (begin 16 | (set! nc (+ nc 1)) 17 | (if (char=? x #\newline) 18 | (set! nl (+ nl 1))) 19 | (if (or (char=? x #\space) 20 | (char=? x #\newline)) 21 | (set! inword #f) 22 | (if (not inword) 23 | (begin 24 | (set! nw (+ nw 1)) 25 | (set! inword #t)))) 26 | (wcport port))))) 27 | 28 | (define (go) 29 | (set! inport (open-input-file "./unit-tests/benchmarks/bib")) 30 | (set! nl 0) 31 | (set! nw 0) 32 | (set! nc 0) 33 | (set! inword #f) 34 | (let ((result (wcport inport))) 35 | (close-input-port inport) 36 | result)) 37 | 38 | (pp (go)) 39 | 40 | ;(1000 26652 137115) 41 | -------------------------------------------------------------------------------- /unit-tests/do.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | ;;; Simple do 31 | (do ((i 0 (+ i 1))) 32 | ((= i 4) (println #t)) 33 | (println i)) 34 | 35 | ;;; No step 36 | (do ((i 0)) 37 | ((= i 4) (println #t)) 38 | (println i) 39 | (set! i (+ i 1))) 40 | 41 | ;;; No command 42 | (do ((i 0)) 43 | ((= (begin (set! i (+ i 1)) 44 | (println (- i 1)) 45 | i) 4) (println #t))) 46 | 47 | ;;; More complex form 48 | (pp 49 | (do ((vec (make-vector 4)) 50 | (i 0 (+ i 100)) 51 | (j 0 (+ j 1))) 52 | ((= i 400) (println #t) vec) 53 | (println j) 54 | (vector-set! vec j i)) 55 | ) 56 | 57 | ;0 58 | ;1 59 | ;2 60 | ;3 61 | ;#t 62 | ;0 63 | ;1 64 | ;2 65 | ;3 66 | ;#t 67 | ;0 68 | ;1 69 | ;2 70 | ;3 71 | ;#t 72 | ;0 73 | ;1 74 | ;2 75 | ;3 76 | ;#t 77 | ;#(0 100 200 300) 78 | -------------------------------------------------------------------------------- /unit-tests/let.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (let ((x 1)) 31 | (println x)) 32 | 33 | (let ((x 1) 34 | (y 2)) 35 | (println x)) 36 | 37 | (let ((x 1) 38 | (y 2)) 39 | (println y)) 40 | 41 | (let ((x 1) 42 | (y 2) 43 | (z 3)) 44 | (println x) 45 | (println y) 46 | (println z) 47 | z) 48 | 49 | (define lx 10) 50 | (let ((lx 100) 51 | (ly (+ lx 200))) 52 | (println lx) 53 | (println ly)) 54 | 55 | (println 123456789) 56 | 57 | (let* ((x 1) 58 | (y 2)) 59 | (println x)) 60 | 61 | (let* ((x 1) 62 | (y 2)) 63 | (println y)) 64 | 65 | (let* ((x 1) 66 | (y 2) 67 | (z 3)) 68 | (println x) 69 | (println y) 70 | (println z) 71 | z) 72 | 73 | (define la 10) 74 | (let* ((lb (+ la 200)) 75 | (la 100) 76 | (lc (+ la 200))) 77 | (println la) 78 | (println lb) 79 | (println lc)) 80 | 81 | (letrec ((f (lambda (n) 82 | (if (= 0 n) 83 | (write-char #\P) 84 | (g (- n 1))))) 85 | (g (lambda (n) 86 | (if (= 0 n) 87 | (write-char #\I) 88 | (f (- n 1)))))) 89 | (f 11) 90 | (f 12) 91 | (f 13) 92 | (f 14) 93 | (f 15) 94 | (f 16) 95 | (newline)) 96 | 97 | (println 98 | 99 | (let fact ((n 4)) 100 | (println 10) 101 | (if (= n 0) 102 | 1 103 | (* n (fact (- n 1))))) 104 | 105 | ) 106 | 107 | ;1 108 | ;1 109 | ;2 110 | ;1 111 | ;2 112 | ;3 113 | ;100 114 | ;210 115 | ;123456789 116 | ;1 117 | ;2 118 | ;1 119 | ;2 120 | ;3 121 | ;100 122 | ;210 123 | ;300 124 | ;IPIPIP 125 | ;10 126 | ;10 127 | ;10 128 | ;10 129 | ;10 130 | ;24 131 | -------------------------------------------------------------------------------- /unit-tests/numbers.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define a 10) 31 | (define b 11) 32 | (define c -10) 33 | (define d -11) 34 | (define e 0) 35 | 36 | (pp (odd? a)) 37 | (pp (odd? b)) 38 | (pp (odd? c)) 39 | (pp (odd? d)) 40 | (pp (odd? e)) 41 | 42 | (pp (even? a)) 43 | (pp (even? b)) 44 | (pp (even? c)) 45 | (pp (even? d)) 46 | (pp (even? e)) 47 | 48 | (pp (negative? a)) 49 | (pp (negative? b)) 50 | (pp (negative? c)) 51 | (pp (negative? d)) 52 | (pp (negative? e)) 53 | 54 | (pp (positive? a)) 55 | (pp (positive? b)) 56 | (pp (positive? c)) 57 | (pp (positive? d)) 58 | (pp (positive? e)) 59 | 60 | (pp (zero? a)) 61 | (pp (zero? b)) 62 | (pp (zero? c)) 63 | (pp (zero? d)) 64 | (pp (zero? e)) 65 | 66 | (pp (remainder 5 4)) 67 | (pp (remainder -5 4)) 68 | (pp (remainder 5 -4)) 69 | (pp (remainder -5 -4)) 70 | 71 | (pp (modulo 5 4)) 72 | (pp (modulo -5 4)) 73 | (pp (modulo 5 -4)) 74 | (pp (modulo -5 -4)) 75 | 76 | ;#f 77 | ;#t 78 | ;#f 79 | ;#t 80 | ;#f 81 | ;#t 82 | ;#f 83 | ;#t 84 | ;#f 85 | ;#t 86 | ;#f 87 | ;#f 88 | ;#t 89 | ;#t 90 | ;#f 91 | ;#t 92 | ;#t 93 | ;#f 94 | ;#f 95 | ;#f 96 | ;#f 97 | ;#f 98 | ;#f 99 | ;#f 100 | ;#t 101 | ;1 102 | ;-1 103 | ;1 104 | ;-1 105 | ;1 106 | ;3 107 | ;-3 108 | ;-1 109 | -------------------------------------------------------------------------------- /unit-tests/operators/eq.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (println (eq? 10 10)) 31 | (println (eq? 10 -10)) 32 | (println (eq? -10 10)) 33 | (println (eq? -10 -10)) 34 | (println (eq? (- 20 10) (+ 5 5))) 35 | 36 | (println (eq? #f 10)) 37 | (println (eq? #f #t)) 38 | (println (eq? #f #f)) 39 | (println (eq? #t #t)) 40 | 41 | (println (eq? '() 10)) 42 | (println (eq? '() #f)) 43 | (println (eq? '() '())) 44 | 45 | (println (eq? (cons 1 2) 10)) 46 | (println (eq? (cons 1 2) #t)) 47 | (println (eq? (cons 1 2) '())) 48 | (println (eq? (cons 1 2) (cons 1 2))) 49 | 50 | (println (eq? (lambda (x y) (* x y)) 10)) 51 | (println (eq? (lambda (x y) (* x y)) #f)) 52 | (println (eq? (lambda (x y) (* x y)) '())) 53 | (println (eq? (lambda (x y) (* x y)) (cons 1 2))) 54 | 55 | ;#t 56 | ;#f 57 | ;#f 58 | ;#t 59 | ;#t 60 | ;#f 61 | ;#f 62 | ;#t 63 | ;#t 64 | ;#f 65 | ;#f 66 | ;#t 67 | ;#f 68 | ;#f 69 | ;#f 70 | ;#f 71 | ;#f 72 | ;#f 73 | ;#f 74 | ;#f 75 | -------------------------------------------------------------------------------- /unit-tests/operators/not.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (println (not #t)) 31 | (println (not #f)) 32 | (println (not 10)) 33 | (println (not '())) 34 | (println (not (cons 1 2))) 35 | (println (not (lambda (x y) (+ x y)))) 36 | (println (not (> 10 12))) 37 | (println (not (> 12 10))) 38 | (println (not (not (not (not (not (not (> 10 12)))))))) 39 | 40 | ;#f 41 | ;#t 42 | ;#f 43 | ;#f 44 | ;#f 45 | ;#f 46 | ;#t 47 | ;#f 48 | ;#f 49 | -------------------------------------------------------------------------------- /unit-tests/pp.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (pp 0) 31 | (pp -0) 32 | (pp -000) 33 | (pp 12345) 34 | (pp -12345) 35 | (pp (* (+ 5 2) (- 5 1))) 36 | 37 | (pp #t) 38 | (pp #f) 39 | (pp (not (not (not (<= 10 10))))) 40 | 41 | (pp '()) 42 | 43 | (pp (cons 10 20)) 44 | (pp (cons 10 (cons 20 '()))) 45 | (pp (cons 99 (cons #f (cons '() '())))) 46 | 47 | (pp '(1 #f 3)) 48 | (pp '(1 () (#f 4) 5 #t)) 49 | (pp '(1 #f (3 4) ())) 50 | 51 | (pp (make-vector 2 42)) 52 | (pp (list->vector '(1 2 3 4 5))) 53 | (pp (make-vector 0)) 54 | 55 | (pp #\a) 56 | (pp #\A) 57 | (pp #\newline) 58 | (pp (string-ref "a a" 1)) 59 | 60 | (pp "Hello World") 61 | (pp (make-string 4 #\Z)) 62 | 63 | (pp 'SYMBOL) 64 | (pp (string->symbol (string-append "SYM" (symbol->string 'BOL)))) 65 | 66 | ;0 67 | ;0 68 | ;0 69 | ;12345 70 | ;-12345 71 | ;28 72 | ;#t 73 | ;#f 74 | ;#f 75 | ;() 76 | ;(10 . 20) 77 | ;(10 20) 78 | ;(99 #f ()) 79 | ;(1 #f 3) 80 | ;(1 () (#f 4) 5 #t) 81 | ;(1 #f (3 4) ()) 82 | ;#(42 42) 83 | ;#(1 2 3 4 5) 84 | ;#() 85 | ;#\a 86 | ;#\A 87 | ;#\newline 88 | ;#\space 89 | ;"Hello World" 90 | ;"ZZZZ" 91 | ;SYMBOL 92 | ;SYMBOL 93 | -------------------------------------------------------------------------------- /unit-tests/print.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | ;; Number 31 | (println 0) 32 | (println -0) 33 | (println -000) 34 | (println 12345) 35 | (println -12345) 36 | (println (* (+ 5 2) (- 5 1))) 37 | 38 | ;; Boolean 39 | (println #t) 40 | (println #f) 41 | (println (not (not (not (<= 10 10))))) 42 | 43 | ;; Null 44 | (println '()) 45 | 46 | ;; Pair 47 | (println (cons 10 20)) 48 | (println (cons 10 (cons 20 '()))) 49 | (println (cons 99 (cons #f (cons '() '())))) 50 | ;; 51 | (println '(1 2 3)) 52 | (println '(1 2 (3 4) 5 6)) 53 | (println '(1 2 (3 4) 5)) 54 | 55 | ;; Char 56 | (println #\a) 57 | (println #\Z) 58 | (println #\?) 59 | (println #\newline) 60 | (println (integer->char 104)) 61 | 62 | ;; String 63 | (println "Hello World") 64 | (println "éêà") 65 | (println "10€ or 10$") 66 | (println (make-string 5 (integer->char 65))) 67 | (println (substring "Dark Vador" 0 4)) 68 | 69 | ;; Vector 70 | (println (make-vector 4 "Hi.")) 71 | (define v (make-vector 4 0)) 72 | (vector-set! v 2 "Hey") 73 | (println v) 74 | (println (vector-ref v 0)) 75 | 76 | ;; Symbol 77 | (println 'Hello) 78 | (define sym 'Dark) 79 | (define str " Vador") 80 | (println (string->symbol (string-append (symbol->string sym) str))) 81 | 82 | ;0 83 | ;0 84 | ;0 85 | ;12345 86 | ;-12345 87 | ;28 88 | ;#t 89 | ;#f 90 | ;#f 91 | ; 92 | ;1020 93 | ;1020 94 | ;99#f 95 | ;123 96 | ;123456 97 | ;12345 98 | ;a 99 | ;Z 100 | ;? 101 | ; 102 | ; 103 | ;h 104 | ;Hello World 105 | ;éêà 106 | ;10€ or 10$ 107 | ;AAAAA 108 | ;Dark 109 | ;Hi.Hi.Hi.Hi. 110 | ;00Hey0 111 | ;0 112 | ;Hello 113 | ;Dark Vador 114 | -------------------------------------------------------------------------------- /unit-tests/procedure.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define (fact n) 31 | (if (or (= n 0) (= n 1)) 32 | 1 33 | (* n (fact (- n 1))))) 34 | 35 | (println (fact 10)) 36 | 37 | (define (fibo n) 38 | (if (or (= n 0) (= n 1)) 39 | n 40 | (+ (fibo (- n 1)) (fibo (- n 2))))) 41 | 42 | (println (fibo 35)) 43 | 44 | ;3628800 45 | ;9227465 46 | -------------------------------------------------------------------------------- /unit-tests/quote.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (println '()) 31 | (println (list? '())) 32 | (println (pair? '())) 33 | (println (length '())) 34 | 35 | (println '(1 #f 3)) 36 | (println (list? '(1 2 3))) 37 | (println (pair? '(1 2 3))) 38 | (println (length '(1 2 3))) 39 | 40 | (println '(10 20 (30 40) 50)) 41 | (println (list? '(10 20 (30 40) 50))) 42 | (println (pair? '(10 20 (30 40) 50))) 43 | (println (length '(10 20 (30 40) 50))) 44 | 45 | (println (null? (car (cdr '(1 () 3))))) 46 | 47 | (println '(1 . 2)) 48 | (println (list? '(1 . 2))) 49 | (println (pair? '(1 . 2))) 50 | 51 | (pp (vector-length '#(1 2 3))) 52 | (pp (vector? '#(1 2 3))) 53 | (pp '#(1 2 3)) 54 | (pp (vector-length '#("Hello" #\W #\o #\r #\l #\d))) 55 | (pp (vector? '#("Hello" #\W #\o #\r #\l #\d))) 56 | (pp '#("Hello" #\W #\o #\r #\l #\d)) 57 | 58 | ; 59 | ;#t 60 | ;#f 61 | ;0 62 | ;1#f3 63 | ;#t 64 | ;#t 65 | ;3 66 | ;1020304050 67 | ;#t 68 | ;#t 69 | ;4 70 | ;#t 71 | ;12 72 | ;#f 73 | ;#t 74 | ;3 75 | ;#t 76 | ;#(1 2 3) 77 | ;6 78 | ;#t 79 | ;#("Hello" #\W #\o #\r #\l #\d) 80 | -------------------------------------------------------------------------------- /unit-tests/symbol.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define sym 'TEST) 31 | 32 | (println (symbol? sym)) 33 | (println sym) 34 | (pp sym) 35 | 36 | (let* ((sym 'OTHER) 37 | (str (symbol->string sym))) 38 | (pp sym) 39 | (pp str)) 40 | 41 | (pp (string->symbol "Hello")) 42 | (pp (symbol->string 'World)) 43 | 44 | ;#t 45 | ;TEST 46 | ;TEST 47 | ;OTHER 48 | ;"OTHER" 49 | ;Hello 50 | ;"World" 51 | -------------------------------------------------------------------------------- /unit-tests/tail.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define (bar1 n) 31 | (if (= n 0) 32 | #t 33 | (bar1 (- n 1)))) 34 | 35 | (define (bar2 n) 36 | (if (= n 0) 37 | #t 38 | (begin 10 39 | (bar2 (- n 1))))) 40 | 41 | (define (foo1 n) 42 | (if (= n 0) 43 | #t 44 | (let ((a (- n 1))) 45 | 100 46 | (foo1 a)))) 47 | 48 | (define (foo2 n) 49 | (if (= n 0) 50 | #t 51 | (let* ((a (- n 1))) 52 | 100 53 | (foo2 a)))) 54 | 55 | (define (fun n) 56 | (if (= n 0) 57 | #t 58 | ((lambda () 100 (fun (- n 1)))))) 59 | 60 | (pp (bar1 999999)) 61 | (pp (bar2 999999)) 62 | (pp (foo1 999999)) 63 | (pp (foo2 999999)) 64 | (pp (fun 99999)) 65 | 66 | ;#t 67 | ;#t 68 | ;#t 69 | ;#t 70 | ;#t 71 | -------------------------------------------------------------------------------- /unit-tests/vectors.scm: -------------------------------------------------------------------------------- 1 | ;;--------------------------------------------------------------------------- 2 | ;; 3 | ;; Copyright (c) 2015, Baptiste Saleil. 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 7 | ;; met: 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer. 10 | ;; 2. Redistributions in binary form must reproduce the above copyright 11 | ;; notice, this list of conditions and the following disclaimer in the 12 | ;; documentation and/or other materials provided with the distribution. 13 | ;; 3. The name of the author may not be used to endorse or promote 14 | ;; products derived from this software without specific prior written 15 | ;; permission. 16 | ;; 17 | ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 18 | ;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 19 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN 20 | ;; NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | ;; NOT LIMITED TO PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | ;; 28 | ;;--------------------------------------------------------------------------- 29 | 30 | (define vect (make-vector 5)) 31 | 32 | (println (vector? vect)) 33 | (println vect) 34 | (println (vector-length vect)) 35 | 36 | (vector-set! vect 2 100) 37 | 38 | (println vect) 39 | (println (list? (vector->list vect))) 40 | (println (vector->list vect)) 41 | 42 | (vector-fill! vect #f) 43 | 44 | (println vect) 45 | 46 | (println (list->vector '(1 2 3 4))) 47 | (println (vector? (list->vector '(1 2 3 4)))) 48 | (println (vector-ref (list->vector '(1 2 3 4)) 0)) 49 | (println (vector-ref (list->vector '(1 2 3 4)) 1)) 50 | (println (vector-ref (list->vector '(1 2 3 4)) 2)) 51 | (println (vector-ref (list->vector '(1 2 3 4)) 3)) 52 | 53 | (println (make-vector 2 #f)) 54 | (pp (make-vector 2 #f)) 55 | 56 | (define a (vector)) 57 | (define b (vector 1)) 58 | (define c (vector 1 2)) 59 | (define d (vector 1 2 3 4 5)) 60 | 61 | (pp (list? a)) 62 | (pp (vector? a)) 63 | (pp a) 64 | 65 | (pp (list? b)) 66 | (pp (vector? b)) 67 | (pp b) 68 | 69 | (pp (list? c)) 70 | (pp (vector? c)) 71 | (pp c) 72 | 73 | (pp (list? d)) 74 | (pp (vector? d)) 75 | (pp d) 76 | 77 | (pp (make-vector 0)) 78 | (pp (make-vector 0 #t)) 79 | (pp (make-vector 1)) 80 | (pp (make-vector 1 #f)) 81 | (pp (make-vector 4)) 82 | (pp (make-vector 4 #f)) 83 | 84 | ;#t 85 | ;00000 86 | ;5 87 | ;0010000 88 | ;#t 89 | ;0010000 90 | ;#f#f#f#f#f 91 | ;1234 92 | ;#t 93 | ;1 94 | ;2 95 | ;3 96 | ;4 97 | ;#f#f 98 | ;#(#f #f) 99 | ;#f 100 | ;#t 101 | ;#() 102 | ;#f 103 | ;#t 104 | ;#(1) 105 | ;#f 106 | ;#t 107 | ;#(1 2) 108 | ;#f 109 | ;#t 110 | ;#(1 2 3 4 5) 111 | ;#() 112 | ;#() 113 | ;#(0) 114 | ;#(#f) 115 | ;#(0 0 0 0) 116 | ;#(#f #f #f #f) 117 | --------------------------------------------------------------------------------