├── .github └── workflows │ ├── dailyTests.yml │ ├── evaluation.yml │ └── testsOnAction.yml ├── .gitignore ├── .jvmopts ├── .scalafmt.conf ├── .travis.yml ├── README.md ├── build.sbt ├── code ├── js │ └── src │ │ └── main │ │ └── scala │ │ └── scalaam │ │ └── web │ │ ├── Main.scala │ │ ├── WebVisualisation.scala │ │ └── WebVisualisationAdaptiveAnalysis.scala ├── jvm │ └── src │ │ └── main │ │ └── scala │ │ └── scalaam │ │ └── cli │ │ ├── ScalaAM.scala │ │ └── experiments │ │ ├── Performance.scala │ │ ├── SchemeAnalyses.scala │ │ ├── incremental │ │ ├── IncrementalExperiment.scala │ │ ├── IncrementalPerformance.scala │ │ ├── IncrementalPrecision.scala │ │ ├── IncrementalProperties.scala │ │ └── RunIncrementalExperiments.scala │ │ ├── precision │ │ ├── AnalysisComparison.scala │ │ ├── DailyPrecisionBenchmarks.scala │ │ ├── PrecisionBenchmarks.scala │ │ └── PrimitivesPrecision.scala │ │ └── primitives │ │ ├── PerformanceCompoundPrecision.scala │ │ └── PerformanceTypeNonPreluded.scala └── shared │ └── src │ ├── main │ └── scala │ │ └── scalaam │ │ ├── bench │ │ └── scheme │ │ │ ├── IncrementalSchemeBenchmarkPrograms.scala │ │ │ └── SchemeBenchmarkPrograms.scala │ │ ├── core │ │ ├── Address.scala │ │ ├── Environment.scala │ │ ├── Error.scala │ │ ├── Expression.scala │ │ ├── Identity.scala │ │ ├── Lattice.scala │ │ ├── MayFail.scala │ │ ├── Primitive.scala │ │ ├── Store.scala │ │ └── WorkList.scala │ │ ├── language │ │ ├── CScheme │ │ │ ├── CSchemeCompiler.scala │ │ │ ├── CSchemeExp.scala │ │ │ ├── CSchemeLexicalAddresser.scala │ │ │ ├── CSchemeParser.scala │ │ │ ├── CSchemeUndefiner.scala │ │ │ └── TID.scala │ │ ├── change │ │ │ └── ChangeExp.scala │ │ ├── scheme │ │ │ ├── SchemeCompiler.scala │ │ │ ├── SchemeExp.scala │ │ │ ├── SchemeInterpreter.scala │ │ │ ├── SchemeLexicalAddresser.scala │ │ │ ├── SchemeLoader.scala │ │ │ ├── SchemeParser.scala │ │ │ ├── SchemeRenamer.scala │ │ │ ├── SchemeUndefiner.scala │ │ │ ├── lattices │ │ │ │ ├── ModularSchemeLattice.scala │ │ │ │ ├── SchemeLattice.scala │ │ │ │ ├── SchemeOps.scala │ │ │ │ └── SchemeTypeLattice.scala │ │ │ └── primitives │ │ │ │ ├── SchemeLatticePrimitives.scala │ │ │ │ ├── SchemePrelude.scala │ │ │ │ └── SchemePrimitives.scala │ │ └── sexp │ │ │ ├── SExp.scala │ │ │ └── SExpParser.scala │ │ ├── lattice │ │ ├── BoolLattice.scala │ │ ├── CharLattice.scala │ │ ├── ConcreteLattice.scala │ │ ├── ConstantPropagationLattice.scala │ │ ├── IntLattice.scala │ │ ├── MathOps.scala │ │ ├── RealLattice.scala │ │ ├── StringLattice.scala │ │ ├── SymbolLattice.scala │ │ └── TypeLattice.scala │ │ ├── modular │ │ ├── AbstractDomain.scala │ │ ├── DependencyTracking.scala │ │ ├── GlobalStore.scala │ │ ├── ModAnalysis.scala │ │ ├── ParallelWorklistAlgorithm.scala │ │ ├── ParallelWorklistAlgorithmActors.scala │ │ ├── ReturnValue.scala │ │ ├── SequentialWorklistAlgorithm.scala │ │ ├── adaptive │ │ │ ├── AdaptiveGlobalStore.scala │ │ │ ├── AdaptiveModAnalysis.scala │ │ │ └── scheme │ │ │ │ ├── AdaptiveCallerSensitivity.scala │ │ │ │ ├── AdaptiveSchemeModFSemantics.scala │ │ │ │ └── adaptiveArgumentSensitivity │ │ │ │ ├── AdaptiveArgumentSensitivity.scala │ │ │ │ ├── AdaptiveArgumentSensitivityPolicy1.scala │ │ │ │ ├── AdaptiveArgumentSensitivityPolicy2.scala │ │ │ │ └── AdaptiveArgumentSensitivityPolicy3.scala │ │ ├── components │ │ │ ├── ContextSensitiveComponents.scala │ │ │ ├── IndirectComponents.scala │ │ │ ├── Indirection.scala │ │ │ └── MutableIndirectComponents.scala │ │ ├── incremental │ │ │ ├── IncrementalModAnalysis.scala │ │ │ ├── old │ │ │ │ ├── IncrementalContextSensitiveComponents.scala │ │ │ │ ├── IncrementalGlobalStore.scala │ │ │ │ ├── IncrementalModAnalysisOld.scala │ │ │ │ ├── IncrementalReturnValue.scala │ │ │ │ ├── IncrementalSchemeComponents.scala │ │ │ │ └── IncrementalSchemeModFSemantics.scala │ │ │ └── scheme │ │ │ │ ├── AnalysisBuilder.scala │ │ │ │ ├── IncrementalSchemeSemantics.scala │ │ │ │ ├── modconc │ │ │ │ └── IncrementalSchemeModConcSmallStepSemantics.scala │ │ │ │ └── modf │ │ │ │ └── IncrementalSchemeModFBigStepSemantics.scala │ │ └── scheme │ │ │ ├── SchemeAddresses.scala │ │ │ ├── SchemeDomain.scala │ │ │ ├── SchemeSetup.scala │ │ │ ├── modconc │ │ │ ├── SchemeModConcAllocator.scala │ │ │ ├── SchemeModConcComponents.scala │ │ │ ├── SchemeModConcSemantics.scala │ │ │ └── SchemeModConcSensitivity.scala │ │ │ ├── modf │ │ │ ├── SchemeModFAllocator.scala │ │ │ ├── SchemeModFBigStepSemantics.scala │ │ │ ├── SchemeModFComponents.scala │ │ │ ├── SchemeModFSemantics.scala │ │ │ ├── SchemeModFSensitivity.scala │ │ │ └── SchemeModFSmallStepSemantics.scala │ │ │ └── ssmodconc │ │ │ └── SchemeModConcSmallStepSemantics.scala │ │ └── util │ │ ├── Annotations.scala │ │ ├── DisjointSet.scala │ │ ├── FileUtil.scala │ │ ├── Monoid.scala │ │ ├── PausableThreadPoolExecutor.java │ │ ├── Show.scala │ │ ├── SmartDatastructures.scala │ │ ├── SmartHash.scala │ │ ├── benchmarks │ │ ├── Statistics.scala │ │ ├── Table.scala │ │ └── TimeUtils.scala │ │ └── graph │ │ ├── Colors.scala │ │ ├── DotGraph.scala │ │ ├── Graph.scala │ │ ├── NoGraph.scala │ │ └── ReachableStatesConditionGraph.scala │ └── test │ └── scala │ └── scalaam │ └── test │ ├── SchemeBenchmarkTests.scala │ ├── SchemeBenchmarks.scala │ ├── SchemeR5RSBenchmarks.scala │ ├── TestTags.scala │ ├── language │ ├── scheme │ │ ├── ParserTests.scala │ │ ├── SchemeGenerators.scala │ │ ├── SchemeLatticeTests.scala │ │ └── SchemeR5RSTests.scala │ └── sexp │ │ ├── LexerTests.scala │ │ └── ParserTests.scala │ ├── lattice │ ├── Generators.scala │ └── LatticeTests.scala │ └── modular │ └── scheme │ ├── SchemeModConcSoundnessTests.scala │ ├── SchemeModFSoundnessTests.scala │ ├── SchemeSoundnessTests.scala │ └── incremental │ └── IncrementalModXSoundnessTests.scala ├── openJS.sh ├── project ├── build.properties └── plugins.sbt ├── scalaam.html └── test ├── DEBUG.scm ├── DEBUG2.scm ├── PossibleBenchmarks.txt ├── R5RS ├── SETL │ ├── setl-benchmarks │ │ └── arithmetic.scm │ ├── setl-interpreter.scm │ └── setl-programs │ │ ├── arithmetic.setl │ │ ├── assignvbpag5.setl │ │ ├── formers.setl │ │ ├── from.setl │ │ ├── functions.setl │ │ ├── procedures.setl │ │ ├── sequence.setl │ │ ├── sets.setl │ │ ├── test.setl │ │ ├── testcase1.setl │ │ ├── testcase2.setl │ │ ├── testcase3.setl │ │ ├── testif.setl │ │ ├── tupleconcat.setl │ │ └── tuples.setl ├── SICP-compiler.scm ├── Streams.scm ├── VUB-projects │ ├── frogger.scm │ ├── mountainvale.scm │ └── railway-control-system.scm ├── WeiChenRompf2019 │ ├── church_exp.sch │ ├── church_simple.sch │ ├── earley.sch │ ├── fermat.scm │ ├── kcfa-worst-case-16.scm │ ├── kcfa-worst-case-256.scm │ ├── kcfa-worst-case-32.scm │ ├── kcfa-worst-case-64.scm │ ├── kcfa3.scm │ ├── mbrotZ.sch │ ├── meta-circ.scm │ ├── omega.scm │ ├── regex-derivative.scm │ ├── rsa.scm │ ├── scheme2java.scm │ ├── solovay-strassen.scm │ ├── the-little-schemer │ │ ├── ch1.scm │ │ ├── ch10.scm │ │ ├── ch2.scm │ │ ├── ch3.scm │ │ ├── ch4.scm │ │ ├── ch5.scm │ │ ├── ch6.scm │ │ ├── ch7.scm │ │ ├── ch8.scm │ │ └── ch9.scm │ └── toplas98 │ │ ├── boyer.sch │ │ ├── dynamic.scm │ │ ├── graphs.scm │ │ ├── handle.scm │ │ ├── lattice-processed.scm │ │ ├── lattice.scm │ │ ├── maze.scm │ │ ├── nbody-processed.scm │ │ ├── nbody.scm │ │ ├── nucleic.sch │ │ ├── nucleic2.sch │ │ └── splay.scm ├── ad │ ├── RBtreeADT.scm │ ├── abstrct.scm │ ├── all.scm │ ├── bfirst.scm │ ├── bst.scm │ ├── btree.scm │ ├── bubsort.scm │ ├── dict.scm │ ├── heap.scm │ ├── inssort.scm │ ├── linear.scm │ ├── list.scm │ ├── mesort.scm │ ├── prioq.scm │ ├── qsort.scm │ ├── qstand.scm │ ├── queue.scm │ ├── quick.scm │ ├── selsort.scm │ ├── stack.scm │ └── stspaceCODE.scm ├── blur.scm ├── bound-precision.scm ├── callcc.scm ├── church-2-num.scm ├── church-6.scm ├── church.scm ├── collatz.scm ├── count.scm ├── eta.scm ├── example.scm ├── fact.scm ├── fib.scm ├── foo.scm ├── four-in-a-row.scm ├── gabriel │ ├── boyer.scm │ ├── browse.scm │ ├── cpstak.scm │ ├── dderiv.scm │ ├── deriv.scm │ ├── destruc.scm │ ├── diviter.scm │ ├── divrec.scm │ ├── puzzle.scm │ ├── takl.scm │ └── triangl.scm ├── gambit │ ├── array1.scm │ ├── browse.scm │ ├── cat.scm │ ├── compiler.scm │ ├── ctak.scm │ ├── deriv.scm │ ├── destruc.scm │ ├── diviter.scm │ ├── earley.scm │ ├── fibc.scm │ ├── graphs.scm │ ├── lattice.scm │ ├── matrix.scm │ ├── mazefun.scm │ ├── nboyer.scm │ ├── nqueens.scm │ ├── paraffins.scm │ ├── perm9.scm │ ├── peval.scm │ ├── primes.scm │ ├── puzzle.scm │ ├── sboyer.scm │ ├── scheme.scm │ ├── slatex.scm │ ├── string.scm │ ├── sum.scm │ ├── sumloop.scm │ ├── tail.scm │ ├── tak.scm │ ├── trav1.scm │ ├── triangl.scm │ └── wc.scm ├── gcipd.scm ├── github │ └── google-schism.scm ├── grid.scm ├── icp │ ├── icp_1c_ambeval.scm │ ├── icp_1c_multiple-dwelling.scm │ ├── icp_1c_ontleed.scm │ ├── icp_1c_prime-sum-pair.scm │ ├── icp_2_aeval.scm │ ├── icp_3_leval.scm │ ├── icp_4_qeval.scm │ ├── icp_5_regsim.scm │ ├── icp_6_stopandcopy_scheme.scm │ ├── icp_7_eceval.scm │ └── icp_8_compiler.scm ├── inc.scm ├── infinite-1.scm ├── infinite-2.scm ├── infinite-3.scm ├── kcfa2.scm ├── kcfa3.scm ├── kernighanvanwyk │ └── ack.scm ├── letrec-begin.scm ├── loop2.scm ├── mceval.scm ├── mj09.scm ├── mut-rec.scm ├── my-list.scm ├── my-test.scm ├── nested-defines.scm ├── pico.scm ├── primtest.scm ├── quasiquoting-simple.scm ├── quasiquoting.scm ├── regex.scm ├── rosetta │ ├── easter.scm │ └── quadratic.scm ├── rotate.scm ├── rsa.scm ├── sat.scm ├── scm2c.scm ├── scm2java.scm ├── scp1-compressed │ ├── 2.scm │ ├── 3.scm │ ├── 4.scm │ ├── 5.scm │ ├── 7.scm │ ├── 8.scm │ ├── 9.scm │ └── all.scm ├── scp1 │ ├── add-to-end.scm │ ├── addition.scm │ ├── all-but-interval.scm │ ├── animal-classification.scm │ ├── append.scm │ ├── apple-tree.scm │ ├── calc-e-and-cos.scm │ ├── car-counter.scm │ ├── cashdesk-counter.scm │ ├── circus.scm │ ├── coca-cola.scm │ ├── compress-measurements.scm │ ├── count-pairs.scm │ ├── count-pairs2.scm │ ├── count-tree.scm │ ├── counter.scm │ ├── dedouble.scm │ ├── deep-map-combine.scm │ ├── draw-umbrella.scm │ ├── family-budget.scm │ ├── fast-multiply.scm │ ├── find-cycles.scm │ ├── fireworks.scm │ ├── flatten.scm │ ├── flip.scm │ ├── flip2.scm │ ├── fringe.scm │ ├── grades.scm │ ├── haha.scm │ ├── insert.scm │ ├── josephus-problem.scm │ ├── leap-year.scm │ ├── lightbulb.scm │ ├── list-compare-n.scm │ ├── merge.scm │ ├── multiply.scm │ ├── organigram.scm │ ├── parking-counter.scm │ ├── polynome.scm │ ├── print-abc.scm │ ├── ring-copy.scm │ ├── ring-rotate.scm │ ├── ring-squares.scm │ ├── ring.scm │ ├── sales-period.scm │ ├── same-structure.scm │ ├── scoreboard.scm │ ├── sim-fast-multiply.scm │ ├── simpson-integral.scm │ ├── slide-in.scm │ ├── square-and-rectangle.scm │ ├── super-list-merge-n.scm │ ├── third-root.scm │ ├── tree-with-branches.scm │ ├── twitter.scm │ ├── unfringe.scm │ ├── university.scm │ └── weird.scm ├── sigscheme │ ├── arithint.scm │ ├── case.scm │ ├── let-loop.scm │ ├── loop.scm │ ├── mem.scm │ ├── rec.scm │ └── takr.scm ├── splitargs.scm ├── sq.scm ├── sym.scm ├── test.scm ├── widen.scm └── work.scm ├── README.md ├── changes ├── README.md ├── cscheme │ └── threads │ │ ├── SICP-compiler.scm │ │ ├── actors.scm │ │ ├── crypt.scm │ │ ├── crypt2.scm │ │ ├── lastzero.scm │ │ ├── mcarlo.scm │ │ ├── mcarlo2.scm │ │ ├── msort.scm │ │ ├── pc.scm │ │ ├── pps.scm │ │ ├── puzzle.scm │ │ ├── stm.scm │ │ └── sudoku.scm └── scheme │ ├── baseline.scm │ ├── collatz.scm │ ├── fact.scm │ ├── fib.scm │ ├── gcipd.scm │ ├── icp_1c_multiple-dwelling-coarse.scm │ ├── icp_1c_multiple-dwelling-fine.scm │ ├── icp_3_leval_ex_5.scm │ ├── icp_4_qeval_nodup.scm │ ├── icp_7_8_open_coded.scm │ ├── mceval-dynamic.scm │ ├── nboyer.scm │ ├── peval.scm │ ├── primtest.scm │ ├── ring-rotate.scm │ ├── sat.scm │ ├── satCoarse.scm │ ├── satFine.scm │ ├── satMiddle.scm │ ├── satRem.scm │ └── scheme.scm ├── changesBenevolPaper ├── baseline-1.scm ├── baseline-2.scm ├── church-2-num-1.scm ├── church-2-num-2.scm ├── collatz-1.scm ├── collatz-2.scm ├── collatzBounded0-1.scm ├── collatzBounded0-2.scm ├── countA-1.scm ├── countA-2.scm ├── countB-1.scm ├── countB-2.scm ├── countC-1.scm ├── countC-2.scm ├── countD-1.scm ├── countD-2.scm ├── eta-1.scm ├── eta-2.scm ├── f1-tests │ ├── f-0.scm │ ├── f-1.scm │ ├── f-10.scm │ ├── f-11.scm │ ├── f-12.scm │ ├── f-13.scm │ ├── f-14.scm │ ├── f-15.scm │ ├── f-16.scm │ ├── f-17.scm │ ├── f-18.scm │ ├── f-19.scm │ ├── f-2.scm │ ├── f-20.scm │ ├── f-3.scm │ ├── f-4.scm │ ├── f-5.scm │ ├── f-6.scm │ ├── f-7.scm │ ├── f-8.scm │ ├── f-9.scm │ ├── f-base.scm │ └── generator.rkt ├── fAdd-1.scm ├── fAdd-2.scm ├── fPerm-1.scm ├── fPerm-2.scm ├── fRem-1.scm ├── fRem-2.scm ├── fact-1.scm ├── fact-2.scm ├── factInp-1.scm ├── factInp-2.scm ├── fib-1.scm ├── fib-2.scm ├── gcipd-1.scm ├── gcipd-2.scm ├── hanoi-1.scm ├── hanoi-2.scm ├── partialsums-1.scm ├── partialsums-2.scm ├── partialsums-3.scm ├── partialsums │ ├── partialsums-1.scm │ ├── partialsums-2.scm │ ├── partialsums-3.scm │ ├── partialsums-4.scm │ └── partialsums-5.scm ├── primtest-1.scm ├── primtest-2.scm ├── rotateA-1.scm ├── rotateA-2.scm ├── rotateB-1.scm ├── rotateB-2.scm ├── sat-1.scm ├── sat-2.scm ├── sat │ ├── satAdd-1.scm │ ├── satAdd-2.scm │ ├── satAlias-1.scm │ ├── satAlias-2.scm │ ├── satOther1-1.scm │ ├── satOther1-2.scm │ ├── satOther2-1.scm │ ├── satOther2-2.scm │ ├── satPerm-1.scm │ ├── satPerm-2.scm │ ├── satRem-1.scm │ ├── satRem-2.scm │ ├── satRename-1.scm │ └── satRename-2.scm ├── var-1.scm └── var-2.scm └── concurrentScheme ├── actors ├── cell.scm ├── check.scm ├── factorial.scm ├── savina │ ├── big.scm │ ├── cham.scm │ ├── count-seq.scm │ ├── count.scm │ ├── fjc-seq.scm │ ├── fjc.scm │ ├── fjt-seq.scm │ ├── fjt-seq2.scm │ ├── fjt.scm │ ├── phil.scm │ ├── pp.scm │ ├── thr-seq.scm │ └── thr.scm ├── soter │ ├── concdb.scm │ ├── parikh.scm │ ├── pipe-seq.scm │ ├── pipe.scm │ ├── safe_send.scm │ ├── state_factory.scm │ ├── stutter.scm │ └── unsafe_send.scm └── stack.scm ├── futures ├── abp.scm ├── actors.scm ├── atoms.scm ├── bchain.scm ├── count.scm ├── crypt.scm ├── dekker.scm ├── fact-indep.scm ├── fact.scm ├── fact2.scm ├── lastzero2.scm ├── life.scm ├── list-with-length.scm ├── matmul.scm ├── mcarlo.scm ├── mceval.scm ├── minimax.scm ├── msort.scm ├── nbody.scm ├── pc.scm ├── phil.scm ├── phild.scm ├── pp.scm ├── pps.scm ├── qsort.scm ├── readers2.scm ├── ringbuf.scm ├── rng.scm ├── sieve.scm ├── simple.scm ├── stm.scm ├── sudoku.scm ├── trapr.scm ├── treiber-stack.scm ├── tsp.scm └── variations │ ├── count10.scm │ ├── count11.scm │ ├── count12.scm │ ├── count13.scm │ ├── count14.scm │ ├── count15.scm │ ├── count2.scm │ ├── count3.scm │ ├── count4.scm │ ├── count5.scm │ ├── count6.scm │ ├── count7.scm │ ├── count8.scm │ ├── count9.scm │ ├── indexer10.scm │ ├── indexer11.scm │ ├── indexer12.scm │ ├── indexer13.scm │ ├── indexer14.scm │ ├── indexer15.scm │ ├── indexer2.scm │ ├── indexer3.scm │ ├── indexer4.scm │ ├── indexer5.scm │ ├── indexer6.scm │ ├── indexer7.scm │ ├── indexer8.scm │ ├── indexer9.scm │ ├── mutex2.scm │ ├── mutex3.scm │ ├── mutex4.scm │ ├── mutex5.scm │ ├── mutex6.scm │ ├── pcounter10.scm │ ├── pcounter11.scm │ ├── pcounter12.scm │ ├── pcounter13.scm │ ├── pcounter14.scm │ ├── pcounter15.scm │ ├── pcounter2.scm │ ├── pcounter3.scm │ ├── pcounter4.scm │ ├── pcounter5.scm │ ├── pcounter6.scm │ ├── pcounter7.scm │ ├── pcounter8.scm │ ├── pcounter9.scm │ ├── race2.scm │ ├── race3.scm │ ├── race4.scm │ ├── race5.scm │ └── race6.scm └── threads ├── abp.scm ├── actors.scm ├── atoms.scm ├── bchain.scm ├── count.scm ├── crypt.scm ├── dekker.scm ├── fact-indep.scm ├── fact.scm ├── fact2.scm ├── infinite-threads.scm ├── lastzero2.scm ├── life.scm ├── matmul.scm ├── mcarlo.scm ├── mceval.scm ├── minimax.scm ├── msort.scm ├── nbody.scm ├── pc.scm ├── peterson.scm ├── phil.scm ├── phild.scm ├── philosophers2.scm ├── pp.scm ├── pps.scm ├── producer.scm ├── qsort.scm ├── randomness.scm ├── randomness2.scm ├── readers2.scm ├── ringbuf.scm ├── rng.scm ├── sieve.scm ├── simple.scm ├── stm.scm ├── sudoku.scm ├── trapr.scm ├── tsp.scm └── variations ├── count10.scm ├── count11.scm ├── count12.scm ├── count13.scm ├── count14.scm ├── count15.scm ├── count2.scm ├── count3.scm ├── count4.scm ├── count5.scm ├── count6.scm ├── count7.scm ├── count8.scm ├── count9.scm ├── fs10.scm ├── fs11.scm ├── fs12.scm ├── fs13.scm ├── fs14.scm ├── fs15.scm ├── fs2.scm ├── fs3.scm ├── fs4.scm ├── fs5.scm ├── fs6.scm ├── fs7.scm ├── fs8.scm ├── fs9.scm ├── incdec2.scm ├── incdec3.scm ├── incdec4.scm ├── incdec5.scm ├── incdec6.scm ├── indexer10.scm ├── indexer11.scm ├── indexer12.scm ├── indexer13.scm ├── indexer14.scm ├── indexer15.scm ├── indexer2.scm ├── indexer3.scm ├── indexer4.scm ├── indexer5.scm ├── indexer6.scm ├── indexer7.scm ├── indexer8.scm ├── indexer9.scm ├── mutex2.scm ├── mutex3.scm ├── mutex4.scm ├── mutex5.scm ├── mutex6.scm ├── pcounter10.scm ├── pcounter11.scm ├── pcounter12.scm ├── pcounter13.scm ├── pcounter14.scm ├── pcounter15.scm ├── pcounter2.scm ├── pcounter3.scm ├── pcounter4.scm ├── pcounter5.scm ├── pcounter6.scm ├── pcounter7.scm ├── pcounter8.scm ├── pcounter9.scm ├── philosophers3.scm ├── philosophers4.scm ├── philosophers5.scm ├── philosophers6.scm ├── race2.scm ├── race3.scm ├── race4.scm ├── race5.scm └── race6.scm /.github/workflows/testsOnAction.yml: -------------------------------------------------------------------------------- 1 | name: Scala-AM tests on action 2 | 3 | # Controls when the action will run. Triggers the workflow on push or pull request 4 | # events but only for the master branch 5 | on: 6 | push: 7 | branches: [ master ] 8 | pull_request: 9 | branches: [ master ] 10 | 11 | jobs: 12 | # The compile job fetches the code and attempts to compile it. 13 | build: 14 | name: Compile Scala-AM 15 | runs-on: ubuntu-latest 16 | steps: 17 | - name: Checkout the repository 18 | uses: actions/checkout@v2 19 | - name: Compile Scala-AM 20 | uses: lokkju/github-action-sbt@v0.2.2 21 | with: 22 | commands: compile 23 | - name: Run the tests 24 | uses: lokkju/github-action-sbt@v0.2.2 25 | with: 26 | commands: scalaam/testOnly -- -l SlowTest -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /testOutput/ 2 | /benchOutput/ 3 | /.d8_history 4 | /.ensime 5 | /.metals 6 | /TODO.org 7 | *target/ 8 | /project/project 9 | /project/.bloop 10 | /project/metals.sbt 11 | /.bloop 12 | .ensime_cache 13 | *.dot 14 | *.log 15 | .idea/ 16 | .DS_Store 17 | /target/ 18 | *.csv 19 | *.png 20 | *.svg 21 | /.idea 22 | *.diff 23 | /.vscode 24 | -------------------------------------------------------------------------------- /.jvmopts: -------------------------------------------------------------------------------- 1 | -Xms1024M 2 | -Xmx4096M 3 | -Xss128M 4 | -XX:MaxMetaspaceSize=2048M 5 | -------------------------------------------------------------------------------- /.scalafmt.conf: -------------------------------------------------------------------------------- 1 | align = true 2 | maxColumn = 100 3 | version=2.0.0-RC8 -------------------------------------------------------------------------------- /code/jvm/src/main/scala/scalaam/cli/experiments/incremental/RunIncrementalExperiments.scala: -------------------------------------------------------------------------------- 1 | package scalaam.cli.experiments.incremental 2 | 3 | object RunIncrementalExperiments { 4 | def main(args: Array[String]): Unit = { 5 | IncrementalSchemeModXPerformance.main(args) 6 | IncrementalSchemeModXPrecision.main(args) 7 | IncrementalSchemeModXProperties.main(args) 8 | } 9 | } -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/bench/scheme/IncrementalSchemeBenchmarkPrograms.scala: -------------------------------------------------------------------------------- 1 | package scalaam.bench.scheme 2 | 3 | object IncrementalSchemeBenchmarkPrograms { 4 | lazy val threads: Set[String] = SchemeBenchmarkPrograms.fromFolder("test/changes/cscheme/threads", 5 | "puzzle.scm", // Needs call-with-current-continuation. 6 | ".DS_Store", 7 | ) 8 | lazy val concurrent: Set[String] = threads 9 | lazy val sequential: Set[String] = SchemeBenchmarkPrograms.fromFolder("test/changes/scheme", 10 | "icp_4_qeval_nodup.scm", // define-syntax, force, delay 11 | "scheme.scm", // error in program 12 | ".DS_Store", 13 | ) 14 | } -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/core/Address.scala: -------------------------------------------------------------------------------- 1 | package scalaam.core 2 | 3 | import scalaam.util.SmartHash 4 | 5 | /** An address */ 6 | trait Address extends SmartHash { 7 | 8 | /** Should the address be included when printing an environment or store? 9 | * This allows to reduce the size of the printed environment/store. 10 | * Address that are not printable may for example include addresses of primitive functions. 11 | */ 12 | def printable: Boolean 13 | 14 | /** The identity of an address * 15 | * Should correspond to the program location where the address was allocated * 16 | * Can be Identity.none if there is no sensible program location (e.g., pre-allocated addresses for primitives) 17 | */ 18 | def idn: Identity 19 | } 20 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/core/Error.scala: -------------------------------------------------------------------------------- 1 | package scalaam.core 2 | 3 | /** An error that is not thrown but rather used as an erroneous value */ 4 | trait Error 5 | //case class ArityError[C](call: C, expected: Int, got: Int) extends Error 6 | //case class NotSupported(message: String) extends Error 7 | case class OperatorNotApplicable[V](operator: String, arguments: List[V]) extends Error 8 | case class TypeError[V](message: String, on: V) extends Error 9 | case class InvalidRelease[V](message: String, on: V) extends Error 10 | 11 | /** An error that is thrown as an exception */ 12 | trait ScalaAMException extends Throwable 13 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/core/Primitive.scala: -------------------------------------------------------------------------------- 1 | package scalaam.core 2 | 3 | trait Primitive { 4 | def name: String 5 | } 6 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/language/CScheme/CSchemeExp.scala: -------------------------------------------------------------------------------- 1 | package scalaam.language.CScheme 2 | 3 | import scalaam.core.{Expression, Identity, Label} 4 | import scalaam.language.scheme.SchemeExp 5 | 6 | trait CSchemeExp extends SchemeExp 7 | 8 | case object FRK extends Label // Fork 9 | case object JOI extends Label // Join 10 | 11 | /** Fork a thread with an expression to evaluate. */ 12 | case class CSchemeFork(body: SchemeExp, idn: Identity) extends CSchemeExp { 13 | def fv: Set[String] = body.fv 14 | def label: Label = FRK 15 | def subexpressions: List[Expression] = List(body) 16 | override val height: Int = body.height + 1 17 | } 18 | 19 | /** Join a thread, given an expression that should evaluate to a TID. */ 20 | case class CSchemeJoin(tExp: SchemeExp, idn: Identity) extends CSchemeExp { 21 | def fv: Set[String] = tExp.fv 22 | def label: Label = JOI 23 | def subexpressions: List[Expression] = List(tExp) 24 | override val height: Int = tExp.height + 1 25 | } -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/language/CScheme/CSchemeLexicalAddresser.scala: -------------------------------------------------------------------------------- 1 | package scalaam.language.CScheme 2 | 3 | import scalaam.language.scheme._ 4 | 5 | object CSchemeLexicalAddresser extends BaseSchemeLexicalAddresser { 6 | 7 | override def translate(exp: SchemeExp, scope: CSchemeLexicalAddresser.Scope): SchemeExp = exp match { 8 | case CSchemeFork(exp, idn) => CSchemeFork(translate(exp, scope), idn) 9 | case CSchemeJoin(exp, idn) => CSchemeJoin(translate(exp, scope), idn) 10 | 11 | case SchemeCodeChange(old, nw, idn) => SchemeCodeChange(translate(old, scope), translate(nw, scope), idn) 12 | 13 | case _ => super.translate(exp, scope) 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/language/CScheme/CSchemeUndefiner.scala: -------------------------------------------------------------------------------- 1 | package scalaam.language.CScheme 2 | 3 | import scalaam.language.scheme._ 4 | 5 | object CSchemeUndefiner extends BaseSchemeUndefiner { 6 | import scala.util.control.TailCalls._ 7 | 8 | override def undefineExp(exp: SchemeExp): TailRec[SchemeExp] = exp match { 9 | case CSchemeFork(body, idn) => tailcall(undefine1(body)).map( CSchemeFork(_, idn)) 10 | case CSchemeJoin(body, idn) => tailcall(undefine1(body)).map( CSchemeJoin(_, idn)) 11 | 12 | case SchemeCodeChange(old, nw, idn) => tailcall(undefine1(old)).flatMap(oldu => tailcall(undefine1(nw)).map(newu => SchemeCodeChange(oldu, newu, idn))) 13 | 14 | case _ => super.undefineExp(exp) 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/language/CScheme/TID.scala: -------------------------------------------------------------------------------- 1 | package scalaam.language.CScheme 2 | 3 | import scalaam.util.SmartHash 4 | 5 | /** Thread identifiers */ 6 | trait TID extends SmartHash -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/language/change/ChangeExp.scala: -------------------------------------------------------------------------------- 1 | package scalaam.language.change 2 | 3 | import scalaam.core._ 4 | 5 | case object CHA extends Label // Code change 6 | 7 | trait ChangeExp[Expr <: Expression] extends Expression { 8 | val old: Expr 9 | val nw: Expr 10 | val idn: Identity 11 | 12 | def fv: Set[String] = old.fv ++ nw.fv 13 | def label: Label = CHA 14 | def subexpressions: List[Expression] = List(old, nw) 15 | override val height: Int = Math.max(old.height, nw.height) + 1 16 | } 17 | 18 | object CodeVersion extends Enumeration { 19 | type Version = Value 20 | val Old, New = Value 21 | } -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/language/scheme/SchemeParser.scala: -------------------------------------------------------------------------------- 1 | package scalaam.language.scheme 2 | 3 | import scalaam.core.Position._ 4 | import scalaam.language.sexp._ 5 | 6 | object SchemeParser { 7 | 8 | /** 9 | * Compiles a s-expression into a scheme expression 10 | */ 11 | def compile(exp: SExp): SchemeExp = SchemeCompiler.compile(exp) 12 | 13 | /** 14 | * Performs alpha-renaming to ensure that every variable has a unique name 15 | */ 16 | def rename(exp: SchemeExp): SchemeExp = SchemeRenamer.rename(exp) 17 | 18 | /** 19 | * Replace defines in a program (a list of expressions) by a big letrec as a single expression 20 | */ 21 | def undefine(exps: List[SchemeExp]): SchemeExp = SchemeUndefiner.undefine(exps) 22 | 23 | /** 24 | * Parse a string representing a Scheme program 25 | */ 26 | def parse(s: String, tag: PTag = noTag): SchemeExp = SchemeBody(SExpParser.parse(s, tag).map(compile)) 27 | } 28 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/lattice/BoolLattice.scala: -------------------------------------------------------------------------------- 1 | package scalaam.lattice 2 | 3 | import scalaam.core.Lattice 4 | 5 | /** A lattice for booleans */ 6 | trait BoolLattice[B] extends Lattice[B] { 7 | def inject(b: Boolean): B 8 | def isTrue(b: B): Boolean 9 | def isFalse(b: B): Boolean 10 | def not(b: B): B 11 | def top: B 12 | } 13 | 14 | object BoolLattice { 15 | def apply[B: BoolLattice]: BoolLattice[B] = implicitly 16 | } 17 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/lattice/CharLattice.scala: -------------------------------------------------------------------------------- 1 | package scalaam.lattice 2 | 3 | import scalaam.core.Lattice 4 | 5 | /** A scalaam.lattice for characters */ 6 | trait CharLattice[C] extends Lattice[C] { 7 | def inject(c: Char): C 8 | def downCase(c: C): C 9 | def upCase(c: C): C 10 | def toInt[I: IntLattice](c: C): I 11 | def toString[S: StringLattice](c: C): S 12 | 13 | def isLower[B: BoolLattice](c: C): B 14 | def isUpper[B: BoolLattice](c: C): B 15 | 16 | def charEq[B: BoolLattice](c1: C, c2: C): B 17 | def charLt[B: BoolLattice](c1: C, c2: C): B 18 | 19 | def charEqCI[B: BoolLattice](c1: C, c2: C): B 20 | def charLtCI[B: BoolLattice](c1: C, c2: C): B 21 | } 22 | 23 | object CharLattice { 24 | def apply[C: CharLattice]: CharLattice[C] = implicitly 25 | } 26 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/lattice/IntLattice.scala: -------------------------------------------------------------------------------- 1 | package scalaam.lattice 2 | 3 | import scalaam.core.Lattice 4 | 5 | /** A scalaam.lattice for integers */ 6 | trait IntLattice[I] extends Lattice[I] { self => 7 | def inject(n: Int): I 8 | def toReal[R: RealLattice](n: I): R 9 | def random(n: I): I 10 | def plus(n1: I, n2: I): I 11 | def minus(n1: I, n2: I): I 12 | def times(n1: I, n2: I): I 13 | def quotient(n1: I, n2: I): I 14 | def div[R: RealLattice](n1: I, n2: I): R 15 | def expt(n1: I, n2: I): I 16 | def modulo(n1: I, n2: I): I 17 | def remainder(n1: I, n2: I): I 18 | def lt[B: BoolLattice](n1: I, n2: I): B 19 | def valuesBetween(n1: I, n2: I): Set[I] 20 | def toString[S: StringLattice](n: I): S 21 | def toChar[C: CharLattice](n: I): C 22 | } 23 | 24 | object IntLattice { 25 | def apply[I: IntLattice]: IntLattice[I] = implicitly 26 | } 27 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/lattice/RealLattice.scala: -------------------------------------------------------------------------------- 1 | package scalaam.lattice 2 | 3 | import scalaam.core.Lattice 4 | 5 | /** A lattice for reals (i.e., floating point numbers) */ 6 | trait RealLattice[R] extends Lattice[R] { self => 7 | def inject(n: Double): R 8 | def toInt[I: IntLattice](n: R): I 9 | def ceiling(n: R): R 10 | def floor(n: R): R 11 | def round(n: R): R 12 | def log(n: R): R 13 | def random(n: R): R 14 | def sin(n: R): R 15 | def asin(n: R): R 16 | def cos(n: R): R 17 | def acos(n: R): R 18 | def tan(n: R): R 19 | def atan(n: R): R 20 | def sqrt(n: R): R 21 | def plus(n1: R, n2: R): R 22 | def minus(n1: R, n2: R): R 23 | def times(n1: R, n2: R): R 24 | def div(n1: R, n2: R): R 25 | def expt(n1: R, n2: R): R 26 | def lt[B: BoolLattice](n1: R, n2: R): B 27 | def toString[S: StringLattice](n: R): S 28 | } 29 | 30 | object RealLattice { 31 | def apply[R: RealLattice]: RealLattice[R] = implicitly 32 | } 33 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/lattice/StringLattice.scala: -------------------------------------------------------------------------------- 1 | package scalaam.lattice 2 | 3 | import scalaam.core._ 4 | 5 | case object NotANumberString extends Error 6 | 7 | /** A scalaam.lattice for strings */ 8 | trait StringLattice[S] extends Lattice[S] { 9 | def inject(s: String): S 10 | def length[I: IntLattice](s: S): I 11 | def append(s1: S, s2: S): S 12 | def ref[I: IntLattice, C: CharLattice](s: S, i: I): C 13 | def lt[B: BoolLattice](s1: S, s2: S): B 14 | def toSymbol[Sym: SymbolLattice](s: S): Sym 15 | def toNumber[I: IntLattice](s: S): MayFail[I, Error] 16 | } 17 | 18 | object StringLattice { 19 | def apply[S: StringLattice]: StringLattice[S] = implicitly 20 | } 21 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/lattice/SymbolLattice.scala: -------------------------------------------------------------------------------- 1 | package scalaam.lattice 2 | 3 | import scalaam.core.Lattice 4 | 5 | /** A scalaam.lattice for symbols */ 6 | trait SymbolLattice[Sym] extends Lattice[Sym] { 7 | def inject(sym: String): Sym 8 | def toString[S: StringLattice](n: Sym): S 9 | } 10 | 11 | object SymbolLattice { 12 | def apply[Sym: SymbolLattice]: SymbolLattice[Sym] = implicitly 13 | 14 | } 15 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/AbstractDomain.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular 2 | 3 | import scalaam.core._ 4 | 5 | trait AbstractDomain[Expr <: Expression] extends ModAnalysis[Expr] { 6 | type Value 7 | implicit val lattice: Lattice[Value] 8 | } 9 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/DependencyTracking.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular 2 | 3 | import scalaam.core._ 4 | 5 | // A common, but optional extension to ModAnalysis 6 | // Specifically, it keeps track of: 7 | // - which components have spawned which other components 8 | // - which components have been spawned by the last intra-analysis 9 | trait DependencyTracking[Expr <: Expression] extends ModAnalysis[Expr] { inter => 10 | var dependencies = Map[Component,Set[Component]]().withDefaultValue(Set.empty) 11 | var newComponents = Set[Component]() 12 | // update some rudimentary analysis results 13 | //override def intraAnalysis(component: Component): DependencyTrackingIntra 14 | trait DependencyTrackingIntra extends IntraAnalysis { 15 | val visited = inter.visited 16 | override def commit(): Unit = { 17 | super.commit() 18 | // update the bookkeeping 19 | newComponents = C.filterNot(visited) 20 | dependencies += component -> (dependencies(component) ++ C) 21 | } 22 | } 23 | } -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/adaptive/scheme/adaptiveArgumentSensitivity/AdaptiveArgumentSensitivityPolicy1.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular.adaptive.scheme.adaptiveArgumentSensitivity 2 | 3 | import scalaam.modular.scheme.modf._ 4 | 5 | trait AdaptiveArgumentSensitivityPolicy1 extends AdaptiveArgumentSensitivity { 6 | // parameterized by a simple limit 7 | // every closure can only have at most "limit" components 8 | val limit: Int 9 | override def onNewComponent(cmp: Component, call: Call[ComponentContext]) = { 10 | super.onNewComponent(cmp, call) 11 | // if there are too many components => do something about it! 12 | val cmps = cmpsPerFn(call.clo._1) 13 | if (limit < cmps.size) { 14 | joinComponents(cmps) 15 | } 16 | } 17 | } -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/adaptive/scheme/adaptiveArgumentSensitivity/AdaptiveArgumentSensitivityPolicy2.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular.adaptive.scheme.adaptiveArgumentSensitivity 2 | 3 | trait AdaptiveArgumentSensitivityPolicy2 extends AdaptiveArgumentSensitivity { 4 | // parameterized by a simple budget 5 | // the analysis can have at most "budget" components at any time 6 | val budget: Int 7 | override def adaptAnalysis() = { 8 | super.adaptAnalysis() 9 | // if the budged is exceeded, adapt the analysis until the budget is satisfied 10 | if (visited.size > budget) { 11 | val cmps = cmpsPerFn.maxBy(_._2.size)._2 12 | joinComponents(cmps) 13 | } 14 | } 15 | } -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/components/ContextSensitiveComponents.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular.components 2 | 3 | import scalaam.core.Expression 4 | import scalaam.modular.ModAnalysis 5 | 6 | trait ContextSensitiveComponents[Expr <: Expression] extends ModAnalysis[Expr] { 7 | 8 | /** Components that consist out of some content + some optional context */ 9 | type ComponentContent 10 | type ComponentContext 11 | def content(cmp: Component): ComponentContent 12 | def context(cmp: Component): Option[ComponentContext] 13 | } 14 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/incremental/old/IncrementalContextSensitiveComponents.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular.incremental.scheme 2 | 3 | // import scalaam.core.Expression 4 | // import scalaam.modular.components.ContextSensitiveComponents 5 | // import scalaam.modular.incremental.IncrementalModAnalysis 6 | 7 | /* 8 | trait IncrementalContextSensitiveComponents [Expr <: Expression] extends IncrementalModAnalysis[Expr] with ContextSensitiveComponents[Expr] { 9 | 10 | def updateComponentContext(ctx: ComponentContext): ComponentContext 11 | } 12 | */ -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/incremental/old/IncrementalReturnValue.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular.incremental 2 | 3 | /* 4 | import scalaam.core.Expression 5 | import scalaam.modular.ReturnValue 6 | 7 | trait IncrementalReturnValue[Expr <: Expression] extends IncrementalGlobalStore[Expr] with ReturnValue[Expr] { 8 | 9 | /* Simple: since an indirection is used for components, the return addresses should not be updated since the pointers in the addresses remain valid. 10 | override def updateIdentities(newIdentities: Map[Identity, Option[Identity]]): Unit = { 11 | super.updateIdentities(newIdentities) 12 | 13 | // Update the identities in all return addresses within the store. 14 | ??? 15 | } 16 | */ 17 | 18 | } 19 | */ -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/incremental/old/IncrementalSchemeComponents.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular.incremental.scheme 2 | 3 | // import scalaam.modular.incremental.scheme.IncrementalSchemeModFSemantics 4 | 5 | /* 6 | trait IncrementalSchemeComponents extends IncrementalSchemeModFSemantics { 7 | 8 | } 9 | */ -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/incremental/scheme/IncrementalSchemeSemantics.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular.incremental.scheme 2 | 3 | import scalaam.language.scheme._ 4 | import scalaam.modular.incremental.IncrementalModAnalysis 5 | 6 | trait IncrementalSchemeSemantics extends IncrementalModAnalysis[SchemeExp] 7 | 8 | 9 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/scheme/SchemeAddresses.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular.scheme 2 | 3 | import scalaam.core._ 4 | import scalaam.language.scheme._ 5 | 6 | trait SchemeAddr[+Context] extends Address 7 | case class VarAddr[Context](id: Identifier, ctx: Context) extends SchemeAddr[Context] { def printable = true; def idn: Identity = id.idn; override def toString: String = s"var ($id)" } 8 | case class PtrAddr[Context](exp: SchemeExp, ctx: Context) extends SchemeAddr[Context] { def printable = false; def idn: Identity = exp.idn; override def toString: String = s"ptr (${exp.idn})" } 9 | case class PrmAddr(nam: String) extends SchemeAddr[Nothing] { def printable = false; def idn: Identity = Identity.none; override def toString: String = s"prm ($nam)" } 10 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/scheme/modconc/SchemeModConcAllocator.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular.scheme.modconc 2 | 3 | import scalaam.core._ 4 | import scalaam.modular.scheme._ 5 | import scalaam.modular.scheme.modf._ 6 | import scalaam.language.scheme._ 7 | 8 | trait StandardSchemeModConcAllocator extends SchemeModConcSemantics { 9 | type AllocationContext = SchemeModFComponent 10 | def allocVar(id: Identifier, modfCmp: SchemeModFComponent, cmp: Component) = VarAddr(id,modfCmp) 11 | def allocPtr(exp: SchemeExp, modfCmp: SchemeModFComponent, cmp: Component) = PtrAddr(exp,modfCmp) 12 | } 13 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/scheme/modconc/SchemeModConcSensitivity.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular.scheme.modconc 2 | 3 | import scalaam.language.scheme._ 4 | import scalaam.modular.scheme.modf._ 5 | 6 | trait SchemeModConcNoSensitivity extends SchemeModConcSemantics { 7 | type ComponentContext = Unit 8 | def allocCtx(exp: SchemeExp, env: Env, modFCmp: SchemeModFComponent, caller: Component) = () 9 | } 10 | 11 | trait SchemeModConcStandardSensitivity extends SchemeModConcSemantics { 12 | type ComponentContext = SchemeModFComponent 13 | def allocCtx(exp: SchemeExp, env: Env, modFCmp: SchemeModFComponent, caller: Component) = modFCmp 14 | } 15 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/modular/scheme/modf/SchemeModFAllocator.scala: -------------------------------------------------------------------------------- 1 | package scalaam.modular.scheme.modf 2 | 3 | import scalaam.core._ 4 | import scalaam.modular.scheme._ 5 | import scalaam.language.scheme._ 6 | 7 | trait StandardSchemeModFAllocator extends BaseSchemeModFSemantics { 8 | type AllocationContext = Component 9 | def allocVar(id: Identifier, cmp: Component) = VarAddr(id,cmp) 10 | def allocPtr(exp: SchemeExp, cmp: Component) = PtrAddr(exp,cmp) 11 | } 12 | 13 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/util/Annotations.scala: -------------------------------------------------------------------------------- 1 | package scalaam.util 2 | 3 | object Annotations { 4 | class unsound(reason: String = "") extends scala.annotation.StaticAnnotation 5 | class maybeUnsound(reason: String = "") extends unsound 6 | 7 | class toCheck(reason: String = "") extends scala.annotation.StaticAnnotation 8 | 9 | class mutable extends scala.annotation.StaticAnnotation 10 | 11 | class assume(assumption: String = "") extends scala.annotation.StaticAnnotation 12 | } 13 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/util/Show.scala: -------------------------------------------------------------------------------- 1 | package scalaam.util 2 | 3 | import scalaam.core._ 4 | 5 | trait Show[V] { 6 | def show(v: V): String 7 | } 8 | 9 | object Show { 10 | def apply[V: Show]: Show[V] = implicitly 11 | } 12 | 13 | trait StoreShow[V, A <: Address] { 14 | def show(v: V, store: Store[A, V]): String 15 | } 16 | 17 | object StoreShow { 18 | def apply[V, A <: Address](implicit e: StoreShow[V, A]): StoreShow[V, A] = e 19 | def fromShow[V: Show, A <: Address]: StoreShow[V, A] = (v: V, _) => Show[V].show(v) 20 | } 21 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/util/SmartDatastructures.scala: -------------------------------------------------------------------------------- 1 | package scalaam.util 2 | 3 | /** 4 | * When using `s1 ++ s2` with the default Scala Set implementation, 5 | * it can be significantly more efficient to use `s2 ++ s1` if s1 is smaller than s2 6 | **/ 7 | object SmartUnion { 8 | def sunion[E](s1: Set[E], s2: Set[E]): Set[E] = if (s1.size < s2.size) s2 ++ s1 else s1 ++ s2 9 | def sunionList[E](s: List[Set[E]]): Set[E] = s.foldLeft(Set[E]())(sunion) 10 | } 11 | 12 | object SmartAppend { 13 | def sappend[E](l1: List[E], l2: List[E]): List[E] = if (l1.size < l2.size) l1 ::: l2 else l2 ::: l1 14 | } -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/util/SmartHash.scala: -------------------------------------------------------------------------------- 1 | package scalaam.util 2 | 3 | import scala.runtime.ScalaRunTime 4 | 5 | /* Imported from JSAI's notjs.util */ 6 | 7 | // the Scala compiler is not yet smart enough to figure out that it 8 | // only needs to hash immutable objects once; extending case classes 9 | // with this trait will make that happen. this one optimization can 10 | // improve performance by orders of magnitude. 11 | trait SmartHash extends Product { 12 | private lazy val cached = ScalaRunTime._hashCode(this) 13 | override def hashCode(): Int = cached 14 | } 15 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/util/graph/Colors.scala: -------------------------------------------------------------------------------- 1 | package scalaam.util.graph 2 | 3 | case class Color(hex: String) { 4 | override def toString = hex 5 | } 6 | object Colors { 7 | object Yellow extends Color("#FFFFDD") 8 | object Green extends Color("#DDFFDD") 9 | object Grass extends Color("#00FF00") 10 | object Pink extends Color("#FFDDDD") 11 | object Red extends Color("#FF0000") 12 | object Blue extends Color("#DDFFFF") 13 | object White extends Color("#FFFFFF") 14 | object Black extends Color("#000000") 15 | } 16 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/util/graph/NoGraph.scala: -------------------------------------------------------------------------------- 1 | package scalaam.util.graph 2 | 3 | /** A graph that preserves no information */ 4 | class NoGraph[N <: GraphElement, E <: GraphElement] { 5 | case class G() 6 | object G { 7 | implicit val typeclass = new Graph[G, N, E] { 8 | def empty = G() 9 | def addNode(g: G, node: N) = g 10 | def addEdge(g: G, node1: N, edge: E, node2: N) = g 11 | override def addEdges(g: G, l: Iterable[(N, E, N)]) = g 12 | def removeNode(g: G, node: N) = g 13 | def removeEdge(g: G, node1: N, edge: E, node2: N) = g 14 | def nodes(g: G) = 0 15 | def edges(g: G) = 0 16 | def findNodes(g: G, p: N => Boolean) = Set.empty 17 | } 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /code/shared/src/main/scala/scalaam/util/graph/ReachableStatesConditionGraph.scala: -------------------------------------------------------------------------------- 1 | package scalaam.util.graph 2 | 3 | case class ReachableStatesConditionGraph[N <: GraphElement, E <: GraphElement]( 4 | condition: N => Boolean 5 | ) { 6 | case class G(states: Set[N]) 7 | 8 | object G { 9 | implicit val typeclass = new Graph[G, N, E] { 10 | def empty = new G(Set.empty) 11 | def addNode(g: G, node: N) = 12 | if (condition(node)) { 13 | G(g.states + node) 14 | } else { 15 | g 16 | } 17 | def addEdge(g: G, node1: N, edge: E, node2: N) = addNode(addNode(g, node1), node2) 18 | def removeNode(g: G, node: N) = G(g.states - node) 19 | def removeEdge(g: G, node1: N, edge: E, node2: N) = g 20 | def nodes(g: G) = g.states.size 21 | def edges(g: G) = 0 22 | def findNodes(g: G, p: N => Boolean) = g.states.filter(p) 23 | } 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /code/shared/src/test/scala/scalaam/test/SchemeBenchmarkTests.scala: -------------------------------------------------------------------------------- 1 | package scalaam.test 2 | 3 | import org.scalatest.propspec.AnyPropSpec 4 | 5 | trait SchemeBenchmarkTests extends AnyPropSpec { 6 | // A benchmark is just a file name. 7 | type Benchmark = String 8 | // The benchmarks involved in the tests. Needs to be overridden later. 9 | def benchmarks(): Set[Benchmark] = Set.empty 10 | 11 | // Needs to be implemented to specify the testing behaviour per benchmark. 12 | protected def onBenchmark(b: Benchmark): Unit 13 | // Run the benchmarks. 14 | benchmarks().foreach(onBenchmark) 15 | } 16 | -------------------------------------------------------------------------------- /code/shared/src/test/scala/scalaam/test/TestTags.scala: -------------------------------------------------------------------------------- 1 | package scalaam.test 2 | 3 | import org.scalatest.Tag 4 | 5 | // Tags by non-functional test characteristics. 6 | object SlowTest extends Tag("SlowTest") 7 | 8 | // Tags by function. 9 | object ParserTest extends Tag("ParserTest") 10 | object LatticeTest extends Tag("LatticeTest") 11 | object PrimitiveTest extends Tag("PrimitiveTest") 12 | object SoundnessTest extends Tag("SoundnessTest") 13 | 14 | // Tags by language. 15 | object SchemeModFTest extends Tag("SchemeModFTest") 16 | object SchemeModConcTest extends Tag("SchemeModConcTest") 17 | 18 | // Tags by semantic type. 19 | object SmallStepTest extends Tag("SmallStepTest") 20 | object BigStepTest extends Tag("BigStepTest") 21 | 22 | // Tags by analysis variation. 23 | object IncrementalTest extends Tag("IncrementalTest") -------------------------------------------------------------------------------- /code/shared/src/test/scala/scalaam/test/language/sexp/ParserTests.scala: -------------------------------------------------------------------------------- 1 | package scalaam.test.language.sexp 2 | 3 | import scalaam.language.sexp._ 4 | import scalaam.test._ 5 | import scalaam.util._ 6 | 7 | trait SExpParserTestsSpec extends SchemeBenchmarkTests { 8 | def onBenchmark(benchmark: Benchmark) = 9 | property(s"SExpParser can correctly parse $benchmark", ParserTest) { 10 | val content = Reader.loadFile(benchmark) 11 | val parsed = SExpParser.parse(content) 12 | // Check that the parsing was succesful 13 | assert(parsed.mkString("").nonEmpty) 14 | // Check that printing and parsing the result again gives the same result 15 | val printed = parsed.mkString("") 16 | val reparsed = SExpParser.parse(printed) 17 | assert(parsed.mkString("") == reparsed.mkString(""), 18 | "Printing and parsing again gives a result different from the original parse") 19 | } 20 | } 21 | 22 | class SExpParserTests extends SExpParserTestsSpec with SequentialBenchmarks -------------------------------------------------------------------------------- /openJS.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # sbt fastOptJS # Can be used separately (this is faster in IntelliJ since it keeps sbt running where it should otherswise restart every time this script is run). 3 | open -a safari ./scalaam.html -------------------------------------------------------------------------------- /project/build.properties: -------------------------------------------------------------------------------- 1 | sbt.version=1.3.10 -------------------------------------------------------------------------------- /project/plugins.sbt: -------------------------------------------------------------------------------- 1 | addSbtPlugin("org.scala-js" % "sbt-scalajs" % "1.0.1") 2 | addSbtPlugin("org.portable-scala" % "sbt-scalajs-crossproject" % "1.0.0") 3 | -------------------------------------------------------------------------------- /scalaam.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Scala-AM 6 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /test/DEBUG.scm: -------------------------------------------------------------------------------- 1 | (define (fib n) 2 | (if (< n 2) 3 | n 4 | (let ((fib-n-1 (fib (- n 1))) 5 | (fib-n-2 (fib (- n 2)))) 6 | (+ fib-n-1 fib-n-2)))) 7 | (procedure? fib) -------------------------------------------------------------------------------- /test/DEBUG2.scm: -------------------------------------------------------------------------------- 1 | (define (fib x) x) 2 | (display (fib 10)) 3 | (newline) 4 | (begin 5 | (load "DEBUG.scm") ; Contains real definition for fibonacci. 6 | (display (fib 10))) 7 | (newline) 8 | (fib 10) -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/arithmetic.setl: -------------------------------------------------------------------------------- 1 | program arithmetic; 2 | 3 | $$ rekenkundige operatoren aanvaarden mix van reële en gehele operanden 4 | x := 2 + 3.0 + 4; 5 | print(x); 6 | 7 | end program; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/assignvbpag5.setl: -------------------------------------------------------------------------------- 1 | program assign; 2 | 3 | a := 3; 4 | a +:= 4; 5 | b:= a +:= 1; 6 | 7 | print(b); 8 | print(a); 9 | 10 | a := 3 + b := 5 + 2; 11 | 12 | print(b); 13 | print(a); 14 | 15 | abc := 'the quick brown fox'; 16 | cde := abc(5 .. 8); 17 | cde := abc(5); 18 | edf := abc(5 ..); 19 | 20 | print(cde); 21 | print(edf); 22 | 23 | end program assign; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/formers.setl: -------------------------------------------------------------------------------- 1 | program formers; 2 | x :=[ [n] : n in [100, 90 .. 1] ]; 3 | print(x); 4 | 5 | y := { [b ** 2, b] : b in {1..5} }; 6 | print(y); 7 | 8 | z := { a: a in x | a(1) > 60}; 9 | print(z); 10 | 11 | end program formers; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/from.setl: -------------------------------------------------------------------------------- 1 | program fromprog; 2 | 3 | a := [11, 26, 37, 17]; 4 | 5 | $ werkt ook correct met a := []; 6 | 7 | b fromb a; 8 | print(b); 9 | print(a); 10 | 11 | c fromb a; 12 | print(c); 13 | print(a); 14 | 15 | d fromb a; 16 | e fromb a; 17 | f fromb a; 18 | 19 | print(f); 20 | print(a); 21 | 22 | end program fromprog; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/functions.setl: -------------------------------------------------------------------------------- 1 | program functions; 2 | 3 | print(factorial(5)); 4 | 5 | 6 | proc factorial(arg); 7 | if arg = 1 then 8 | return 1; 9 | else 10 | return arg * factorial(arg-1); 11 | end if; 12 | end proc factorial; 13 | 14 | 15 | 16 | 17 | end program; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/procedures.setl: -------------------------------------------------------------------------------- 1 | program procedures; 2 | $$ er is een x in de globale omgeving en in een lokale omgeving 3 | $$ het return statement escaped ook 4 | 5 | x := fac(200); 6 | print(x); 7 | y := fib(10); 8 | print(y); 9 | 10 | $$ operatoren zijn keywords en het misbruik ervan resulteert in een read-error 11 | $$ proc max(a,b); return a; end proc max; 12 | 13 | proc fib(n); 14 | if n > 1 15 | then return fib(n - 1) + fib(n-2); 16 | else return 1; 17 | end if; 18 | end proc fib; 19 | 20 | 21 | proc fac(x); 22 | if x = 1 23 | then return 1; 24 | else return x * fac(x - 1); 25 | end if; 26 | print('hier komen we nooit'); 27 | end proc; 28 | 29 | $$ deze herdefinitie van de native procedure print wordt genegeerd 30 | proc print(x); 31 | x := 'hier komen we niet'; 32 | end proc; 33 | 34 | 35 | 36 | end program procedures; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/sequence.setl: -------------------------------------------------------------------------------- 1 | program sequence; 2 | 3 | print(testif(test())); 4 | 5 | proc testif(x); 6 | 7 | if x = 4 then 8 | print('if1'); 9 | print('if2'); 10 | return('gedaan'); 11 | print('niet op scherm'); 12 | else 13 | print('else1'); 14 | print('else2'); 15 | return('elsegedaan'); 16 | print('niet op scherm else'); 17 | end if; 18 | 19 | print('niet op scherm 3'); 20 | 21 | end proc testif; 22 | 23 | proc test; 24 | print('een'); 25 | print('twee'); 26 | print('drie'); 27 | return 4; 28 | end proc; 29 | 30 | end program sequence; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/sets.setl: -------------------------------------------------------------------------------- 1 | program sets; 2 | 3 | x := {1, [2], 8, om, {2 .. 3 + 5 }}; 4 | y := {1, 2, om, [2] }; 5 | 6 | z := x + y; 7 | k := x * y; 8 | 9 | test(z, k); 10 | 11 | proc test(x, y); 12 | print(x); 13 | print(y); 14 | end proc; 15 | 16 | end program sets; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/test.setl: -------------------------------------------------------------------------------- 1 | program recursie; 2 | 3 | test(3); 4 | 5 | proc test(x); 6 | if x = 1 then 7 | print('gedaan'); 8 | else 9 | test(x - 1); 10 | end if; 11 | end proc; 12 | 13 | end program recursie; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/testcase1.setl: -------------------------------------------------------------------------------- 1 | program testcase1; 2 | a := ((4*5 + 5)) * 100 / 5 ** 2 - 10 *3** 0 + 8 ; 3 | 4 | print(a); 5 | scope1; 6 | 7 | proc scope1; 8 | a := 2; 9 | print(a); 10 | scope2; 11 | end proc scope1; 12 | 13 | proc scope2; 14 | print(a); 15 | a := 3; 16 | print(a); 17 | end proc; 18 | 19 | end program testcase1; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/testcase3.setl: -------------------------------------------------------------------------------- 1 | program sample3; 2 | 3 | $ simpele test op iterators, forall, exists en loop constructie 4 | 5 | init s := {1,2,10,20}; 6 | 7 | if forall x in s | x > 3 8 | then print('All elements met the requirements'); 9 | else 10 | print('The test failed for at least one element: ' + x); 11 | end if; 12 | 13 | if notexists x in s | x > 3 $werkt pok met not exists 14 | then print('The following element has met the requirements: ' + x); 15 | else 16 | print('No element met the requirements'); 17 | end if; 18 | 19 | loop for i in [1 .. 20] do 20 | print([1 .. i]); 21 | end loop; 22 | 23 | i:=20; 24 | loop while i > 0 do 25 | print([1 .. i]); 26 | i := i-1; 27 | end loop; 28 | 29 | end program sample3; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/testif.setl: -------------------------------------------------------------------------------- 1 | program testif; 2 | 3 | x := 3; 4 | 5 | if x = 3 then print('ok'); else print('nok'); end if; 6 | 7 | end program; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/tupleconcat.setl: -------------------------------------------------------------------------------- 1 | program test; 2 | 3 | k := {}; 4 | 5 | x := [1, 2, 3]; 6 | 7 | y := [4, 5]; 8 | 9 | if is_tuple y then 10 | 11 | print(x + y); 12 | 13 | end if; 14 | end program test; -------------------------------------------------------------------------------- /test/R5RS/SETL/setl-programs/tuples.setl: -------------------------------------------------------------------------------- 1 | program tuples; 2 | x := [om]; 3 | print(x); 4 | x := [om, 3, 7, 9, om]; 5 | print(x); 6 | 7 | y := x(1..3); 8 | print(y); 9 | 10 | z := [1,3...10]; 11 | print(z); 12 | k := [10, 7..1]; 13 | print(k); 14 | 15 | [a, -, c, d] := [1, 2, 3]; 16 | print(a); 17 | print(c); 18 | print(d); 19 | [l] := [[a,c,[ ]],d]; 20 | print(l); 21 | 22 | m := [1,2,3,4,5,6]; 23 | m(2..5) := [7 , 10]; 24 | print(m); 25 | m(3..) := []; 26 | print(m); 27 | m(1) := 6; 28 | print(m); 29 | 30 | end program; -------------------------------------------------------------------------------- /test/R5RS/WeiChenRompf2019/church_simple.sch: -------------------------------------------------------------------------------- 1 | (define pred 2 | (lambda (n) 3 | (lambda (rf) 4 | (lambda (rx) 5 | (((n (lambda (g) (lambda (h) (h (g rf))))) 6 | (lambda (ignored) rx)) 7 | (lambda (id) id)))))) 8 | 9 | (define church0 (lambda (f0) (lambda (x0) x0))) 10 | (define church1 (lambda (f1) (lambda (x1) (f1 x1)))) 11 | (define church0? (lambda (z) ((z (lambda (zx) #f)) #t))) 12 | 13 | (define ff 14 | (lambda (e) 15 | (if (church0? e) 16 | e 17 | (ff ((church1 pred) e))))) 18 | (ff church1) 19 | -------------------------------------------------------------------------------- /test/R5RS/WeiChenRompf2019/kcfa3.scm: -------------------------------------------------------------------------------- 1 | ;; Another working example (bigger) 2 | ;; 1749 states, 3846 edges for 1CFA 3 | ;; Normalized by pretty-print 4 | ((lambda (f1) (let ((a (f1 #t))) (f1 #f))) 5 | (lambda (x1) 6 | ((lambda (f2) (let ((b (f2 #t))) (f2 #f))) 7 | (lambda (x2) 8 | ((lambda (f3) (let ((c (f3 #t))) (f3 #f))) 9 | (lambda (x3) ((lambda (z) (z x1 x2 x3)) (lambda (y1 y2 y3) y1)))))))) 10 | -------------------------------------------------------------------------------- /test/R5RS/WeiChenRompf2019/omega.scm: -------------------------------------------------------------------------------- 1 | ((lambda (x) (x x)) 2 | (lambda (x) (x x))) 3 | -------------------------------------------------------------------------------- /test/R5RS/WeiChenRompf2019/the-little-schemer/ch1.scm: -------------------------------------------------------------------------------- 1 | ;这里是注释 2 | ;第一章源代码 3 | 4 | (define atom? 5 | (lambda (x) 6 | (and (not (pair? x)) (not (null? x))))) 7 | 8 | (atom? 'atom) 9 | 10 | (atom? 'turkey) 11 | 12 | (atom? 1942) 13 | 14 | (atom? 'u) 15 | 16 | (atom? '*abc$) 17 | 18 | (list? '(atom)) 19 | 20 | (list? '(atom turkey or)) 21 | 22 | ; 会报错 23 | ; (list? '(atom turkey) or) 24 | 25 | (list? '((atom turkey) or)) 26 | 27 | (list? '()) 28 | 29 | (atom? '()) 30 | 31 | (car '(a b c)) 32 | 33 | (car '((a b c) x y z)) 34 | 35 | ; 会报错 36 | ;(car 'hotdog) 37 | 38 | (cdr '(a b c)) 39 | 40 | (cdr '((a b c) x y z)) 41 | 42 | ;(cdr '()) 43 | 44 | (cons 'peanut '(butter and jelly)) 45 | 46 | (cons '(banana and) '(peanut butter and jelly)) 47 | 48 | (null? (quote ())) 49 | -------------------------------------------------------------------------------- /test/R5RS/WeiChenRompf2019/the-little-schemer/ch2.scm: -------------------------------------------------------------------------------- 1 | (define atom? 2 | (lambda (x) 3 | (and (not (pair? x)) (not (null? x))))) 4 | 5 | ;; a lat is a list of atoms 6 | (define lat? 7 | (lambda (l) 8 | (cond 9 | ((null? l) #t) 10 | ((atom? (car l)) (lat? (cdr l))) 11 | (else #f)))) 12 | 13 | (lat? '(Jack Sprat could eat no chicken fat)) 14 | (lat? '((Jack) Sprat could eat no chicken fat)) 15 | (lat? '(Jack (Sprat could) eat no chicken fat)) 16 | (lat? '()) -------------------------------------------------------------------------------- /test/R5RS/WeiChenRompf2019/toplas98/handle.scm: -------------------------------------------------------------------------------- 1 | (define-data handle owner ref) 2 | (define-data Aspace name) 3 | 4 | (defmacro def-macro args 5 | (match args 6 | (((name . pat) . body) 7 | `(defmacro ,name args2 8 | (match args2 9 | (,pat (let () ,@body))))))) 10 | 11 | (def-macro (with-aspace aspace exp) 12 | `(let ((current-aspace (lambda () ,aspace))) 13 | ,exp)) 14 | 15 | (let* ((a (make-Aspace "foo")) 16 | (b (make-handle a 0)) 17 | (c (make-Aspace "bar")) 18 | (d (make-handle b 0))) 19 | (handle-ref d) 20 | (handle-ref b)) 21 | 22 | -------------------------------------------------------------------------------- /test/R5RS/ad/btree.scm: -------------------------------------------------------------------------------- 1 | (define (make-node key left right parent info) 2 | (list key left right parent info)) 3 | 4 | (define (key node) 5 | (list-ref node 0)) 6 | 7 | (define (left node) 8 | (list-ref node 1)) 9 | 10 | (define (right node) 11 | (list-ref node 2)) 12 | 13 | (define (parent node) 14 | (list-ref node 3)) 15 | 16 | (define (info node) 17 | (list-ref node 4)) 18 | 19 | (define (set-key! node key) 20 | (set-car! node key)) 21 | 22 | (define (set-left! node l) 23 | (set-car! (cdr node) l)) 24 | 25 | (define (set-right! node r) 26 | (set-car! (cddr node) r)) 27 | 28 | (define (set-parent! node p) 29 | (set-car! (cdddr node) p)) 30 | 31 | (define (set-info! node i) 32 | (set-car! (cddddr node) i)) 33 | 34 | (define null-tree '()) 35 | 36 | (define (null-tree? tree) 37 | (null? tree)) 38 | 39 | (define (is-leaf? node) 40 | (and (null-tree? (left node)) 41 | (null-tree? (right node)))) 42 | 43 | (define (is-root? node) 44 | (null-tree? (parent node))) 45 | 46 | -------------------------------------------------------------------------------- /test/R5RS/ad/bubsort.scm: -------------------------------------------------------------------------------- 1 | (define (bubble-sort vector) 2 | (define (swap vector index1 index2) 3 | (let ((temp (vector-ref vector index1))) 4 | (vector-set! vector index1 (vector-ref vector index2)) 5 | (vector-set! vector index2 temp))) 6 | (define (bubble index) 7 | (define (bubble-iter index1 changed) 8 | (cond ((<= index1 index) 9 | (if(> (vector-ref vector index1) 10 | (vector-ref vector (+ index1 1))) 11 | (begin 12 | (swap vector index1 (+ index1 1)) 13 | (set! changed #t))) 14 | (bubble-iter (+ index1 1) changed)) 15 | (else changed))) 16 | (bubble-iter 0 #f)) 17 | (define (bubble-sort-iter index) 18 | (if(>= index 0) 19 | (if (bubble index) 20 | (bubble-sort-iter (- index 1))))) 21 | (bubble-sort-iter (- (vector-length vector) 2))) 22 | 23 | (define vect (vector 9 5 1 7 8 9 4 6 2 3 )) 24 | (bubble-sort vect) 25 | (equal? vect (vector 1 2 3 4 5 6 7 8 9 9)) -------------------------------------------------------------------------------- /test/R5RS/ad/inssort.scm: -------------------------------------------------------------------------------- 1 | (define (insertion-sort vector) 2 | (let ((high (- (vector-length vector) 1))) 3 | (define (shift-left vector index) 4 | (vector-set! vector (- index 1) (vector-ref vector index))) 5 | (define (insert-sort-iter index1) 6 | (define (insert index1) 7 | (let ((insert-value (vector-ref vector (- index1 1)))) 8 | (define (insert-iter index2) 9 | (cond ((and (<= index2 high) 10 | (< (vector-ref vector index2) 11 | insert-value)) 12 | (shift-left vector index2) 13 | (insert-iter (+ index2 1))) 14 | (else (vector-set! vector (- index2 1) insert-value)))) 15 | (insert-iter index1))) 16 | (if (> index1 0) 17 | (begin 18 | (insert index1) 19 | (insert-sort-iter (- index1 1))))) 20 | (insert-sort-iter high))) 21 | 22 | (define vect (vector 5 2 7 1 0 9 8 6 3 4)) 23 | (insertion-sort vect) 24 | (equal? vect (vector 0 1 2 3 4 5 6 7 8 9)) -------------------------------------------------------------------------------- /test/R5RS/ad/selsort.scm: -------------------------------------------------------------------------------- 1 | (define (selection-sort vector) 2 | (define (swap vector index1 index2) 3 | (let ((temp (vector-ref vector index1))) 4 | (vector-set! vector index1 (vector-ref vector index2)) 5 | (vector-set! vector index2 temp))) 6 | 7 | (define (pos-of-min vector low high) 8 | (define (min-iter index pos-of-min-so-far) 9 | (if (<= index high) 10 | (if (< (vector-ref vector index) 11 | (vector-ref vector pos-of-min-so-far)) 12 | (min-iter (+ index 1) index) 13 | (min-iter (+ index 1) pos-of-min-so-far)) 14 | pos-of-min-so-far)) 15 | (min-iter (+ low 1) low)) 16 | 17 | (let ((high (- (vector-length vector) 1))) 18 | (define (selection-sort-iter index) 19 | (if (< index high) 20 | (begin 21 | (swap vector index (pos-of-min vector index high)) 22 | (selection-sort-iter (+ index 1))))) 23 | (selection-sort-iter 0))) 24 | 25 | 26 | (define vect (vector 5 7 0 9 6 4 3 8 2 1)) 27 | (selection-sort vect) 28 | (equal? vect (vector 0 1 2 3 4 5 6 7 8 9)) 29 | -------------------------------------------------------------------------------- /test/R5RS/blur.scm: -------------------------------------------------------------------------------- 1 | (letrec ((id (lambda (x) x)) 2 | (blur (lambda (y) y)) 3 | (lp (lambda (a n) 4 | (if (<= n 1) 5 | (id a) 6 | (letrec ((r ((blur id) #t)) 7 | (s ((blur id) #f))) 8 | (not ((blur lp) s (- n 1)))))))) 9 | (lp #f 2)) 10 | -------------------------------------------------------------------------------- /test/R5RS/bound-precision.scm: -------------------------------------------------------------------------------- 1 | (define (f x) (if (< x 100) f 1)) 2 | (define f2 (f 5)) 3 | (eq? (f2 2) f) 4 | -------------------------------------------------------------------------------- /test/R5RS/callcc.scm: -------------------------------------------------------------------------------- 1 | ;; result: 103 2 | 3 | (define saved '()) 4 | (define done? #f) 5 | 6 | (define (foo x) 7 | (+ x (call/cc bar))) 8 | 9 | (define (bar cnt) 10 | (set! saved cnt) 11 | 42) 12 | 13 | (define (main) 14 | (let ((res (foo 100))) 15 | (if done? 16 | res 17 | (begin 18 | (set! done? #t) 19 | (saved 3))))) 20 | 21 | (main) 22 | -------------------------------------------------------------------------------- /test/R5RS/church-2-num.scm: -------------------------------------------------------------------------------- 1 | (letrec ((zero (lambda (f x) x)) 2 | (inc (lambda (n) 3 | (lambda (f x) 4 | (f (n f x))))) 5 | (plus (lambda (m n) 6 | (lambda (f x) 7 | (m f (n f x)))))) 8 | ((inc (inc zero)) (lambda (x) (+ x 1)) 0)) 9 | -------------------------------------------------------------------------------- /test/R5RS/church-6.scm: -------------------------------------------------------------------------------- 1 | (letrec ((zero (lambda (f x) x)) 2 | (inc (lambda (n) 3 | (lambda (f x) 4 | (f (n f x))))) 5 | (plus (lambda (m n) 6 | (lambda (f x) 7 | (m f (n f x)))))) 8 | ((plus (inc (inc (inc zero))) (plus (inc (inc zero)) (inc zero))) (lambda (x) (+ x 1)) 0)) 9 | -------------------------------------------------------------------------------- /test/R5RS/collatz.scm: -------------------------------------------------------------------------------- 1 | (define (div2* n s) 2 | (if (= (* 2 n) s) 3 | n 4 | (if (= (+ (* 2 n) 1) s) 5 | n 6 | (div2* (- n 1) s)))) 7 | (define (div2 n) 8 | (div2* n n)) 9 | (define (hailstone* n count) 10 | (if (= n 1) 11 | count 12 | (if (even? n) 13 | (hailstone* (div2 n) (+ count 1)) 14 | (hailstone* (+ (* 3 n) 1) 15 | (+ count 1))))) 16 | (define (hailstone n) 17 | (hailstone* n 0)) 18 | (hailstone 5) 19 | -------------------------------------------------------------------------------- /test/R5RS/count.scm: -------------------------------------------------------------------------------- 1 | (letrec ((count (lambda (n) (if (= n 0) "done" (count (- n 1)))))) 2 | (count 10)) 3 | -------------------------------------------------------------------------------- /test/R5RS/eta.scm: -------------------------------------------------------------------------------- 1 | ;; Taken from https://github.com/jensnicolay/abstractmemo 2 | ;; Expected result: #f 3 | (define (do-something) 10) 4 | (define (id y) 5 | (do-something) 6 | y) 7 | ((id (lambda (a) a)) #t) 8 | ((id (lambda (b) b)) #f) 9 | -------------------------------------------------------------------------------- /test/R5RS/example.scm: -------------------------------------------------------------------------------- 1 | (define (map f lst) 2 | (if (null? lst) 3 | '() 4 | (cons (f (car lst)) (map f (cdr lst))))) 5 | 6 | 7 | (define (inc n) (+ n 1)) 8 | (map inc '(1 2 3)) -------------------------------------------------------------------------------- /test/R5RS/fact.scm: -------------------------------------------------------------------------------- 1 | (define (fact n) 2 | (if (= n 0) 3 | 1 4 | (* n (fact (- n 1))))) 5 | (fact 5) 6 | -------------------------------------------------------------------------------- /test/R5RS/fib.scm: -------------------------------------------------------------------------------- 1 | (define (fib n) 2 | (if (< n 2) 3 | n 4 | (+ (fib (- n 1)) 5 | (fib (- n 2))))) 6 | 7 | (fib 10) 8 | -------------------------------------------------------------------------------- /test/R5RS/foo.scm: -------------------------------------------------------------------------------- 1 | (append '(1 2 3) '(4 5 6)) 2 | -------------------------------------------------------------------------------- /test/R5RS/gabriel/cpstak.scm: -------------------------------------------------------------------------------- 1 | ;; Taken from https://github.com/jensnicolay/abstractmemo 2 | ;; Expected result: 6 3 | (letrec ((tak (lambda (x y z k) 4 | (if (not (< y x)) 5 | (k z) 6 | (tak (- x 1) 7 | y 8 | z 9 | (lambda (v1) 10 | (tak (- y 1) 11 | z 12 | x 13 | (lambda (v2) 14 | (tak (- z 1) 15 | x 16 | y 17 | (lambda (v3) 18 | (tak v1 v2 v3 k))))))))))) 19 | (tak 20 10 5 (lambda (a) a))) 20 | -------------------------------------------------------------------------------- /test/R5RS/gabriel/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 | (equal? (iterative-div2 *ll*) 16 | '(() () () () () () () () () () () () () () () () () () () () 17 | () () () () () () () () () () () () () () () () () () () () 18 | () () () () () () () () () () () () () () () () () () () () 19 | () () () () () () () () () () () () () () () () () () () () 20 | () () () () () () () () () () () () () () () () () () () ())) 21 | -------------------------------------------------------------------------------- /test/R5RS/gabriel/divrec.scm: -------------------------------------------------------------------------------- 1 | (letrec ((create-n (lambda (n) 2 | (letrec ((loop (lambda (n a) 3 | (if (= n 0) 4 | a 5 | (loop (- n 1) (cons '() a)))))) 6 | (loop n '()))))) 7 | (letrec ((recursive-div2 (lambda (l) 8 | (if (null? l) 9 | '() 10 | (cons (car l) (recursive-div2 (cddr l))))))) 11 | (let ((result '(() () () () () () () () () () () () () () () () () () () () 12 | () () () () () () () () () () () () () () () () () () () () 13 | () () () () () () () () () () () () () () () () () () () () 14 | () () () () () () () () () () () () () () () () () () () () 15 | () () () () () () () () () () () () () () () () () () () ()))) 16 | (equal? (recursive-div2 (create-n 200)) result)))) 17 | -------------------------------------------------------------------------------- /test/R5RS/gabriel/takl.scm: -------------------------------------------------------------------------------- 1 | (define (listn n) 2 | (if (= n 0) 3 | '() 4 | (cons n (listn (- n 1))))) 5 | (define (shorterp x y) 6 | (and (not (null? y)) 7 | (or (null? x) 8 | (shorterp (cdr x) 9 | (cdr y))))) 10 | (define (mas x y z) 11 | (if (not (shorterp y x)) 12 | z 13 | (mas (mas (cdr x) y z) 14 | (mas (cdr y) z x) 15 | (mas (cdr z) x y)))) 16 | (let ((result '(7 6 5 4 3 2 1))) 17 | (equal? (mas (listn 18) (listn 12) (listn 6)) result)) 18 | -------------------------------------------------------------------------------- /test/R5RS/gambit/array1.scm: -------------------------------------------------------------------------------- 1 | ;;; ARRAY1 -- One of the Kernighan and Van Wyk benchmarks. 2 | ;; reduced number of iterations from 200000 to 200 3 | 4 | (define (create-x n) 5 | (define result (make-vector n 0)) 6 | (do ((i 0 (+ i 1))) 7 | ((>= i n) result) 8 | (vector-set! result i i))) 9 | 10 | (define (create-y x) 11 | (let* ((n (vector-length x)) 12 | (result (make-vector n 0))) 13 | (do ((i (- n 1) (- i 1))) 14 | ((< i 0) result) 15 | (vector-set! result i (vector-ref x i))))) 16 | 17 | (define (my-try n) 18 | (vector-length (create-y (create-x n)))) 19 | 20 | (define (go n) 21 | (let loop ((repeat 100) 22 | (result '())) 23 | (if (> repeat 0) 24 | (loop (- repeat 1) (my-try n)) 25 | result))) 26 | 27 | (= 200 (go 200)) 28 | -------------------------------------------------------------------------------- /test/R5RS/gambit/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 "../../src/bib")) 16 | (set! outport (open-output-file "foo")) 17 | (catport inport) 18 | (close-input-port inport)) 19 | 20 | (go) -------------------------------------------------------------------------------- /test/R5RS/gambit/ctak.scm: -------------------------------------------------------------------------------- 1 | ;;; CTAK -- A version of the TAK procedure that uses continuations. 2 | 3 | (define (ctak x y z) 4 | (call-with-current-continuation 5 | (lambda (k) (ctak-aux k x y z)))) 6 | 7 | (define (ctak-aux k x y z) 8 | (if (not (< y x)) 9 | (k z) 10 | (call-with-current-continuation 11 | (lambda (k) 12 | (ctak-aux 13 | k 14 | (call-with-current-continuation 15 | (lambda (k) (ctak-aux k (- x 1) y z))) 16 | (call-with-current-continuation 17 | (lambda (k) (ctak-aux k (- y 1) z x))) 18 | (call-with-current-continuation 19 | (lambda (k) (ctak-aux k (- z 1) x y)))))))) 20 | 21 | (= 7 (ctak 18 12 6)) 22 | -------------------------------------------------------------------------------- /test/R5RS/gambit/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 | (equal? (iterative-div2 *ll*) 16 | '(() () () () () () () () () () () () () () () () () () () () 17 | () () () () () () () () () () () () () () () () () () () () 18 | () () () () () () () () () () () () () () () () () () () () 19 | () () () () () () () () () () () () () () () () () () () () 20 | () () () () () () () () () () () () () () () () () () () ())) -------------------------------------------------------------------------------- /test/R5RS/gambit/fibc.scm: -------------------------------------------------------------------------------- 1 | ;;; FIBC -- FIB using first-class continuations, written by Kent Dybvig 2 | 3 | (define (_1+ n) (+ n 1)) 4 | (define (_1- n) (- n 1)) 5 | 6 | ;;; fib with peano arithmetic (using numbers) with call/cc 7 | 8 | (define (addc x y k) 9 | (if (zero? y) 10 | (k x) 11 | (addc (_1+ x) (_1- y) k))) 12 | 13 | (define (fibc x c) 14 | (if (zero? x) 15 | (c 0) 16 | (if (zero? (_1- x)) 17 | (c 1) 18 | (addc (call-with-current-continuation (lambda (c) (fibc (_1- x) c))) 19 | (call-with-current-continuation (lambda (c) (fibc (_1- (_1- x)) c))) 20 | c)))) 21 | 22 | (equal? (fibc 18 (lambda (n) n)) 2584) 23 | -------------------------------------------------------------------------------- /test/R5RS/gambit/nqueens.scm: -------------------------------------------------------------------------------- 1 | (define (one-to n) 2 | (letrec ((loop (lambda (i l) 3 | (if (= i 0) 4 | l 5 | (loop (- i 1) (cons i l)))))) 6 | (loop n '()))) 7 | 8 | (define (ok? row dist placed) 9 | (if (null? placed) 10 | #t 11 | (and (not (= (car placed) (+ row dist))) 12 | (not (= (car placed) (- row dist))) 13 | (ok? row (+ dist 1) (cdr placed))))) 14 | 15 | (define (try-it x y z) 16 | (if (null? x) 17 | (if (null? y) 18 | 1 19 | 0) 20 | (+ (if (ok? (car x) 1 z) 21 | (try-it (append (cdr x) y) '() (cons (car x) z)) 22 | 0) 23 | (try-it (cdr x) (cons (car x) y) z)))) 24 | 25 | (define (nqueens n) 26 | (try-it (one-to n) '() '())) 27 | 28 | (nqueens 8) 29 | #t 30 | -------------------------------------------------------------------------------- /test/R5RS/gambit/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 | (equal? (primes<= 100) 26 | '(2 3 5 7 11 13 17 19 23 29 31 37 41 27 | 43 47 53 59 61 67 71 73 79 83 89 97)) 28 | 29 | -------------------------------------------------------------------------------- /test/R5RS/gambit/string.scm: -------------------------------------------------------------------------------- 1 | ;;; STRING -- One of the Kernighan and Van Wyk benchmarks. 2 | 3 | (define s "abcdef") 4 | 5 | (define (grow) 6 | (set! s (string-append "123" s "456" s "789")) 7 | (set! s (string-append 8 | (substring s (quotient (string-length s) 2) (string-length s)) 9 | (substring s 0 (+ 1 (quotient (string-length s) 2))))) 10 | s) 11 | 12 | (define (trial n) 13 | (do ((i 0 (+ i 1))) 14 | ((> (string-length s) n) (string-length s)) 15 | (grow))) 16 | 17 | (define (my-try n) 18 | (do ((i 0 (+ i 1))) 19 | ((>= i 10) (string-length s)) 20 | (set! s "abcdef") 21 | (trial n))) 22 | 23 | (= (my-try 500000) 524278) -------------------------------------------------------------------------------- /test/R5RS/gambit/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 | (= (run 10000) 50005000) -------------------------------------------------------------------------------- /test/R5RS/gambit/sumloop.scm: -------------------------------------------------------------------------------- 1 | ;;; SUMLOOP -- One of the Kernighan and Van Wyk benchmarks. 2 | ;; reduced number of iterations from 1000000 to 1000 3 | 4 | (define sum 0) 5 | 6 | (define (tail-rec-aux i n) 7 | (if (< i n) 8 | (begin (set! sum (+ sum 1)) (tail-rec-aux (+ i 1) n)) 9 | sum)) 10 | 11 | (define (tail-rec-loop n) 12 | (set! sum 0) 13 | (tail-rec-aux 0 n) 14 | sum) 15 | 16 | (define (do-loop n) 17 | (set! sum 0) 18 | (do ((i 0 (+ i 1))) 19 | ((>= i n) sum) 20 | (set! sum (+ sum 1)))) 21 | 22 | (= (do-loop 1000) 1000) 23 | -------------------------------------------------------------------------------- /test/R5RS/gambit/tail.scm: -------------------------------------------------------------------------------- 1 | ;;; TAIL -- One of the Kernighan and Van Wyk benchmarks. 2 | 3 | (define inport #f) 4 | (define outport #f) 5 | 6 | (define (readline port line-so-far) 7 | (let ((x (read-char port))) 8 | (cond ((eof-object? x) 9 | x) 10 | ((char=? x #\newline) 11 | (list->string (reverse 12 | (cons x line-so-far)))) 13 | (#t (readline port (cons x line-so-far)))))) 14 | 15 | (define (tail-r-aux port file-so-far) 16 | (let ((x (readline port '()))) 17 | (if (eof-object? x) 18 | (begin 19 | (display file-so-far outport) 20 | (close-output-port outport)) 21 | (tail-r-aux port (cons x file-so-far))))) 22 | 23 | (define (tail-r port) 24 | (tail-r-aux port '())) 25 | 26 | (define (go) 27 | (set! inport (open-input-file "../../src/bib")) 28 | (set! outport (open-output-file "foo")) 29 | (tail-r inport) 30 | (close-input-port inport)) 31 | 32 | (go) -------------------------------------------------------------------------------- /test/R5RS/gambit/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 | (= 7 (tak 18 12 6)) -------------------------------------------------------------------------------- /test/R5RS/gambit/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 "../../src/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 | (equal? (go) '(31102 851820 4460056)) -------------------------------------------------------------------------------- /test/R5RS/gcipd.scm: -------------------------------------------------------------------------------- 1 | ;; Taken from https://github.com/jensnicolay/abstractmemo 2 | ;; Expected result: 36 3 | (letrec ((id (lambda (x) x)) 4 | (f (lambda (n) 5 | (if (<= n 1) 6 | 1 7 | (* n (f (- n 1)))))) 8 | (g (lambda (n) 9 | (if (<= n 1) 10 | 1 11 | (+ (* n n) (g (- n 1))))))) 12 | (+ ((id f) 3) ((id g) 4))) 13 | -------------------------------------------------------------------------------- /test/R5RS/inc.scm: -------------------------------------------------------------------------------- 1 | (letrec ((inc (lambda (x) (+ x 1)))) 2 | (inc (inc 2))) 3 | -------------------------------------------------------------------------------- /test/R5RS/infinite-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda () (f)))) 2 | (f)) 3 | -------------------------------------------------------------------------------- /test/R5RS/infinite-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((t (lambda (x) (t (+ x 1))))) 2 | (t 0)) 3 | -------------------------------------------------------------------------------- /test/R5RS/infinite-3.scm: -------------------------------------------------------------------------------- 1 | ((lambda (x) (x x)) (lambda (y) (y y))) 2 | -------------------------------------------------------------------------------- /test/R5RS/kcfa2.scm: -------------------------------------------------------------------------------- 1 | ((lambda (f1) 2 | (letrec ((a (f1 #t))) 3 | (f1 #f))) 4 | (lambda (x1) 5 | ((lambda (f2) 6 | (letrec ((b (f2 #t)) 7 | (c (f2 #f))) 8 | (f2 #t))) 9 | (lambda (x2) ((lambda (z) (z x1 x2)) (lambda (y1 y2) y1)))))) 10 | -------------------------------------------------------------------------------- /test/R5RS/kcfa3.scm: -------------------------------------------------------------------------------- 1 | ;; Taken from https://github.com/jensnicolay/abstractmemo 2 | ;; Expected result: #f 3 | ((lambda (f1) 4 | (letrec ((a (f1 #t))) 5 | (f1 #f))) 6 | (lambda (x1) 7 | ((lambda (f2) 8 | (letrec ((b (f2 #t))) 9 | (f2 #f))) 10 | (lambda (x2) 11 | ((lambda (f3) 12 | (letrec ((c (f3 #t))) 13 | (f3 #f))) 14 | (lambda (x3) 15 | ((lambda (z) 16 | (z x1 x2 x3)) 17 | (lambda (y1 y2 y3) y1)))))))) 18 | -------------------------------------------------------------------------------- /test/R5RS/kernighanvanwyk/ack.scm: -------------------------------------------------------------------------------- 1 | (letrec ((ack (lambda (m n) 2 | (if (= m 0) 3 | (+ n 1) 4 | (if (= n 0) 5 | (ack (- m 1) 1) 6 | (ack (- m 1) (ack m (- n 1)))))))) 7 | (ack 1 2)) 8 | -------------------------------------------------------------------------------- /test/R5RS/letrec-begin.scm: -------------------------------------------------------------------------------- 1 | (letrec ((h (lambda () 2 | '())) 3 | (i 1) 4 | (res (begin 5 | (h) 6 | i))) 7 | res) 8 | -------------------------------------------------------------------------------- /test/R5RS/loop2.scm: -------------------------------------------------------------------------------- 1 | ;; Taken from https://github.com/jensnicolay/abstractmemo 2 | ;; Expected result: 550 3 | (letrec ((lp1 (lambda (i x) 4 | (letrec ((a (= 0 i ))) 5 | (if a 6 | x 7 | (letrec ((lp2 (lambda (j f y) 8 | (letrec ((b (= 0 j ))) 9 | (if b 10 | (lp1 (- i 1 ) y ) 11 | (lp2 (- j 1 ) f (f y))))))) 12 | (lp2 10 (lambda (n) (+ n i )) x ))))))) 13 | (lp1 10 0 )) 14 | -------------------------------------------------------------------------------- /test/R5RS/mj09.scm: -------------------------------------------------------------------------------- 1 | ;; Taken from https://github.com/jensnicolay/abstractmemo 2 | ;; Expected result: 2 3 | (letrec ((h (lambda (b) 4 | (letrec ((g (lambda (z) z)) 5 | (f (lambda (k) 6 | (if b 7 | (k 1) 8 | (k 2)))) 9 | (y (f (lambda (x) x)))) 10 | (g y)))) 11 | (x (h #t)) 12 | (y (h #f))) 13 | y) 14 | -------------------------------------------------------------------------------- /test/R5RS/mut-rec.scm: -------------------------------------------------------------------------------- 1 | (letrec ((even? (lambda (x) 2 | (if (= x 0) 3 | #t 4 | (odd? (- x 1))))) 5 | (odd? (lambda (x) 6 | (if (= x 0) 7 | #f 8 | (even? (- x 1)))))) 9 | (even? 4)) 10 | -------------------------------------------------------------------------------- /test/R5RS/my-list.scm: -------------------------------------------------------------------------------- 1 | ; Expected result: 3 2 | 3 | (define (my-cons el lst) 4 | (cons el lst)) 5 | 6 | (define my-list 7 | (my-cons 1 8 | (my-cons 2 9 | (my-cons 3 '())))) 10 | 11 | my-list -------------------------------------------------------------------------------- /test/R5RS/my-test.scm: -------------------------------------------------------------------------------- 1 | (define (random-bool) 2 | (= (random 2) 0)) 3 | 4 | (define (f x) 5 | (if (random-bool) 6 | x 7 | (g (cons 'f x)))) 8 | 9 | (define (g x) 10 | (if (random-bool) 11 | x 12 | (f (cons 'g x)))) 13 | 14 | (f '()) -------------------------------------------------------------------------------- /test/R5RS/nested-defines.scm: -------------------------------------------------------------------------------- 1 | (define (f x) 2 | (define (g y) 3 | (+ x y)) 4 | (g 5)) 5 | 6 | (= (f 0) 5) 7 | -------------------------------------------------------------------------------- /test/R5RS/rosetta/quadratic.scm: -------------------------------------------------------------------------------- 1 | ;; Taken from http://rosettacode.org/wiki/Roots_of_a_quadratic_function 2 | ;; Expected result: #t 3 | 4 | (define (quadratic a b c) 5 | (if (= a 0) 6 | (if (= b 0) 'fail (- (/ c b))) 7 | (let ((delta (- (* b b) (* 4 a c)))) 8 | (if (and (real? delta) (> delta 0)) 9 | (let ((u (+ b (* (if (>= b 0) 1 -1) (sqrt delta))))) 10 | (list (/ u -2 a) (/ (* -2 c) u))) 11 | (list 12 | (/ (- (sqrt delta) b) 2 a) 13 | (/ (+ (sqrt delta) b) -2 a)))))) 14 | 15 | (let ((res1 (quadratic 0 0 1)) 16 | (exp1 'fail) 17 | (res2 (quadratic 1 2 0)) 18 | (exp2 (cons -2 (cons 0 '())))) 19 | (and (eq? res1 exp1) 20 | (equal? res2 exp2))) 21 | -------------------------------------------------------------------------------- /test/R5RS/rotate.scm: -------------------------------------------------------------------------------- 1 | ;; Taken from https://github.com/jensnicolay/abstractmemo 2 | ;; Expected result: "hallo" 3 | (letrec ((rotate (lambda (n x y z) 4 | (if (= n 0) 5 | x 6 | (rotate (- n 1) y z x))))) 7 | (rotate 41 5 #t "hallo")) 8 | -------------------------------------------------------------------------------- /test/R5RS/sat.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 p) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (p n1 n2 n3 n4)))))))))) 13 | 14 | (sat-solve-4 phi) 15 | -------------------------------------------------------------------------------- /test/R5RS/scp1/add-to-end.scm: -------------------------------------------------------------------------------- 1 | (define (add-to-end e l) 2 | (if (null? l) 3 | (cons e '()) 4 | (cons (car l) (add-to-end e (cdr l))))) 5 | 6 | (and (equal? (add-to-end 999 '(1 2 3 4 5)) '(1 2 3 4 5 999)) 7 | (equal? (add-to-end 999 '()) '(999)) 8 | (equal? (add-to-end 999 '(1)) '(1 999))) -------------------------------------------------------------------------------- /test/R5RS/scp1/addition.scm: -------------------------------------------------------------------------------- 1 | (define (1- x) (- x 1)) 2 | (define (1+ x) (+ 1 x)) 3 | 4 | (define (rec-add a b) 5 | (if (= b 0) 6 | a 7 | (1+ (rec-add a (1- b))))) 8 | 9 | (define (iter-add a b) 10 | (cond 11 | ((= a 0) b) 12 | ((< a 0) (iter-add (1+ a) (1- b))) 13 | ((> a 0) (iter-add (1- a) (1+ b))))) 14 | 15 | (= 9 16 | (rec-add 4 5) 17 | (iter-add 4 5)) 18 | -------------------------------------------------------------------------------- /test/R5RS/scp1/all-but-interval.scm: -------------------------------------------------------------------------------- 1 | (define (all-but-interval lst min max) 2 | (define (aux last-smaller-cons aux-lst) 3 | (cond 4 | ((null? aux-lst) 5 | (set-cdr! last-smaller-cons '())) 6 | ((< (car aux-lst) min) 7 | (aux aux-lst (cdr aux-lst))) 8 | ((> (car aux-lst) max) 9 | (set-cdr! last-smaller-cons aux-lst)) 10 | (else 11 | (aux last-smaller-cons (cdr aux-lst))))) 12 | (aux lst lst) 13 | lst) 14 | 15 | (and (equal? (all-but-interval '(1 2 3 4 5 6) 2 4) '(1 5 6)) 16 | (equal? (all-but-interval '(1 2 3 4 5) 2 2) '(1 3 4 5)) 17 | (equal? (all-but-interval '(1 2 5 6 7) 3 9) '(1 2))) -------------------------------------------------------------------------------- /test/R5RS/scp1/append.scm: -------------------------------------------------------------------------------- 1 | (and (equal? (append '(1 2 3) '(4 5)) '(1 2 3 4 5)) 2 | (equal? (append '(1 2 3) '()) '(1 2 3)) 3 | (equal? (append '() '(1 2 3)) '(1 2 3)) 4 | (null? (append '() '()))) 5 | -------------------------------------------------------------------------------- /test/R5RS/scp1/calc-e-and-cos.scm: -------------------------------------------------------------------------------- 1 | (define (calc-e-iter n) 2 | (define (iter ctr res fac-prev) 3 | (if (> ctr n) 4 | res 5 | (let ((new-fac (* ctr fac-prev))) 6 | (iter (+ ctr 1) (+ res (/ 1 new-fac)) new-fac)))) 7 | (iter 1 1 1)) 8 | 9 | (define (calc-cos x n) 10 | (define (iter ctr acc fac xpow sign) 11 | (if (>= ctr n) 12 | acc 13 | (let* ((i (* 2 ctr)) 14 | (newfac (* fac (- i 1) i)) 15 | (newxpow (* xpow x x)) 16 | (newsign (- sign))) 17 | (iter (+ ctr 1) 18 | (+ acc (/ (* newsign newxpow) newfac)) 19 | newfac 20 | newxpow 21 | newsign)))) 22 | (iter 1 1 1 1 1)) 23 | 24 | (define (close-to x y) 25 | (< (abs (- x y)) 0.00000001)) 26 | 27 | (and (close-to (exact->inexact (calc-e-iter 10)) 2.7182818011463845) 28 | (close-to (calc-cos 0 10) 1) 29 | (close-to (calc-cos (/ 3.1415 2) 10) 4.6326794876592664e-05) 30 | (close-to (calc-cos 3.1415 10) -0.9999999992346591)) 31 | -------------------------------------------------------------------------------- /test/R5RS/scp1/count-pairs.scm: -------------------------------------------------------------------------------- 1 | (define (count-pairs x) 2 | (if (not (pair? x)) 3 | 0 4 | (+ (count-pairs (car x)) 5 | (count-pairs (cdr x)) 6 | 1))) 7 | 8 | 9 | (define ret3 (cons 'a (cons 'b (cons 'c '())))) 10 | (define ret4 11 | (let ((last (cons 'c '()))) 12 | (cons last (cons 'b last)))) 13 | (define ret7 14 | (let* ((last (cons 'c '())) 15 | (middle (cons last last))) 16 | (cons middle middle))) 17 | 18 | (and (= (count-pairs ret3) 3) 19 | (= (count-pairs ret4) 4) 20 | (= (count-pairs ret7) 7)) -------------------------------------------------------------------------------- /test/R5RS/scp1/count-pairs2.scm: -------------------------------------------------------------------------------- 1 | (define (count-pairs lst) 2 | (let ((path '())) 3 | (define (count current) 4 | (cond 5 | ((null? current) 0) 6 | ((not (pair? current)) 0) 7 | ((memq current path) 0) 8 | (else 9 | (set! path (cons current path)) 10 | (+ 1 (count (car current)) 11 | (count (cdr current)))))) 12 | (count lst))) 13 | 14 | (define ret3 (cons 'a (cons 'b (cons 'c '())))) 15 | (define ret4 16 | (let ((last (cons 'c '()))) 17 | (cons last (cons 'b last)))) 18 | (define ret7 19 | (let* ((last (cons 'c '())) 20 | (middle (cons last last))) 21 | (cons middle middle))) 22 | (define retno 23 | (let* ((last (cons 'c '())) 24 | (lst (cons 'a (cons 'b last)))) 25 | (set-cdr! last lst) 26 | lst)) 27 | 28 | (= 3 (count-pairs ret3) (count-pairs ret4) (count-pairs ret7) (count-pairs retno)) 29 | -------------------------------------------------------------------------------- /test/R5RS/scp1/counter.scm: -------------------------------------------------------------------------------- 1 | (define result '()) 2 | (define output (lambda (i) (set! result (cons i result)))) 3 | 4 | (define (count1 x) 5 | (cond ((= 0 x) (display x)) 6 | (else (display x) 7 | (count1 (- x 1))))) 8 | 9 | (define (count2 x) 10 | (cond ((= 0 x) (display x)) 11 | (else (count2 (- x 1)) 12 | (display x)))) 13 | 14 | (count1 4) 15 | (count2 4) 16 | (equal? result '(4 3 2 1 0 0 1 2 3 4)) -------------------------------------------------------------------------------- /test/R5RS/scp1/dedouble.scm: -------------------------------------------------------------------------------- 1 | (define (ontdubbel! lijst) 2 | (let ((deEven '()) 3 | (deOneven '())) 4 | (define (ontdubbel-iter prevE prevO restLijst) 5 | (cond ((null? restLijst) (set-cdr! prevE '()) 6 | (set-cdr! prevO '()) 7 | (cons deEven deOneven)) 8 | ((even? (car restLijst)) 9 | (if (null? prevE) 10 | (set! deEven restLijst) 11 | (set-cdr! prevE restLijst)) 12 | (ontdubbel-iter restLijst prevO (cdr restLijst))) 13 | (else (if (null? prevO) 14 | (set! deOneven restLijst) 15 | (set-cdr! prevO restLijst)) 16 | (ontdubbel-iter prevE restLijst (cdr restLijst))))) 17 | (ontdubbel-iter deEven deOneven lijst))) 18 | 19 | (equal? (ontdubbel! '(1 2 3 4 5 6 7 8 9 10)) '((2 4 6 8 10) 1 3 5 7 9)) -------------------------------------------------------------------------------- /test/R5RS/scp1/deep-map-combine.scm: -------------------------------------------------------------------------------- 1 | (define (atom? x) 2 | (not (pair? x))) 3 | 4 | (define (deep-combine combiner null-value l) 5 | (cond ((null? l) null-value) 6 | ((atom? l) l) 7 | (else (combiner (deep-combine combiner 8 | null-value 9 | (car l)) 10 | (deep-combine combiner 11 | null-value 12 | (cdr l)))))) 13 | 14 | (define (deep-map f l) 15 | (cond 16 | ((null? l) '()) 17 | ((atom? l) (f l)) 18 | (else (cons (deep-map f (car l)) 19 | (deep-map f (cdr l)))))) 20 | 21 | (and (= (deep-combine + 0 '((((1 2) (3 4)) ((5 6) (7 8))) 9)) 45) 22 | (equal? (deep-map (lambda (x) (* x x)) '((((1 . 2) (3 4)) ((5 6) (7 8))) . 9)) 23 | '((((1 . 4) (9 16)) ((25 36) (49 64))) . 81))) -------------------------------------------------------------------------------- /test/R5RS/scp1/fast-multiply.scm: -------------------------------------------------------------------------------- 1 | (define (double x) (+ x x)) 2 | (define (halve x) (/ x 2)) 3 | 4 | (define (rec-fast-multiply a b) 5 | (cond ((zero? b) 0) 6 | ((even? b) (rec-fast-multiply (double a) (halve b))) 7 | (else (+ a (rec-fast-multiply a (- b 1)))))) 8 | 9 | (define (iter-fast-multiply a b) 10 | (define (iter a b acc) 11 | (cond ((zero? b) acc) 12 | ((even? b) (iter (double a) (halve b) acc)) 13 | (else (iter a (- b 1) (+ acc a))))) 14 | (iter a b 0)) 15 | 16 | (and (= (rec-fast-multiply 3 4) 12) 17 | (= (rec-fast-multiply 100 200) 20000) 18 | (= (iter-fast-multiply 3 4) 12) 19 | (= (iter-fast-multiply 100 200) 20000)) -------------------------------------------------------------------------------- /test/R5RS/scp1/find-cycles.scm: -------------------------------------------------------------------------------- 1 | (define ret4 2 | (let ((last (cons 'c '()))) 3 | (cons last (cons 'b last)))) 4 | (define ret7 5 | (let* ((last (cons 'c '())) 6 | (middle (cons last last))) 7 | (cons middle middle))) 8 | (define retno 9 | (let* ((last (cons 'c '())) 10 | (lst (cons 'a (cons 'b last)))) 11 | (set-cdr! last lst) 12 | lst)) 13 | 14 | (define (cycles? lst) 15 | (define (find-cycles? current path) 16 | (cond 17 | ((null? current) #f) 18 | ((memq current path) #t) 19 | (else (find-cycles? (cdr current) 20 | (cons current path))))) 21 | (find-cycles? lst '())) 22 | 23 | (and (not (cycles? '())) 24 | (not (cycles? '(1 2 3))) 25 | (not (cycles? ret4)) 26 | (cycles? retno) 27 | (not (cycles? ret7)) 28 | (cycles? (cons 'a (cons 'b retno)))) 29 | -------------------------------------------------------------------------------- /test/R5RS/scp1/flip.scm: -------------------------------------------------------------------------------- 1 | (define flip 2 | (let ((state 0)) 3 | (lambda () 4 | (if (= state 0) 5 | (set! state 1) 6 | (set! state 0)) 7 | state))) 8 | 9 | (and (= (flip) 1) 10 | (= (flip) 0) 11 | (= (flip) 1) 12 | (= (flip) 0)) -------------------------------------------------------------------------------- /test/R5RS/scp1/flip2.scm: -------------------------------------------------------------------------------- 1 | (define (make-flip) 2 | (let ((state 0)) 3 | (lambda () 4 | (if (= state 0) 5 | (set! state 1) 6 | (set! state 0)) 7 | state))) 8 | 9 | (define flip (make-flip)) 10 | 11 | (and (= (flip) 1) 12 | (= (flip) 0) 13 | (= (flip) 1) 14 | (= (flip) 0)) -------------------------------------------------------------------------------- /test/R5RS/scp1/fringe.scm: -------------------------------------------------------------------------------- 1 | (define (atom? x) 2 | (not (pair? x))) 3 | 4 | (define (fringe l) 5 | (cond ((null? l) '()) 6 | ((atom? l) (list l)) 7 | (else (append (fringe (car l)) 8 | (fringe (cdr l)))))) 9 | 10 | (equal? (fringe '((1) ((((2)))) (3 (4 5) 6) ((7) 8 9))) '(1 2 3 4 5 6 7 8 9)) 11 | -------------------------------------------------------------------------------- /test/R5RS/scp1/grades.scm: -------------------------------------------------------------------------------- 1 | (define (show namen punten test?) 2 | (if (null? namen) 3 | '() 4 | (let ((res (show (cdr namen) (cdr punten) test?))) 5 | (if (test? (car punten)) 6 | (cons (car namen) res) 7 | res)))) 8 | 9 | (define (one namen punten) 10 | (define (één-buis? punten) 11 | (if (null? punten) 12 | #f 13 | (let ((punt (car punten)) 14 | (rest (cdr punten))) 15 | (if (< punt 10) 16 | (geen-buis? rest) 17 | (één-buis? rest))))) 18 | 19 | 20 | (define (geen-buis? punten) 21 | (if (null? punten) 22 | #t 23 | (let ((punt (car punten)) 24 | (rest (cdr punten))) 25 | (if (< punt 10) 26 | #f 27 | (geen-buis? rest))))) 28 | 29 | (show namen punten één-buis?)) 30 | 31 | (equal? (one '(wendy dirk kris jan eef) 32 | '((12 13 15 18) (7 10 14 17) (13 8 7 11) 33 | (9 12 11 10) (18 14 17 19))) 34 | '(dirk jan)) -------------------------------------------------------------------------------- /test/R5RS/scp1/haha.scm: -------------------------------------------------------------------------------- 1 | (define result '()) 2 | (define output (lambda (i) (set! result (cons i result)))) 3 | 4 | (define hulp 2) 5 | (define (haha x) 6 | (let ((hulp (* x hulp))) 7 | (output hulp)) 8 | (output hulp) 9 | (set! hulp 4)) 10 | 11 | (haha 2) 12 | (haha 3) 13 | (equal? result '(4 12 2 4)) -------------------------------------------------------------------------------- /test/R5RS/scp1/insert.scm: -------------------------------------------------------------------------------- 1 | (define (insert-aux! lst lst2) 2 | (set-cdr! lst2 '()) 3 | (if (null? (cdr lst)) 4 | (set-cdr! lst lst2) 5 | (insert-aux! (cdr lst) lst2)) 6 | lst) 7 | 8 | (define (insert! lst1 lst2) 9 | (if (not (null? lst1)) 10 | (begin 11 | (insert! (cdr lst1) (cdr lst2)) 12 | (insert-aux! (car lst1) lst2) 13 | lst1))) 14 | 15 | (and (equal? (insert-aux! '(a 12 q) '(v w x y z)) '(a 12 q v)) 16 | (equal? (insert! '((a 12 q) (b 13) (c 14 r s) (f 18) (j 22 t)) '(v w x y z)) 17 | '((a 12 q v) (b 13 w) (c 14 r s x) (f 18 y) (j 22 t z)))) -------------------------------------------------------------------------------- /test/R5RS/scp1/leap-year.scm: -------------------------------------------------------------------------------- 1 | (define (sign number) 2 | (cond ((zero? number) 0) 3 | ((> number 0) 1) 4 | (else -1))) 5 | 6 | (define (divides? deler deeltal) 7 | (= 0 (modulo deeltal deler))) 8 | 9 | (define (leap-year? year) 10 | (if (divides? 4 year) 11 | (if (divides? 100 year) 12 | (divides? 400 year) 13 | #t) 14 | #f)) 15 | 16 | (define (leap-year2? year) 17 | (cond ((divides? 400 year) #t) 18 | ((divides? 100 year) #f) 19 | ((divides? 4 year) #t) 20 | (else #f))) 21 | 22 | (define (leap-year3? year) 23 | (if (divides? 400 year) 24 | #t 25 | (if (divides? 100 year) 26 | #f 27 | (divides? 4 year)))) 28 | 29 | 30 | (define (leap-year4? year) 31 | (or (divides? 400 year) 32 | (and (divides? 4 year) 33 | (not (divides? 100 year))))) 34 | 35 | 36 | (and (not (or (leap-year? 1989) 37 | (leap-year? 1900))) 38 | (leap-year? 2000) 39 | (= -1 (sign -5)) 40 | (= 1 (sign 17.28)) 41 | (= 0 (sign 0))) -------------------------------------------------------------------------------- /test/R5RS/scp1/multiply.scm: -------------------------------------------------------------------------------- 1 | (define (rec-multiply a b) 2 | (if (zero? b) 3 | 0 4 | (+ a (rec-multiply a (- b 1))))) 5 | 6 | (define (iter-multiply a b) 7 | (define (iter result counter) 8 | (if (zero? counter) 9 | result 10 | (iter (+ result a) (- counter 1)))) 11 | (iter 0 b)) 12 | 13 | (= 10 14 | (rec-multiply 5 2) 15 | (iter-multiply 5 2)) -------------------------------------------------------------------------------- /test/R5RS/scp1/print-abc.scm: -------------------------------------------------------------------------------- 1 | (define result '()) 2 | (define output (lambda (i) (set! result (cons i result)))) 3 | (define linebreak (lambda () (set! result (cons 'linebreak result)))) 4 | 5 | (define (print-abc a b c) 6 | (output a) (output " ") 7 | (output b) (output " ") 8 | (output c) (linebreak)) 9 | 10 | (define (foo a b c) 11 | (print-abc a b c) 12 | (let ((a 4) 13 | (c 5) 14 | (b c)) 15 | (print-abc a b c) 16 | (let ((b 6) 17 | (c a)) 18 | (print-abc a b c)) 19 | (let ((a b) 20 | (c a)) 21 | (print-abc a b c))) 22 | (print-abc a b c)) 23 | 24 | (foo 1 2 3) 25 | (equal? result '(linebreak 3 " " 2 " " 1 linebreak 4 " " 3 " " 3 linebreak 4 " " 6 " " 4 linebreak 5 " " 3 " " 4 linebreak 3 " " 2 " " 1)) -------------------------------------------------------------------------------- /test/R5RS/scp1/ring-rotate.scm: -------------------------------------------------------------------------------- 1 | (define result '()) 2 | (define output (lambda (i) (set! result (cons i result)))) 3 | 4 | (define (make-ring n) 5 | (let ((last (cons 0 '()))) 6 | (define (build-list n) 7 | (if (= n 0) 8 | last 9 | (cons n (build-list (- n 1))))) 10 | (let ((ring (build-list n))) 11 | (set-cdr! last ring) 12 | ring))) 13 | 14 | (define (print-ring r) 15 | (define (aux l) 16 | (if (not (null? l)) 17 | (if (eq? (cdr l) r) 18 | (begin (output " ") 19 | (output (car l)) 20 | (output "...")) 21 | (begin (output " ") 22 | (output (car l)) 23 | (aux (cdr l)))))) 24 | (aux r) 25 | #t) 26 | 27 | (define (right-rotate r) 28 | (define (iter l) 29 | (if (eq? (cdr l) r) 30 | l 31 | (iter (cdr l)))) 32 | (iter r)) 33 | 34 | (define r (make-ring 3)) 35 | (print-ring (right-rotate r)) 36 | (equal? result '("..." 1 " " 2 " " 3 " " 0 " ")) -------------------------------------------------------------------------------- /test/R5RS/scp1/ring-squares.scm: -------------------------------------------------------------------------------- 1 | (define result '()) 2 | (define output (lambda (i) (set! result (cons i result)))) 3 | 4 | (define (kw-lijst lst) 5 | (define (loop l) 6 | (let ((rest (cdr l)) 7 | (n (list (* (car l) (car l))))) 8 | (set-cdr! l n) 9 | (set-cdr! n rest) 10 | (if (not (eq? rest lst)) 11 | (loop rest)))) 12 | (loop lst) 13 | lst) 14 | 15 | (define (print-ring r) 16 | (define (aux l) 17 | (if (not (null? l)) 18 | (if (eq? (cdr l) r) 19 | (begin (output " ") 20 | (output (car l)) 21 | (output "...")) 22 | (begin (output " ") 23 | (output (car l)) 24 | (aux (cdr l)))))) 25 | (aux r) 26 | #t) 27 | 28 | (define last-cons (cons 3 '())) 29 | (define test-lst (cons 1 (cons 4 last-cons))) 30 | (set-cdr! last-cons test-lst) 31 | (print-ring (kw-lijst test-lst)) 32 | (equal? result '("..." 9 " " 3 " " 16 " " 4 " " 1 " " 1 " ")) -------------------------------------------------------------------------------- /test/R5RS/scp1/ring.scm: -------------------------------------------------------------------------------- 1 | (define result '()) 2 | (define output (lambda (i) (set! result (cons i result)))) 3 | 4 | (define (make-ring n) 5 | (let ((last (cons 0 '()))) 6 | (define (build-list n) 7 | (if (= n 0) 8 | last 9 | (cons n (build-list (- n 1))))) 10 | (let ((ring (build-list n))) 11 | (set-cdr! last ring) 12 | ring))) 13 | 14 | (define (print-ring r) 15 | (define (aux l) 16 | (if (not (null? l)) 17 | (if (eq? (cdr l) r) 18 | (begin (output " ") 19 | (output (car l)) 20 | (output "...")) 21 | (begin (output " ") 22 | (output (car l)) 23 | (aux (cdr l)))))) 24 | (aux r) 25 | #t) 26 | 27 | 28 | (define r (make-ring 3)) 29 | (print-ring r) 30 | (print-ring (cdr r)) 31 | (equal? result '("..." 3 " " 0 " " 1 " " 2 " " "..." 0 " " 1 " " 2 " " 3 " ")) -------------------------------------------------------------------------------- /test/R5RS/scp1/same-structure.scm: -------------------------------------------------------------------------------- 1 | (define (atom? x) 2 | (not (pair? x))) 3 | 4 | (define (same-structure? l1 l2) 5 | (cond ((and (atom? l1) (atom? l2)) #t) 6 | ((or (atom? l1) (atom? l2)) #f) 7 | (else (and (same-structure? (car l1) (car l2)) 8 | (same-structure? (cdr l1) (cdr l2)))))) 9 | 10 | (define (same-structure?-or l1 l2) 11 | (or (and (atom? l1) (atom? l2)) 12 | (and (pair? l1) 13 | (pair? l2) 14 | (same-structure?-or (car l1) (car l2)) 15 | (same-structure?-or (cdr l1) (cdr l2))))) 16 | 17 | (and (same-structure? '((1 2) ((3 . 4) ((5 6) ((7 8) (9))))) 18 | '((a b) ((c . d) ((e f) ((g h) (i)))))) 19 | (not (same-structure? '((1 2) ((3 4) ((5 6) ((7 8) (9))))) 20 | '((((1 2) (3 4)) ((5 6) (7 8))) 9)))) -------------------------------------------------------------------------------- /test/R5RS/scp1/sim-fast-multiply.scm: -------------------------------------------------------------------------------- 1 | (define (double x) (+ x x)) 2 | (define (halve x) (/ x 2)) 3 | (define (sim-multiply a b) 4 | (if (zero? b) 5 | 1 6 | (+ 1 (sim-multiply a (- b 1))))) 7 | (define (sim-fast-multiply a b) 8 | (cond ((zero? b) 1) 9 | ((even? b) (+ 1 (sim-fast-multiply (double a) (halve b)))) 10 | (else (+ 1 (sim-fast-multiply a (- b 1)))))) 11 | 12 | (and (= (sim-multiply 14 2365) 2366) 13 | (= (sim-fast-multiply 14 2365) 19)) -------------------------------------------------------------------------------- /test/R5RS/scp1/simpson-integral.scm: -------------------------------------------------------------------------------- 1 | (define (incr x) (+ x 1)) 2 | (define (sum term a next b) 3 | (if (> a b) 4 | 0 5 | (+ (term a) (sum term (next a) next b)))) 6 | 7 | (define (simp-int f a b n) 8 | (let ((h (/ (- b a) n))) 9 | (define (y k) (f (+ a (* h k)))) 10 | (define (term k) 11 | (* (if (or (= k 0)(= k n)) 1 (+ 2 (* 2 (modulo k 2)))) 12 | (y k))) 13 | (/ (* h (sum term 0 incr n)) 3))) 14 | 15 | (define r (sqrt 2)) 16 | (and (= (simp-int (lambda (x) x) 0 10 100) 50) 17 | (= (simp-int (lambda (x) (sqrt (- (* r r) (* x x)))) (- r) r 100) 3.1402925778303366)) 18 | -------------------------------------------------------------------------------- /test/R5RS/scp1/slide-in.scm: -------------------------------------------------------------------------------- 1 | (define (schuif-in! l1 l2) 2 | (cond ((null? (cdr l1)) (set-cdr! l1 l2) 'ok) 3 | ((null? l2) 'ok) 4 | (else 5 | (let ((rest1 (cdr l1)) (rest2 (cdr l2))) 6 | (set-cdr! l1 l2) 7 | (set-cdr! l2 rest1) 8 | (schuif-in! rest1 rest2))))) 9 | 10 | (define lijst1 '(1 3 5)) 11 | (define lijst2 '(2 4 6 8)) 12 | (schuif-in! lijst1 lijst2) 13 | (equal? lijst1 '(1 2 3 4 5 6 8)) -------------------------------------------------------------------------------- /test/R5RS/scp1/square-and-rectangle.scm: -------------------------------------------------------------------------------- 1 | (define (maak-rechthoek l b) 2 | (define (oppervlakte) (* l b)) 3 | (define (omtrek) (* 2 (+ l b))) 4 | (define (dispatch m) 5 | (cond ((eq? m 'oppervlakte) (oppervlakte)) 6 | ((eq? m 'omtrek) (omtrek)))) 7 | dispatch) 8 | 9 | (define (maak-vierkant zijde) 10 | (define rechthoek (maak-rechthoek zijde zijde)) 11 | (define (schaal! n) (set! zijde (* n zijde))) 12 | (define (dispatch m) 13 | (cond ((eq? m 'oppervlakte) (rechthoek 'oppervlakte)) 14 | ((eq? m 'omtrek) (rechthoek 'omtrek)) 15 | ((eq? m 'schaal!) schaal!))) 16 | dispatch) 17 | 18 | (define test (maak-vierkant 5)) 19 | (and (= (test 'oppervlakte) 25) 20 | (= (test 'omtrek) 20) 21 | (= (begin ((test 'schaal!) 2) 22 | (test 'oppervlakte)) 23 | 25)) -------------------------------------------------------------------------------- /test/R5RS/scp1/third-root.scm: -------------------------------------------------------------------------------- 1 | (define (derde-machtswortel x) 2 | (define epsilon 0.01) 3 | (define (hulp-derde-machtswortel y) 4 | (if (< (abs (- (* y y y) x)) epsilon) 5 | y 6 | (hulp-derde-machtswortel (/ (+ (/ x (* y y)) y y) 3)))) 7 | (hulp-derde-machtswortel (/ x 3))) 8 | 9 | (= 3.000000068671529 (exact->inexact (derde-machtswortel 27))) -------------------------------------------------------------------------------- /test/R5RS/scp1/unfringe.scm: -------------------------------------------------------------------------------- 1 | (define (unfringe-1 l) 2 | (cond ((null? l) '()) 3 | ((null? (cdr l)) (list (car l))) 4 | (else (list (car l) 5 | (unfringe-1 (cdr l)))))) 6 | 7 | (define (unfringe-2 l) 8 | (define (pair l) 9 | (cond ((null? l) '()) 10 | ((null? (cdr l)) (list l)) 11 | (else (cons (list (car l) (cadr l)) 12 | (pair (cddr l)))))) 13 | 14 | (let loop ((l l)) 15 | (if (or (null? l) 16 | (null? (cdr l))) 17 | l 18 | (loop (pair l))))) 19 | 20 | (and (equal? (unfringe-1 '(1 2 3 4 5 6 7 8 9)) '(1 (2 (3 (4 (5 (6 (7 (8 (9)))))))))) 21 | (equal? (unfringe-2 '(1 2 3 4 5 6 7 8 9)) '(((((1 2) (3 4)) ((5 6) (7 8))) (((9))))))) -------------------------------------------------------------------------------- /test/R5RS/scp1/weird.scm: -------------------------------------------------------------------------------- 1 | (define result '()) 2 | (define output (lambda (i) (set! result (cons i result)))) 3 | 4 | (define (weird x) 5 | (cond 6 | ((= x 1) 1) 7 | ((even? x) (weird (/ x 2))) 8 | (else (weird (+ (* 3 x) 1))))) 9 | 10 | (define (depth-weird x) 11 | (cond 12 | ((= x 1) 0) 13 | ((even? x) (+ 1 (depth-weird (/ x 2)))) 14 | (else (+ (depth-weird (+ (* 3 x) 1)) 1)))) 15 | 16 | (define (weird-table min max) 17 | (cond 18 | ((< min max) 19 | (for-each output (list min "\t" (depth-weird min) "\n")) 20 | (weird-table (+ min 1) max)))) 21 | 22 | (weird-table 1 10) 23 | 24 | (and (= (weird 15) 1) 25 | (= (depth-weird 15) 17) 26 | (equal? result '("\n" 19 "\t" 9 "\n" 3 "\t" 8 "\n" 16 "\t" 7 "\n" 8 "\t" 6 "\n" 5 "\t" 5 "\n" 2 "\t" 4 "\n" 7 "\t" 3 "\n" 1 "\t" 2 "\n" 0 "\t" 1))) 27 | -------------------------------------------------------------------------------- /test/R5RS/sigscheme/arithint.scm: -------------------------------------------------------------------------------- 1 | (define *max* 20001) 2 | 3 | (define (test x y) 4 | (if (= x *max*) 5 | x 6 | (test (- x (+ (* y 2) (/ x (abs y)))) 7 | (- y (+ (* x 2) (/ y (abs x))))))) 8 | 9 | (test 1 1) -------------------------------------------------------------------------------- /test/R5RS/sigscheme/case.scm: -------------------------------------------------------------------------------- 1 | (define loop 2 | (lambda (i l) 3 | (case 6 4 | ((1 2 3 4 5) #f) 5 | ((6) 6 | (if (< i l) 7 | (loop (+ 1 i) l) 8 | l))))) 9 | 10 | (loop 0 20000) -------------------------------------------------------------------------------- /test/R5RS/sigscheme/let-loop.scm: -------------------------------------------------------------------------------- 1 | (define loop 2 | (lambda (i l) 3 | (let ((a 0) 4 | (b 1) 5 | (c 2)) 6 | (if (< i l) 7 | (loop (+ 1 i) l) 8 | l)))) 9 | 10 | (loop 0 20000) -------------------------------------------------------------------------------- /test/R5RS/sigscheme/loop.scm: -------------------------------------------------------------------------------- 1 | (define loop 2 | (lambda (i l) 3 | (if (< i l) 4 | (loop (+ 1 i) l) 5 | l))) 6 | 7 | (loop 0 8000) -------------------------------------------------------------------------------- /test/R5RS/sigscheme/rec.scm: -------------------------------------------------------------------------------- 1 | (define (test f g n) 2 | (if (= n 0) 3 | f 4 | (let ((m (- n 1))) 5 | ((f g f m) f g m) 6 | ((g f g m) g f m) 7 | g))) 8 | 9 | (equal? (test test test 10) test) -------------------------------------------------------------------------------- /test/R5RS/splitargs.scm: -------------------------------------------------------------------------------- 1 | (define (sanity-check x) (eq? x x)) ;should always be #t 2 | (define (random-bool) 3 | (= (random 2) 0)) ;50/50 change to get #t or #f here (to simulate some non-determinism) 4 | (sanity-check (random-bool)) -------------------------------------------------------------------------------- /test/R5RS/sq.scm: -------------------------------------------------------------------------------- 1 | (let ((sq (lambda (x) (* x x)))) 2 | (sq 2) 3 | (sq 3)) 4 | -------------------------------------------------------------------------------- /test/R5RS/sym.scm: -------------------------------------------------------------------------------- 1 | (let ((x 'foo)) 2 | x) 3 | -------------------------------------------------------------------------------- /test/R5RS/test.scm: -------------------------------------------------------------------------------- 1 | (define (f x) x) 2 | 3 | (define x 1) 4 | (set! x "hello") 5 | (f x) -------------------------------------------------------------------------------- /test/R5RS/widen.scm: -------------------------------------------------------------------------------- 1 | (letrec ((g (lambda () 2 | 1)) 3 | (f (lambda (n) 4 | (if (= n 0) 5 | 0 6 | (+ (f (- n 1)) (g)))))) 7 | (f 10)) 8 | -------------------------------------------------------------------------------- /test/changes/README.md: -------------------------------------------------------------------------------- 1 | # Scala-AM Incremental Benchmark Suite 2 | 3 | This directory contains the Scala-AM Incremental Benchmark suite. 4 | This suite contains programs annotated with changes, originally taken from the main benchmark suite. 5 | 6 | To execute these programs in a standard Scheme interpreter, macros can be used. 7 | 8 | * To execute the original program: 9 | ```scheme 10 | (define-syntax 11 | (syntax-rules () 12 | (( x y) x))) 13 | ``` 14 | * To execute the modified program: 15 | ```scheme 16 | (define-syntax 17 | (syntax-rules () 18 | (( x y) y))) 19 | ``` -------------------------------------------------------------------------------- /test/changes/cscheme/threads/lastzero.scm: -------------------------------------------------------------------------------- 1 | ;; Example taken from Optimal Dynamic Partial Order Reduction, Figure 4 2 | (let* ((n 2) 3 | (array (make-vector (+ n 1) 0))) 4 | (letrec ((thread0 (lambda (i) 5 | (if (= (vector-ref array i) 0) 6 | i 7 | (thread0 (- i 1))))) 8 | (thread (lambda (j) 9 | (vector-set! array j (+ 1 (vector-ref array (- j 1))))))) 10 | (let ((t1 ( (thread 1) (fork (thread 1)))) ; <============================================================== 11 | (t2 (thread 2))) 12 | (thread0 n) 13 | ( t1 (join t1)) ; <======================================================================================= 14 | t2))) 15 | -------------------------------------------------------------------------------- /test/changes/scheme/baseline.scm: -------------------------------------------------------------------------------- 1 | (let ((square (lambda (x) (* x x))) 2 | (double (lambda (x) (+ x x)))) 3 | (let ((a (square 10)) 4 | (b (( square double) 20)) 5 | (c (square 30))) 6 | (+ a b c))) -------------------------------------------------------------------------------- /test/changes/scheme/collatz.scm: -------------------------------------------------------------------------------- 1 | (define (div2* n s) 2 | (if (= (* 2 n) s) 3 | n 4 | (if (= (+ (* 2 n) 1) s) 5 | n 6 | (div2* (- n 1) s)))) 7 | (define (div2 n) 8 | (div2* n n)) 9 | (define (hailstone* n count) 10 | (if (= n 1) 11 | ( count (+ count 1 -1)) 12 | (if (even? n) 13 | (hailstone* (div2 n) (+ count 1)) 14 | (hailstone* (+ (* 3 n) 1) 15 | (+ count 1))))) 16 | (define (hailstone n) 17 | (hailstone* n 0)) 18 | (hailstone 5) 19 | -------------------------------------------------------------------------------- /test/changes/scheme/fact.scm: -------------------------------------------------------------------------------- 1 | (letrec ((fact (lambda (n) 2 | (if ( (= n 0) (< n 2)) 3 | 1 4 | (* n (fact (- n 1))))))) 5 | (fact 3)) 6 | -------------------------------------------------------------------------------- /test/changes/scheme/fib.scm: -------------------------------------------------------------------------------- 1 | (letrec ((fib (lambda (n) 2 | (if (< n 2) 3 | n 4 | (+ (fib (- n ( 1 2))) (fib (- n ( 2 1)))))))) 5 | (fib 4)) 6 | -------------------------------------------------------------------------------- /test/changes/scheme/gcipd.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (n) 2 | (if (<= n 1) 3 | 1 4 | (* n (f (- n 1)))))) 5 | (g (lambda (n) 6 | (if (<= n 1) 7 | 1 8 | (+ (* n n) (g (- n 1))))))) 9 | (+ (( g f) 2) (( f g) 2))) -------------------------------------------------------------------------------- /test/changes/scheme/sat.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 p) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (p ( n1 n4) 13 | ( n2 n3) 14 | ( n3 n2) 15 | ( n4 n1))))))))))) 16 | (sat-solve-4 phi) -------------------------------------------------------------------------------- /test/changes/scheme/satCoarse.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | ( 3 | (and (or x1 (not x2) (not x3)) 4 | (or (not x2) (not x3)) 5 | (or x4 x2)) 6 | (and (or x1 (not x2) (not x3) (not x4)) 7 | (or x2 (not x3)) 8 | (or (not x1) x4 x2)))) 9 | (define (try f) 10 | (or (f #t) (f #f))) 11 | (define (sat-solve-4 pred) 12 | (try (lambda (n1) 13 | (try (lambda (n2) 14 | (try (lambda (n3) 15 | (try (lambda (n4) 16 | (pred n1 n2 n3 n4)))))))))) 17 | (sat-solve-4 phi) 18 | -------------------------------------------------------------------------------- /test/changes/scheme/satFine.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3) ( #t (not x4))) 3 | (or ( (not x2) x2) (not x3)) 4 | (or ( #f (not x1)) x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 pred) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (pred n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changes/scheme/satMiddle.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and ( (or x1 (not x2) (not x3)) 3 | (or x1 (not x2) (not x3) (not x4))) 4 | ( (or (not x2) (not x3)) 5 | (or x2 (not x3))) 6 | ( (or x4 x2) 7 | (or (not x1) x4 x2)))) 8 | (define (try f) 9 | (or (f #t) (f #f))) 10 | (define (sat-solve-4 pred) 11 | (try (lambda (n1) 12 | (try (lambda (n2) 13 | (try (lambda (n3) 14 | (try (lambda (n4) 15 | (pred n1 n2 n3 n4)))))))))) 16 | (sat-solve-4 phi) 17 | -------------------------------------------------------------------------------- /test/changes/scheme/satRem.scm: -------------------------------------------------------------------------------- 1 | (define phi 2 | ( (lambda (x1 x2 x3 x4) 3 | (and (or x1 (not x2) (not x3)) 4 | (or (not x2) (not x3)) 5 | (or x4 x2))) 6 | (lambda (x1 x2 x3) 7 | (and (or x1 (not x2) (not x3)) 8 | (or (not x2) (not x3)) 9 | (or x2))))) 10 | (define (try f) 11 | (or (f #t) (f #f))) 12 | (define (sat-solve-4 p) 13 | (try (lambda (n1) 14 | (try (lambda (n2) 15 | (try (lambda (n3) 16 | ( 17 | (try (lambda (n4) 18 | (p n1 n2 n3 n4))) 19 | (p n1 n2 n3))))))))) 20 | (sat-solve-4 phi) 21 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/baseline-1.scm: -------------------------------------------------------------------------------- 1 | (let ((square (lambda (x) (* x x))) 2 | (double (lambda (x) (+ x x)))) 3 | (let ((a (square 10)) 4 | (b (square 20)) 5 | (c (square 30))) 6 | (+ a b c))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/baseline-2.scm: -------------------------------------------------------------------------------- 1 | (let ((square (lambda (x) (* x x))) 2 | (double (lambda (x) (+ x x)))) 3 | (let ((a (square 10)) 4 | (b (double 20)) 5 | (c (square 30))) 6 | (+ a b c))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/church-2-num-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((zero (lambda (f x) x)) 2 | (inc (lambda (n) 3 | (lambda (f x) 4 | (f (n f x))))) 5 | (plus (lambda (m n) 6 | (lambda (f x) 7 | (m f (n f x)))))) 8 | ((inc (inc zero)) (lambda (x) (+ x 1)) 0)) 9 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/church-2-num-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((zero (lambda (f x) x)) 2 | (inc (lambda (n) 3 | (lambda (f x) 4 | (f (n f x))))) 5 | (plus (lambda (m n) 6 | (lambda (f x) 7 | (m f (n f x)))))) 8 | ((inc (inc zero)) (lambda (x) (+ x 1)) 0)) 9 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/collatz-1.scm: -------------------------------------------------------------------------------- 1 | (define (div2* n s) 2 | (if (= (* 2 n) s) 3 | n 4 | (if (= (+ (* 2 n) 1) s) 5 | n 6 | (div2* (- n 1) s)))) 7 | (define (div2 n) 8 | (div2* n n)) 9 | (define (hailstone* n count) 10 | (if (= n 1) 11 | count 12 | (if (even? n) 13 | (hailstone* (div2 n) (+ count 1)) 14 | (hailstone* (+ (* 3 n) 1) 15 | (+ count 1))))) 16 | (define (hailstone n) 17 | (hailstone* n 0)) 18 | (hailstone 5) 19 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/collatz-2.scm: -------------------------------------------------------------------------------- 1 | (define (div2* n s) 2 | (if (= (* 2 n) s) 3 | n 4 | (if (= (+ (* 2 n) 1) s) 5 | n 6 | (div2* (- n 1) s)))) 7 | (define (div2 n) 8 | (div2* n n)) 9 | (define (hailstone* n count) 10 | (if (= n 1) 11 | (+ count 1 -1) 12 | (if (even? n) 13 | (hailstone* (div2 n) (+ count 1)) 14 | (hailstone* (+ (* 3 n) 1) 15 | (+ count 1))))) 16 | (define (hailstone n) 17 | (hailstone* n 0)) 18 | (hailstone 5) 19 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/collatzBounded0-1.scm: -------------------------------------------------------------------------------- 1 | (define (div2* n s) 2 | (if (= (* 2 n) s) 3 | n 4 | (if (= (+ (* 2 n) 1) s) 5 | n 6 | (div2* (- n 1) s)))) 7 | (define (div2 n) 8 | (div2* n n)) 9 | (define (hailstone* n count) 10 | (if (= n 1) 11 | count 12 | (if (even? n) 13 | (hailstone* (div2 n) (+ count 1)) 14 | (hailstone* (+ (* 3 n) 1) 15 | (+ count 1))))) 16 | (define (hailstone n) 17 | (hailstone* n 0)) 18 | (hailstone 5) 19 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/collatzBounded0-2.scm: -------------------------------------------------------------------------------- 1 | (define (div2* n s) 2 | (if (= (* 2 n) s) 3 | n 4 | (if (= (+ (* 2 n) 1) s) 5 | n 6 | (div2* (- n 1) s)))) 7 | (define (div2 n) 8 | (div2* n n)) 9 | (define (hailstone* n count) 10 | (if (= n 1) 11 | (+ count 1 -1) 12 | (if (even? n) 13 | (hailstone* (div2 n) (+ count 1)) 14 | (hailstone* (+ (* 3 n) 1) 15 | (+ count 1))))) 16 | (define (hailstone n) 17 | (hailstone* n 0)) 18 | (hailstone 5) 19 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/countA-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((count (lambda (n) (if (= n 0) "done" (count (- n 1)))))) 2 | (count 10)) 3 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/countA-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((count (lambda (n) (if (= n 0) "done" (count (- n 1)))))) 2 | (count 8)) 3 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/countB-1.scm: -------------------------------------------------------------------------------- 1 | (let ((input 10)) 2 | (letrec ((count (lambda (n) (if (= n 0) "done" (count (- n 1)))))) 3 | (count input))) 4 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/countB-2.scm: -------------------------------------------------------------------------------- 1 | (let ((input 10)) 2 | (letrec ((count2 (lambda (n) (if (= n 0) "done" (count2 (- n 1)))))) 3 | (count2 input))) 4 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/countC-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((count (lambda (n) (if (= n 0) "done" (count (- n 1))))) 2 | (count-alias (lambda (n) (count n)))) 3 | (count 10)) 4 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/countC-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((count (lambda (n) (if (= n 0) "done" (count (- n 1))))) 2 | (count-alias (lambda (n) (count n)))) 3 | (count-alias 10)) 4 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/countD-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((count (lambda (n) (if (= n 0) "done" (count (- n 1)))))) 2 | (count 10)) -------------------------------------------------------------------------------- /test/changesBenevolPaper/countD-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((count (lambda (n) (if (= n 0) #f (count (- n 1)))))) 2 | (count 10)) -------------------------------------------------------------------------------- /test/changesBenevolPaper/eta-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((do-something (lambda () 10)) 2 | (id (lambda (y) 3 | (letrec ((tmp1 (do-something))) 4 | y))) 5 | (tmp2 ((id (lambda (a) a)) #t))) 6 | ((id (lambda (c) c)) #f)) 7 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/eta-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((do-something (lambda () 10)) 2 | (id (lambda (y) 3 | (letrec ((tmp1 (do-something))) 4 | y))) 5 | (tmp2 ((id (lambda (a) a)) #t))) 6 | ((id (lambda (b) b)) #f)) 7 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-0.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (f 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (g 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (f 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-10.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (g 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-11.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (let ((_tmp10 (f 10))) (let ((_tmp11 (g 11))) (let ((_tmp12 (f 12))) (let ((_tmp13 (f 13))) (let ((_tmp14 (f 14))) (let ((_tmp15 (f 15))) (let ((_tmp16 (f 16))) (let ((_tmp17 (f 17))) (let ((_tmp18 (f 18))) (let ((_tmp19 (f 19))) (f 20))))))))))))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-12.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (let ((_tmp10 (f 10))) (let ((_tmp11 (f 11))) (let ((_tmp12 (g 12))) (let ((_tmp13 (f 13))) (let ((_tmp14 (f 14))) (let ((_tmp15 (f 15))) (let ((_tmp16 (f 16))) (let ((_tmp17 (f 17))) (let ((_tmp18 (f 18))) (let ((_tmp19 (f 19))) (f 20))))))))))))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-13.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (let ((_tmp10 (f 10))) (let ((_tmp11 (f 11))) (let ((_tmp12 (f 12))) (let ((_tmp13 (g 13))) (let ((_tmp14 (f 14))) (let ((_tmp15 (f 15))) (let ((_tmp16 (f 16))) (let ((_tmp17 (f 17))) (let ((_tmp18 (f 18))) (let ((_tmp19 (f 19))) (f 20))))))))))))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-14.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (let ((_tmp10 (f 10))) (let ((_tmp11 (f 11))) (let ((_tmp12 (f 12))) (let ((_tmp13 (f 13))) (let ((_tmp14 (g 14))) (let ((_tmp15 (f 15))) (let ((_tmp16 (f 16))) (let ((_tmp17 (f 17))) (let ((_tmp18 (f 18))) (let ((_tmp19 (f 19))) (f 20))))))))))))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-15.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (let ((_tmp10 (f 10))) (let ((_tmp11 (f 11))) (let ((_tmp12 (f 12))) (let ((_tmp13 (f 13))) (let ((_tmp14 (f 14))) (let ((_tmp15 (g 15))) (let ((_tmp16 (f 16))) (let ((_tmp17 (f 17))) (let ((_tmp18 (f 18))) (let ((_tmp19 (f 19))) (f 20))))))))))))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-16.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (let ((_tmp10 (f 10))) (let ((_tmp11 (f 11))) (let ((_tmp12 (f 12))) (let ((_tmp13 (f 13))) (let ((_tmp14 (f 14))) (let ((_tmp15 (f 15))) (let ((_tmp16 (g 16))) (let ((_tmp17 (f 17))) (let ((_tmp18 (f 18))) (let ((_tmp19 (f 19))) (f 20))))))))))))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-17.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (let ((_tmp10 (f 10))) (let ((_tmp11 (f 11))) (let ((_tmp12 (f 12))) (let ((_tmp13 (f 13))) (let ((_tmp14 (f 14))) (let ((_tmp15 (f 15))) (let ((_tmp16 (f 16))) (let ((_tmp17 (g 17))) (let ((_tmp18 (f 18))) (let ((_tmp19 (f 19))) (f 20))))))))))))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-18.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (let ((_tmp10 (f 10))) (let ((_tmp11 (f 11))) (let ((_tmp12 (f 12))) (let ((_tmp13 (f 13))) (let ((_tmp14 (f 14))) (let ((_tmp15 (f 15))) (let ((_tmp16 (f 16))) (let ((_tmp17 (f 17))) (let ((_tmp18 (g 18))) (let ((_tmp19 (f 19))) (f 20))))))))))))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-19.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (let ((_tmp10 (f 10))) (let ((_tmp11 (f 11))) (let ((_tmp12 (f 12))) (let ((_tmp13 (f 13))) (let ((_tmp14 (f 14))) (let ((_tmp15 (f 15))) (let ((_tmp16 (f 16))) (let ((_tmp17 (f 17))) (let ((_tmp18 (f 18))) (let ((_tmp19 (g 19))) (f 20))))))))))))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (g 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (f 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-20.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (let ((_tmp10 (f 10))) (let ((_tmp11 (f 11))) (let ((_tmp12 (f 12))) (let ((_tmp13 (f 13))) (let ((_tmp14 (f 14))) (let ((_tmp15 (f 15))) (let ((_tmp16 (f 16))) (let ((_tmp17 (f 17))) (let ((_tmp18 (f 18))) (let ((_tmp19 (f 19))) (g 20))))))))))))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-3.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (g 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (f 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-4.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (g 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (f 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-5.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (g 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (f 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-6.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (g 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (f 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-7.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (g 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (f 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-8.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (g 8))) (let ((_tmp9 (f 9))) (f 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-9.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (g 9))) (f 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/f1-tests/f-base.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x)))) (g (lambda (x) (+ (* x x) (* x x))))) (let ((_tmp1 (f 1))) (let ((_tmp2 (f 2))) (let ((_tmp3 (f 3))) (let ((_tmp4 (f 4))) (let ((_tmp5 (f 5))) (let ((_tmp6 (f 6))) (let ((_tmp7 (f 7))) (let ((_tmp8 (f 8))) (let ((_tmp9 (f 9))) (f 10))))))))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/fAdd-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x))))) 2 | (let ((f1 (f 1))) 3 | (let ((f2 (f 2))) 4 | (let ((f4 (f 4))) 5 | (f 5))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/fAdd-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x))))) 2 | (let ((f1 (f 1))) 3 | (let ((f2 (f 2))) 4 | (let ((f3 (f 3))) 5 | (let ((f4 (f 4))) 6 | (f 5)))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/fPerm-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x))))) 2 | (let ((f1 (f 1))) 3 | (let ((f2 (f 2))) 4 | (let ((f3 (f 3))) 5 | (let ((f4 (f 4))) 6 | (f 5)))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/fPerm-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x))))) 2 | (let ((f5 (f 5))) 3 | (let ((f3 (f 3))) 4 | (let ((f1 (f 1))) 5 | (let ((f4 (f 4))) 6 | (f 2)))))) 7 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/fRem-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x))))) 2 | (let ((f1 (f 1))) 3 | (let ((f2 (f 2))) 4 | (let ((f3 (f 3))) 5 | (let ((f4 (f 4))) 6 | (f 5)))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/fRem-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (x) (+ (* x x) (* x x))))) 2 | (let ((f1 (f 1))) 3 | (let ((f2 (f 2))) 4 | (let ((f4 (f 4))) 5 | (f 5))))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/fact-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((fact (lambda (n) 2 | (if (= n 0) 3 | 1 4 | (* n (fact (- n 1))))))) 5 | (fact 3)) 6 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/fact-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((fact (lambda (n) 2 | (if (< n 2) 3 | 1 4 | (* n (fact (- n 1))))))) 5 | (fact 3)) 6 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/factInp-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((fact (lambda (n) 2 | (if (= n 0) 3 | 1 4 | (* n (fact (- n 1))))))) 5 | (fact 5)) 6 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/factInp-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((fact (lambda (n) 2 | (if (= n 0) 3 | 1 4 | (* n (fact (- n 1))))))) 5 | (fact 8)) 6 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/fib-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((fib (lambda (n) 2 | (if (< n 2) 3 | n 4 | (+ (fib (- n 1)) (fib (- n 2))))))) 5 | (fib 4)) 6 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/fib-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((fib (lambda (n) 2 | (if (< n 2) 3 | n 4 | (+ (fib (- n 2)) (fib (- n 1))))))) 5 | (fib 4)) 6 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/gcipd-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (n) 2 | (if (<= n 1) 3 | 1 4 | (* n (f (- n 1)))))) 5 | (g (lambda (n) 6 | (if (<= n 1) 7 | 1 8 | (+ (* n n) (g (- n 1))))))) 9 | (+ (g 2) (f 2))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/gcipd-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((f (lambda (n) 2 | (if (<= n 1) 3 | 1 4 | (* n (f (- n 1)))))) 5 | (g (lambda (n) 6 | (if (<= n 1) 7 | 1 8 | (+ (* n n) (g (- n 1))))))) 9 | (+ (f 2) (g 2))) -------------------------------------------------------------------------------- /test/changesBenevolPaper/hanoi-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((move-them (lambda (n from to helper) 2 | (if (> n 1) 3 | (begin 4 | (move-them (- n 1) from helper to) 5 | (move-them (- n 1) helper to from)))))) 6 | (move-them 5 0 1 2)) 7 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/hanoi-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((move-them (lambda (n from to helper) 2 | (if (> n 1) 3 | (begin 4 | (move-them (- n 1) helper to from) 5 | (move-them (- n 1) from helper to)))))) 6 | (move-them 5 0 1 2)) 7 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/rotateA-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((rotate (lambda (n x y z) 2 | (if (= n 0) 3 | x 4 | (rotate (- n 1) y z x))))) 5 | (rotate 41 5 #t "hallo")) -------------------------------------------------------------------------------- /test/changesBenevolPaper/rotateA-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((rotate (lambda (n x y z) 2 | (if (= n 0) 3 | x 4 | (rotate (- n 1) y z x))))) 5 | (rotate 41 5 #t #f)) -------------------------------------------------------------------------------- /test/changesBenevolPaper/rotateB-1.scm: -------------------------------------------------------------------------------- 1 | (letrec ((rotate (lambda (n x y z) 2 | (if (= n 0) 3 | y 4 | (rotate (- n 1) y z x))))) 5 | (rotate 41 5 #t "hallo")) 6 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/rotateB-2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((rotate (lambda (n x y z) 2 | (if (= n 0) 3 | y 4 | (rotate (- n 1) y z x))))) 5 | (rotate 41 #t "hallo" 5)) 6 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat-1.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 p) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (p n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat-2.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 p) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (p n4 n3 n2 n1)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satAdd-1.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 p) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (p n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satAdd-2.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4 x5) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2 x5))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 p) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (try (lambda (n5) 13 | (p n1 n2 n3 n4 n5)))))))))))) 14 | (sat-solve-4 phi) 15 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satAlias-1.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 pred) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (pred n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satAlias-2.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (phi-alias x1 x2 x3 x4) 6 | (phi x1 x2 x3 x4)) 7 | (define (try f) 8 | (or (f #t) (f #f))) 9 | (define (sat-solve-4 pred) 10 | (try (lambda (n1) 11 | (try (lambda (n2) 12 | (try (lambda (n3) 13 | (try (lambda (n4) 14 | (pred n1 n2 n3 n4)))))))))) 15 | (sat-solve-4 phi-alias) 16 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satOther1-1.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 pred) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (pred n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satOther1-2.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3) (not x4)) 3 | (or x2 (not x3)) 4 | (or (not x1) x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 pred) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (pred n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satOther2-1.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 pred) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (pred n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satOther2-2.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x4)) 3 | (or (not x1) (not x2)) 4 | (and x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 pred) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (pred n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satPerm-1.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 p) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (p n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satPerm-2.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 p) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (p n1 n4 n3 n2)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satRem-1.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 p) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (p n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satRem-2.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 p) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (p n1 n2 n3)))))))) 12 | (sat-solve-4 phi) 13 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satRename-1.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 p) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (p n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/sat/satRename-2.scm: -------------------------------------------------------------------------------- 1 | (define (phi x1 x2 x3 x4) 2 | (and (or x1 (not x2) (not x3)) 3 | (or (not x2) (not x3)) 4 | (or x4 x2))) 5 | (define (try f) 6 | (or (f #t) (f #f))) 7 | (define (sat-solve-4 pred) 8 | (try (lambda (n1) 9 | (try (lambda (n2) 10 | (try (lambda (n3) 11 | (try (lambda (n4) 12 | (pred n1 n2 n3 n4)))))))))) 13 | (sat-solve-4 phi) 14 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/var-1.scm: -------------------------------------------------------------------------------- 1 | (begin 2 | (define (g x) x) 3 | (define (h x) (g x)) 4 | (define (f x) (h (g (g (g x))))) 5 | (f 2)) 6 | -------------------------------------------------------------------------------- /test/changesBenevolPaper/var-2.scm: -------------------------------------------------------------------------------- 1 | (begin 2 | (define (g x) x) 3 | (define (h x) (g x)) 4 | (define (f x) (h (g (g (g x))))) 5 | (define input 2) 6 | (f input)) 7 | -------------------------------------------------------------------------------- /test/concurrentScheme/actors/cell.scm: -------------------------------------------------------------------------------- 1 | (letrec ((cell 2 | (actor "cell" (content) 3 | (put (newcontent) (become cell newcontent)) 4 | (get (act) (send act value content) (become cell content)))) 5 | (display-actor 6 | (actor "display" () 7 | (value (x) (if (= x 2) (terminate) (error "Error!"))))) 8 | (disp (create display-actor)) 9 | (c1 (create cell 1)) 10 | (c2 (create cell 2))) 11 | (send c1 put 2) 12 | (send c2 put 5) 13 | (send c1 get disp)) 14 | -------------------------------------------------------------------------------- /test/concurrentScheme/actors/check.scm: -------------------------------------------------------------------------------- 1 | ;; Benchmark showing that when actors are allocated at the same call site, precision is lost. 2 | (letrec ((check-actor (actor "check" (n) 3 | (check (m) 4 | (if (= m n) (become check-actor n) (error "error!"))))) 5 | (new-check (lambda (n) (create check-actor n))) 6 | ;; Replace (new-check i) by (create check-actor i) and the program is easily proved to be error-free 7 | ;; Note: it isn't the case right now but it will be (TODO). The problem comes from the fact that 8 | ;; it is the main process that allocates check-actor's constructor argument n, therefore c1, c2 9 | ;; and c3's n are allocated the same address, and 1, 2 and 3 are joined together, resulting in Int. 10 | (c1 (new-check 1)) 11 | (c2 (new-check 2)) 12 | (c3 (new-check 3)) 13 | ) 14 | (send c1 check 1) 15 | (send c2 check 2) 16 | (send c3 check 3) 17 | ) 18 | -------------------------------------------------------------------------------- /test/concurrentScheme/actors/factorial.scm: -------------------------------------------------------------------------------- 1 | ;; From Agha, 1986, p. 54 2 | (letrec ((fact-actor 3 | (actor "fac" () 4 | (compute (n customer) 5 | (if (= n 0) 6 | (send customer result 1) 7 | (let ((c (create customer-actor n customer))) 8 | (send self compute (- n 1) c))) 9 | (become fact-actor)))) 10 | (customer-actor 11 | (actor "customer" (n customer) 12 | (result (k) 13 | (send customer result (* n k)) 14 | (become customer-actor n customer)))) 15 | (display-actor 16 | (actor "display" () 17 | (result (n) (display n)))) 18 | (f (create fact-actor)) 19 | (disp (create display-actor))) 20 | (send f compute 5 disp)) 21 | -------------------------------------------------------------------------------- /test/concurrentScheme/actors/savina/fjc-seq.scm: -------------------------------------------------------------------------------- 1 | ;; Adapted from Savina benchmarks ("Frok Join (actor creation)" benchmark, coming from JGF 2 | (letrec ((N 3) 3 | (perform-computation (lambda (theta) 4 | (let ((sint (+ 1 theta))) ; was (sint (sin theta)) in the original implementation 5 | (* sint sint)))) 6 | (forkjoin-actor 7 | (actor "forkjoin" () 8 | (message () 9 | (perform-computation 37.2) 10 | (terminate))))) 11 | (send (create forkjoin-actor) message) 12 | (send (create forkjoin-actor) message) 13 | (send (create forkjoin-actor) message)) 14 | -------------------------------------------------------------------------------- /test/concurrentScheme/actors/savina/fjc.scm: -------------------------------------------------------------------------------- 1 | ;; Adapted from Savina benchmarks ("Frok Join (actor creation)" benchmark, coming from JGF 2 | (letrec ((N 3) 3 | (perform-computation (lambda (theta) 4 | (let ((sint (+ 1 theta))) ; was (sint (sin theta)) in the original implementation 5 | (* sint sint)))) 6 | (forkjoin-actor 7 | (actor "forkjoin" () 8 | (message () 9 | (perform-computation 37.2) 10 | (terminate)))) 11 | (loop (lambda (n) 12 | (if (= n N) 13 | 'done 14 | (begin 15 | (send (create forkjoin-actor) message) 16 | (loop (+ n 1))))))) 17 | (loop 0)) 18 | -------------------------------------------------------------------------------- /test/concurrentScheme/actors/soter/pipe-seq.scm: -------------------------------------------------------------------------------- 1 | ;; From SOTER benchmarks (pipe). Adapted to use a fixed number of actors that can be distinguished by the analyzer. 2 | ;; Bound: pipe-node bounded by 1 3 | (letrec ((pipe-node (actor "pipe-node" (f next) 4 | (message (m) 5 | (send next message (f m)) 6 | (become pipe-node f next)))) 7 | (sink-actor (actor "sink" () 8 | (message (m) (terminate)))) 9 | (sink (create sink-actor)) 10 | (N 3) 11 | (f (lambda (x) (+ x 1))) 12 | (p1 (create pipe-node f sink)) 13 | (p2 (create pipe-node f p1)) 14 | (head (create pipe-node f p2))) 15 | (send head message 0)) 16 | -------------------------------------------------------------------------------- /test/concurrentScheme/actors/soter/safe_send.scm: -------------------------------------------------------------------------------- 1 | ;; From D'Osualdo 2 | (letrec ((server-actor (actor "server" (state) 3 | (message (x p) 4 | (send p state state) 5 | (become server-actor state)) 6 | (state (x) (become server-actor state)) 7 | (bye () (terminate)))) 8 | (init-actor (actor "init" () 9 | (init (x) 10 | (become server-actor x)))) 11 | (act (create init-actor))) 12 | (send act init 0) 13 | (send act message 'hi act) 14 | (send act message 'then act) 15 | (send act bye)) 16 | -------------------------------------------------------------------------------- /test/concurrentScheme/actors/soter/unsafe_send.scm: -------------------------------------------------------------------------------- 1 | ;; From SOTER benchmarks (unsafe_send). Description from SOTER: 2 | ;; This example illustrates the "Verify Absence-of-Errors" mode. The server expects a tuple {REQUEST,PID-OF-SENDER} but the main sends to it an atom instead of its pid, then generating an exception when the server tries to send back a response to what he assumes to be a pid. 3 | ;; The verification step discovers a genuine counter-example. To inspect the error trace run bfc on the generated model and look at the trace alongside the dot model of the ACS. 4 | (let* ((server-actor (actor "server" () 5 | (message (x p) 6 | (send p message x) 7 | (become server-actor)) 8 | (bye () (terminate)))) 9 | (server (create server-actor))) 10 | (send server message 'hi 'bye)) 11 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/fact-indep.scm: -------------------------------------------------------------------------------- 1 | ;; Expected result: #t 2 | (letrec ((fact (lambda (n) 3 | (if (= n 0) 4 | 1 5 | (* n (fact (- n 1)))))) 6 | (t1 (future (fact 5))) 7 | (t2 (future (fact 4)))) 8 | (= (+ (deref t1) (deref t2)) 144)) 9 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/fact2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((result (atom 1)) 2 | (fact (lambda (i) 3 | (if (= i 0) 4 | result 5 | (begin (swap! result (lambda (curr) (* curr i))) 6 | (fact (- i 1)))))) 7 | (t1 (future (fact 4))) 8 | (t2 (future (fact 5)))) 9 | (deref t1) 10 | (deref t2) 11 | (= (read result) 2880)) 12 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/lastzero2.scm: -------------------------------------------------------------------------------- 1 | ;; Example taken from Optimal Dynamic Partial Order Reduction, Figure 4 2 | (letrec ((n 2) 3 | (array (atom (make-vector (+ n 1) 0))) 4 | (thread0 (lambda (i) 5 | (if (= (vector-ref (deref atom) i) 0) 6 | i 7 | (thread0 (- i 1))))) 8 | (thread (lambda (j) 9 | (swap! atom (lambda (v) (vector-set! v j (+ 1 (vector-ref v (- j 1)))))))) 10 | (t1 (future (thread 1))) 11 | (t2 (future (thread 2)))) 12 | (thread0 n) 13 | (deref t1) 14 | (deref t2) 15 | #t) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/readers2.scm: -------------------------------------------------------------------------------- 1 | ;; Example based on Optimal Dynamic Partial Order Reduction, Figure 3 2 | (let* ((x 0) (y 0) (z 0) 3 | (p (lambda () (set! x 1))) 4 | (q (lambda () y x)) 5 | (z (lambda () z x)) 6 | (t1 (future (p))) 7 | (t2 (future (q))) 8 | (t3 (future (z)))) 9 | (deref t1) 10 | (let ((res (deref t2))) 11 | (or (= res 1) 12 | (= res 0)))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/rng.scm: -------------------------------------------------------------------------------- 1 | ;; Random number generate sharing state among multiple thrds 2 | (define N (+ 42 10)) 3 | (define (range from to) 4 | (if (= from to) 5 | (cons from '()) 6 | (cons from (range (+ from 1) to)))) 7 | 8 | (define (rng seed) 9 | (letrec ((state (atom seed)) 10 | (lock (new-lock))) 11 | (lambda () 12 | (acquire lock) 13 | (reset! state (modulo (+ (* 5245 (read state)) 12345) 107374182)) 14 | (let ((n (modulo (quotient (read state) 65535) 32768))) 15 | (release lock) 16 | n)))) 17 | (define gen (rng 100)) 18 | (define ts (map (lambda (x) (future (gen))) (range 1 N))) 19 | (map (lambda (t) (deref t)) ts) 20 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/simple.scm: -------------------------------------------------------------------------------- 1 | ;; Example based on Dynamic Partial Order Reduction paper 2 | (let* ((x 0) 3 | (y 0) 4 | (t1 (future (set! x 1) (set! x 2))) 5 | (t2 (future (set! y 1) (set! x 3)))) 6 | (deref t1) 7 | (deref t2) 8 | (and (= y 1) 9 | (or (= x 2) 10 | (= x 3)))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/treiber-stack.scm: -------------------------------------------------------------------------------- 1 | ; Treiber stack as an example of a lock-free data structure using atoms. 2 | 3 | (define (new-stack) 4 | (atom '())) 5 | 6 | (define (push stk el) 7 | (let loop ((top (read stk))) 8 | (if (not (compare-and-set! stk top (cons el top))) 9 | (loop (read stk))))) 10 | 11 | (define (pop stk) 12 | (let loop ((top (read stk))) 13 | (cond ((null? top) #f) 14 | ((compare-and-set! stk top (cdr top)) (car top)) 15 | (else (loop (read stk)))))) 16 | 17 | (define (loop stk n f) 18 | (if (> n 0) 19 | (let ((next (f stk n))) 20 | (loop stk next f)))) 21 | 22 | (define stack (new-stack)) 23 | (define f1 (future (loop stack 25 (lambda (s n) (push s n) (- n 1))))) 24 | (define f2 (future (loop stack 25 (lambda (s n) (if (pop s) (- n 1) n))))) 25 | 26 | (deref f1) 27 | (deref f2) 28 | (not (pop stack)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count10.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3))) 9 | (t4 (future (thread 4))) 10 | (t5 (future (thread 5))) 11 | (t6 (future (thread 6))) 12 | (t7 (future (thread 7))) 13 | (t8 (future (thread 8))) 14 | (t9 (future (thread 9))) 15 | (t10 (future (thread 10)))) 16 | (and 17 | (deref t1) 18 | (deref t2) 19 | (deref t3) 20 | (deref t4) 21 | (deref t5) 22 | (deref t6) 23 | (deref t7) 24 | (deref t8) 25 | (deref t9) 26 | (deref t10) 27 | (<=i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count11.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3))) 9 | (t4 (future (thread 4))) 10 | (t5 (future (thread 5))) 11 | (t6 (future (thread 6))) 12 | (t7 (future (thread 7))) 13 | (t8 (future (thread 8))) 14 | (t9 (future (thread 9))) 15 | (t10 (future (thread 10))) 16 | (t11 (future (thread 11)))) 17 | (and 18 | (deref t1) 19 | (deref t2) 20 | (deref t3) 21 | (deref t4) 22 | (deref t5) 23 | (deref t6) 24 | (deref t7) 25 | (deref t8) 26 | (deref t9) 27 | (deref t10) 28 | (deref t11) 29 | (<=i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count12.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3))) 9 | (t4 (future (thread 4))) 10 | (t5 (future (thread 5))) 11 | (t6 (future (thread 6))) 12 | (t7 (future (thread 7))) 13 | (t8 (future (thread 8))) 14 | (t9 (future (thread 9))) 15 | (t10 (future (thread 10))) 16 | (t11 (future (thread 11))) 17 | (t12 (future (thread 12)))) 18 | (and 19 | (deref t1) 20 | (deref t2) 21 | (deref t3) 22 | (deref t4) 23 | (deref t5) 24 | (deref t6) 25 | (deref t7) 26 | (deref t8) 27 | (deref t9) 28 | (deref t10) 29 | (deref t11) 30 | (deref t12) 31 | (<=i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count13.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3))) 9 | (t4 (future (thread 4))) 10 | (t5 (future (thread 5))) 11 | (t6 (future (thread 6))) 12 | (t7 (future (thread 7))) 13 | (t8 (future (thread 8))) 14 | (t9 (future (thread 9))) 15 | (t10 (future (thread 10))) 16 | (t11 (future (thread 11))) 17 | (t12 (future (thread 12))) 18 | (t13 (future (thread 13)))) 19 | (and 20 | (deref t1) 21 | (deref t2) 22 | (deref t3) 23 | (deref t4) 24 | (deref t5) 25 | (deref t6) 26 | (deref t7) 27 | (deref t8) 28 | (deref t9) 29 | (deref t10) 30 | (deref t11) 31 | (deref t12) 32 | (deref t13) 33 | (<=i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count14.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3))) 9 | (t4 (future (thread 4))) 10 | (t5 (future (thread 5))) 11 | (t6 (future (thread 6))) 12 | (t7 (future (thread 7))) 13 | (t8 (future (thread 8))) 14 | (t9 (future (thread 9))) 15 | (t10 (future (thread 10))) 16 | (t11 (future (thread 11))) 17 | (t12 (future (thread 12))) 18 | (t13 (future (thread 13))) 19 | (t14 (future (thread 14)))) 20 | (and 21 | (deref t1) 22 | (deref t2) 23 | (deref t3) 24 | (deref t4) 25 | (deref t5) 26 | (deref t6) 27 | (deref t7) 28 | (deref t8) 29 | (deref t9) 30 | (deref t10) 31 | (deref t11) 32 | (deref t12) 33 | (deref t13) 34 | (deref t14) 35 | (<=i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2)))) 8 | (and 9 | (deref t1) 10 | (deref t2) 11 | (<= i 0))) 12 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count3.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3)))) 9 | (and 10 | (deref t1) 11 | (deref t2) 12 | (deref t3) 13 | (<= i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count4.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3))) 9 | (t4 (future (thread 4)))) 10 | (and 11 | (deref t1) 12 | (deref t2) 13 | (deref t3) 14 | (deref t4) 15 | (<=i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count5.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3))) 9 | (t4 (future (thread 4))) 10 | (t5 (future (thread 5)))) 11 | (and 12 | (deref t1) 13 | (deref t2) 14 | (deref t3) 15 | (deref t4) 16 | (deref t5) 17 | (<=i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count6.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3))) 9 | (t4 (future (thread 4))) 10 | (t5 (future (thread 5))) 11 | (t6 (future (thread 6)))) 12 | (and 13 | (deref t1) 14 | (deref t2) 15 | (deref t3) 16 | (deref t4) 17 | (deref t5) 18 | (deref t6) 19 | (<=i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count7.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3))) 9 | (t4 (future (thread 4))) 10 | (t5 (future (thread 5))) 11 | (t6 (future (thread 6))) 12 | (t7 (future (thread 7)))) 13 | (and 14 | (deref t1) 15 | (deref t2) 16 | (deref t3) 17 | (deref t4) 18 | (deref t5) 19 | (deref t6) 20 | (deref t7) 21 | (<=i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count8.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3))) 9 | (t4 (future (thread 4))) 10 | (t5 (future (thread 5))) 11 | (t6 (future (thread 6))) 12 | (t7 (future (thread 7))) 13 | (t8 (future (thread 8)))) 14 | (and 15 | (deref t1) 16 | (deref t2) 17 | (deref t3) 18 | (deref t4) 19 | (deref t5) 20 | (deref t6) 21 | (deref t7) 22 | (deref t8) 23 | (<=i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/count9.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (future (thread 1))) 7 | (t2 (future (thread 2))) 8 | (t3 (future (thread 3))) 9 | (t4 (future (thread 4))) 10 | (t5 (future (thread 5))) 11 | (t6 (future (thread 6))) 12 | (t7 (future (thread 7))) 13 | (t8 (future (thread 8))) 14 | (t9 (future (thread 9)))) 15 | (and 16 | (deref t1) 17 | (deref t2) 18 | (deref t3) 19 | (deref t4) 20 | (deref t5) 21 | (deref t6) 22 | (deref t7) 23 | (deref t8) 24 | (deref t9) 25 | (<=i 0))) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/mutex2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((lock (atom #f)) 2 | (acq (lambda () 3 | (if (compare-and-set! lock #f #t) 4 | #t 5 | (acq)))) 6 | (rel (lambda () 7 | (set! lock #f))) 8 | (counter 0) 9 | (inc (lambda () 10 | (acq) 11 | (set! counter (+ counter 1)) 12 | (rel))) 13 | (t1 (future (inc))) 14 | (t2 (future (inc)))) 15 | (deref t1) 16 | (deref t2) 17 | (= counter 2)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/mutex3.scm: -------------------------------------------------------------------------------- 1 | (letrec ((lock (atom #f)) 2 | (acq (lambda () 3 | (if (compare-and-set! lock #f #t) 4 | #t 5 | (acq)))) 6 | (rel (lambda () 7 | (set! lock #f))) 8 | (counter 0) 9 | (inc (lambda () 10 | (acq) 11 | (set! counter (+ counter 1)) 12 | (rel))) 13 | (t1 (future (inc))) 14 | (t2 (future (inc))) 15 | (t3 (future (inc)))) 16 | (deref t1) 17 | (deref t2) 18 | (deref t3) 19 | (= counter 3)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/mutex4.scm: -------------------------------------------------------------------------------- 1 | (letrec ((lock (atom #f)) 2 | (acq (lambda () 3 | (if (compare-and-set! lock #f #t) 4 | #t 5 | (acq)))) 6 | (rel (lambda () 7 | (set! lock #f))) 8 | (counter 0) 9 | (inc (lambda () 10 | (acq) 11 | (set! counter (+ counter 1)) 12 | (rel))) 13 | (t1 (future (inc))) 14 | (t2 (future (inc))) 15 | (t3 (future (inc))) 16 | (t4 (future (inc)))) 17 | (deref t1) 18 | (deref t2) 19 | (deref t3) 20 | (deref t4) 21 | (= counter 4)) 22 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/mutex5.scm: -------------------------------------------------------------------------------- 1 | (letrec ((lock (atom #f)) 2 | (acq (lambda () 3 | (if (compare-and-set! lock #f #t) 4 | #t 5 | (acq)))) 6 | (rel (lambda () 7 | (set! lock #f))) 8 | (counter 0) 9 | (inc (lambda () 10 | (acq) 11 | (set! counter (+ counter 1)) 12 | (rel))) 13 | (t1 (future (inc))) 14 | (t2 (future (inc))) 15 | (t3 (future (inc))) 16 | (t4 (future (inc))) 17 | (t5 (future (inc)))) 18 | (deref t1) 19 | (deref t2) 20 | (deref t3) 21 | (deref t4) 22 | (deref t5) 23 | (= counter 5)) 24 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/mutex6.scm: -------------------------------------------------------------------------------- 1 | (letrec ((lock (atom #f)) 2 | (acq (lambda () 3 | (if (compare-and-set! lock #f #t) 4 | #t 5 | (acq)))) 6 | (rel (lambda () 7 | (set! lock #f))) 8 | (counter 0) 9 | (inc (lambda () 10 | (acq) 11 | (set! counter (+ counter 1)) 12 | (rel))) 13 | (t1 (future (inc))) 14 | (t2 (future (inc))) 15 | (t3 (future (inc))) 16 | (t4 (future (inc))) 17 | (t5 (future (inc))) 18 | (t6 (future (inc)))) 19 | (deref t1) 20 | (deref t2) 21 | (deref t3) 22 | (deref t4) 23 | (deref t5) 24 | (deref t6) 25 | (= counter 6)) 26 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/pcounter10.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter (atom 0)) 2 | (thread (lambda (n) 3 | (letrec ((old (deref counter)) 4 | (new (+ old 1))) 5 | (if (compare-and-set! counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (future (thread 1))) 9 | (t2 (future (thread 2))) 10 | (t3 (future (thread 3))) 11 | (t4 (future (thread 4))) 12 | (t5 (future (thread 5))) 13 | (t6 (future (thread 6))) 14 | (t7 (future (thread 7))) 15 | (t8 (future (thread 8))) 16 | (t9 (future (thread 9))) 17 | (t10 (future (thread 10)))) 18 | (deref t1) 19 | (deref t2) 20 | (deref t3) 21 | (deref t4) 22 | (deref t5) 23 | (deref t6) 24 | (deref t7) 25 | (deref t8) 26 | (deref t9) 27 | (deref t10) 28 | (= counter 10)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/pcounter11.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter (atom 0)) 2 | (thread (lambda (n) 3 | (letrec ((old (deref counter)) 4 | (new (+ old 1))) 5 | (if (compare-and-set! counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (future (thread 1))) 9 | (t2 (future (thread 2))) 10 | (t3 (future (thread 3))) 11 | (t4 (future (thread 4))) 12 | (t5 (future (thread 5))) 13 | (t6 (future (thread 6))) 14 | (t7 (future (thread 7))) 15 | (t8 (future (thread 8))) 16 | (t9 (future (thread 9))) 17 | (t10 (future (thread 10))) 18 | (t11 (future (thread 11)))) 19 | (deref t1) 20 | (deref t2) 21 | (deref t3) 22 | (deref t4) 23 | (deref t5) 24 | (deref t6) 25 | (deref t7) 26 | (deref t8) 27 | (deref t9) 28 | (deref t10) 29 | (deref t11) 30 | (= counter 11)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/pcounter12.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter (atom 0)) 2 | (thread (lambda (n) 3 | (letrec ((old (deref counter)) 4 | (new (+ old 1))) 5 | (if (compare-and-set! counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (future (thread 1))) 9 | (t2 (future (thread 2))) 10 | (t3 (future (thread 3))) 11 | (t4 (future (thread 4))) 12 | (t5 (future (thread 5))) 13 | (t6 (future (thread 6))) 14 | (t7 (future (thread 7))) 15 | (t8 (future (thread 8))) 16 | (t9 (future (thread 9))) 17 | (t10 (future (thread 10))) 18 | (t11 (future (thread 11))) 19 | (t12 (future (thread 12)))) 20 | (deref t1) 21 | (deref t2) 22 | (deref t3) 23 | (deref t4) 24 | (deref t5) 25 | (deref t6) 26 | (deref t7) 27 | (deref t8) 28 | (deref t9) 29 | (deref t10) 30 | (deref t11) 31 | (deref t12) 32 | (= counter 12)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/pcounter2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter (atom 0)) 2 | (thread (lambda (n) 3 | (letrec ((old (deref counter)) 4 | (new (+ old 1))) 5 | (if (compare-and-set! counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (future (thread 1))) 9 | (t2 (future (thread 2)))) 10 | (deref t1) 11 | (deref t2) 12 | (= counter 2)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/pcounter3.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter (atom 0)) 2 | (thread (lambda (n) 3 | (letrec ((old (deref counter)) 4 | (new (+ old 1))) 5 | (if (compare-and-set! counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (future (thread 1))) 9 | (t2 (future (thread 2))) 10 | (t3 (future (thread 3)))) 11 | (deref t1) 12 | (deref t2) 13 | (deref t3) 14 | (= counter 3)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/pcounter4.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter (atom 0)) 2 | (thread (lambda (n) 3 | (letrec ((old (deref counter)) 4 | (new (+ old 1))) 5 | (if (compare-and-set! counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (future (thread 1))) 9 | (t2 (future (thread 2))) 10 | (t3 (future (thread 3))) 11 | (t4 (future (thread 4)))) 12 | (deref t1) 13 | (deref t2) 14 | (deref t3) 15 | (deref t4) 16 | (= counter 4)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/pcounter5.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter (atom 0)) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (compare-and-set! counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (future (thread 1))) 9 | (t2 (future (thread 2))) 10 | (t3 (future (thread 3))) 11 | (t4 (future (thread 4))) 12 | (t5 (future (thread 5)))) 13 | (deref t1) 14 | (deref t2) 15 | (deref t3) 16 | (deref t4) 17 | (deref t5) 18 | (= counter 5)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/pcounter6.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter (atom 0)) 2 | (thread (lambda (n) 3 | (letrec ((old (deref counter)) 4 | (new (+ old 1))) 5 | (if (compare-and-set! counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (future (thread 1))) 9 | (t2 (future (thread 2))) 10 | (t3 (future (thread 3))) 11 | (t4 (future (thread 4))) 12 | (t5 (future (thread 5))) 13 | (t6 (future (thread 6)))) 14 | (deref t1) 15 | (deref t2) 16 | (deref t3) 17 | (deref t4) 18 | (deref t5) 19 | (deref t6) 20 | (= counter 6)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/pcounter7.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter (atom 0)) 2 | (thread (lambda (n) 3 | (letrec ((old (deref counter)) 4 | (new (+ old 1))) 5 | (if (compare-and-set! counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (future (thread 1))) 9 | (t2 (future (thread 2))) 10 | (t3 (future (thread 3))) 11 | (t4 (future (thread 4))) 12 | (t5 (future (thread 5))) 13 | (t6 (future (thread 6))) 14 | (t7 (future (thread 7)))) 15 | (deref t1) 16 | (deref t2) 17 | (deref t3) 18 | (deref t4) 19 | (deref t5) 20 | (deref t6) 21 | (deref t7) 22 | (= counter 7)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/pcounter8.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter (atom 0)) 2 | (thread (lambda (n) 3 | (letrec ((old (deref counter)) 4 | (new (+ old 1))) 5 | (if (compare-and-set! counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (future (thread 1))) 9 | (t2 (future (thread 2))) 10 | (t3 (future (thread 3))) 11 | (t4 (future (thread 4))) 12 | (t5 (future (thread 5))) 13 | (t6 (future (thread 6))) 14 | (t7 (future (thread 7))) 15 | (t8 (future (thread 8)))) 16 | (deref t1) 17 | (deref t2) 18 | (deref t3) 19 | (deref t4) 20 | (deref t5) 21 | (deref t6) 22 | (deref t7) 23 | (deref t8) 24 | (= counter 8)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/pcounter9.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter (atom 0)) 2 | (thread (lambda (n) 3 | (letrec ((old (deref counter)) 4 | (new (+ old 1))) 5 | (if (compare-and-set! counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (future (thread 1))) 9 | (t2 (future (thread 2))) 10 | (t3 (future (thread 3))) 11 | (t4 (future (thread 4))) 12 | (t5 (future (thread 5))) 13 | (t6 (future (thread 6))) 14 | (t7 (future (thread 7))) 15 | (t8 (future (thread 8))) 16 | (t9 (future (thread 9)))) 17 | (deref t1) 18 | (deref t2) 19 | (deref t3) 20 | (deref t4) 21 | (deref t5) 22 | (deref t6) 23 | (deref t7) 24 | (deref t8) 25 | (deref t9) 26 | (= counter 9)) -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/race2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (inc (lambda () 3 | (set! counter (+ counter 1)))) 4 | (dec (lambda () 5 | (set! counter (- counter 1)))) 6 | (t1 (future (inc))) 7 | (t2 (future (dec)))) 8 | (deref t1) 9 | (deref t2) 10 | counter) 11 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/race3.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (inc (lambda () 3 | (set! counter (+ counter 1)))) 4 | (dec (lambda () 5 | (set! counter (- counter 1)))) 6 | (t1 (future (inc))) 7 | (t2 (future (dec))) 8 | (t3 (future (inc)))) 9 | (deref t1) 10 | (deref t2) 11 | (deref t3) 12 | counter) 13 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/race4.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (inc (lambda () 3 | (set! counter (+ counter 1)))) 4 | (dec (lambda () 5 | (set! counter (- counter 1)))) 6 | (t1 (future (inc))) 7 | (t2 (future (dec))) 8 | (t3 (future (inc))) 9 | (t4 (future (dec)))) 10 | (deref t1) 11 | (deref t2) 12 | (deref t3) 13 | (deref t4) 14 | counter) 15 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/race5.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (inc (lambda () 3 | (set! counter (+ counter 1)))) 4 | (dec (lambda () 5 | (set! counter (- counter 1)))) 6 | (t1 (future (inc))) 7 | (t2 (future (dec))) 8 | (t3 (future (inc))) 9 | (t4 (future (dec))) 10 | (t5 (future (inc)))) 11 | (deref t1) 12 | (deref t2) 13 | (deref t3) 14 | (deref t4) 15 | (deref t5) 16 | counter) 17 | -------------------------------------------------------------------------------- /test/concurrentScheme/futures/variations/race6.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (inc (lambda () 3 | (set! counter (+ counter 1)))) 4 | (dec (lambda () 5 | (set! counter (- counter 1)))) 6 | (t1 (future (inc))) 7 | (t2 (future (dec))) 8 | (t3 (future (inc))) 9 | (t4 (future (dec))) 10 | (t5 (future (inc))) 11 | (t6 (future (dec)))) 12 | (deref t1) 13 | (deref t2) 14 | (deref t3) 15 | (deref t4) 16 | (deref t5) 17 | (deref t6) 18 | counter) 19 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/fact-indep.scm: -------------------------------------------------------------------------------- 1 | ;; Expected result: #t 2 | (letrec ((fact (lambda (n) 3 | (if (= n 0) 4 | 1 5 | (* n (fact (- n 1)))))) 6 | (t1 (fork (fact 5))) 7 | (t2 (fork (fact 4)))) 8 | (= (+ (join t1) (join t2)) 144)) 9 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/fact2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((result 1) 2 | (fact (lambda (i) 3 | (if (= i 0) 4 | result 5 | (begin (set! result (* result i)) 6 | (fact (- i 1)))))) 7 | (t1 (fork (fact 4))) 8 | (t2 (fork (fact 5)))) 9 | (join t1) 10 | (join t2) 11 | result) 12 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/infinite-threads.scm: -------------------------------------------------------------------------------- 1 | (define (f x) 2 | (fork (f x))) 3 | 4 | (f 42) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/lastzero2.scm: -------------------------------------------------------------------------------- 1 | ;; Example taken from Optimal Dynamic Partial Order Reduction, Figure 4 2 | (let* ((n 2) 3 | (array (make-vector (+ n 1) 0)) 4 | (thread0 (lambda (i) 5 | (if (= (vector-ref array i) 0) 6 | i 7 | (thread0 (- i 1))))) 8 | (thread (lambda (j) 9 | (vector-set! array j (+ 1 (vector-ref array (- j 1)))))) 10 | (t1 (fork (thread 1))) 11 | (t2 (fork (thread 2)))) 12 | (thread0 n) 13 | (join t1) 14 | (join t2)) 15 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/peterson.scm: -------------------------------------------------------------------------------- 1 | (letrec ((flag-0 #f) 2 | (flag-1 #f) 3 | (turn 0) 4 | (counter 0) 5 | (p0 (lambda () 6 | (set! flag-0 #t) 7 | (letrec ((wait (lambda () 8 | (if (and flag-1 (= turn 1)) 9 | (wait) 10 | #t)))) 11 | (wait) 12 | (set! counter (+ counter 1)) 13 | (set! flag-0 #f)))) 14 | (p1 (lambda () 15 | (set! flag-1 #t) 16 | (letrec ((wait (lambda () 17 | (if (and flag-0 (= turn 0)) 18 | (wait) 19 | #t)))) 20 | (wait) 21 | (set! counter (+ counter 1)) 22 | (set! flag-1 #f)))) 23 | (t0 (fork (p0))) 24 | (t1 (fork (p1)))) 25 | (join t0) 26 | (join t1) 27 | #t) 28 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/philosophers2.scm: -------------------------------------------------------------------------------- 1 | ;; Dining philosophers problem 2 | (define Turns (random 42)) 3 | (define forks (vector (new-lock) (new-lock))) 4 | (define N 2) 5 | (define (philosopher i) 6 | (letrec ((left i) 7 | (right (modulo (- i 1) N)) 8 | (process (lambda (turn) 9 | (if (> turn Turns) 10 | 'done 11 | (begin 12 | (acquire (vector-ref forks (min left right))) 13 | (acquire (vector-ref forks (max left right))) 14 | ;; eat 15 | (display "Eating...") 16 | (release (vector-ref forks (min left right))) 17 | (release (vector-ref forks (max left right))) 18 | (process (+ turn 1))))))) 19 | (process 0))) 20 | (define phi0 (fork (philosopher 0))) 21 | (define phi1 (fork (philosopher 1))) 22 | (join phi0) 23 | (join phi1) 24 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/randomness.scm: -------------------------------------------------------------------------------- 1 | ;; Simple program to show randomness of a concurrent program. (Note that race conditions are present in the program, which should increase randomness even more.) 2 | ;; Author: jevdplas 3 | 4 | (define count 0) 5 | 6 | (define (reader n) 7 | (let loop ((n n)) 8 | (if (> n 0) 9 | (begin (display count) 10 | (loop (- n 1)))))) 11 | 12 | (define (writer m) 13 | (let loop ((m m)) 14 | (if (> m 0) 15 | (begin (set! count m) 16 | (loop (- m 1)))))) 17 | 18 | (define threads '()) 19 | 20 | (let loop ((n 100)) 21 | (cond ((= n 0) #t) 22 | ((even? n) (set! threads (cons (fork (writer (/ n 2))) threads)) 23 | (loop (- n 1))) 24 | (else (set! threads (cons (fork (reader n)) threads)) 25 | (loop (- n 1))))) 26 | 27 | (for-each (lambda (x) (join x)) threads) 28 | 29 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/readers2.scm: -------------------------------------------------------------------------------- 1 | ;; Example taken from Optimal Dynamic Partial Order Reduction, Figure 3 2 | (let* ((x 0) (y 0) (z 0) 3 | (p (lambda () (set! x 1))) 4 | (q (lambda () y x)) 5 | (z (lambda () z x)) 6 | (t1 (fork (p))) 7 | (t2 (fork (q))) 8 | (t3 (fork (z)))) 9 | (join t1) 10 | (join t2)) 11 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/rng.scm: -------------------------------------------------------------------------------- 1 | ;; Random number generate sharing state among multiple threads 2 | 3 | (define N (+ (random 42) 10)) 4 | (define (range from to) 5 | (if (= from to) 6 | (cons from '()) 7 | (cons from (range (+ from 1) to)))) 8 | 9 | (define (rng seed) 10 | (letrec ((state (ref seed)) 11 | (lock (new-lock))) 12 | (lambda () 13 | (acquire lock) 14 | (ref-set state (modulo (+ (* 5245 (deref state)) 12345) 107374182)) 15 | (let ((n (modulo (quotient (deref state) 65535) 32768))) 16 | (release lock) 17 | n)))) 18 | (define gen (rng 100)) 19 | (define ts (map (lambda (x) (fork (gen))) (range 1 N))) 20 | (map (lambda (t) (join t)) ts) 21 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/simple.scm: -------------------------------------------------------------------------------- 1 | ;; Example taken from Dynamic Partial Order Reduction paper 2 | (let* ((x 0) 3 | (y 0) 4 | (t1 (fork (begin (set! x 1) (set! x 2)))) 5 | (t2 (fork (begin (set! y 1) (set! x 3))))) 6 | (join t1) 7 | (join t2) 8 | x) 9 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count10.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4))) 10 | (t5 (fork (thread 5))) 11 | (t6 (fork (thread 6))) 12 | (t7 (fork (thread 7))) 13 | (t8 (fork (thread 8))) 14 | (t9 (fork (thread 9))) 15 | (t10 (fork (thread 10)))) 16 | (join t1) 17 | (join t2) 18 | (join t3) 19 | (join t4) 20 | (join t5) 21 | (join t6) 22 | (join t7) 23 | (join t8) 24 | (join t9) 25 | (join t10)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count11.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4))) 10 | (t5 (fork (thread 5))) 11 | (t6 (fork (thread 6))) 12 | (t7 (fork (thread 7))) 13 | (t8 (fork (thread 8))) 14 | (t9 (fork (thread 9))) 15 | (t10 (fork (thread 10))) 16 | (t11 (fork (thread 11)))) 17 | (join t1) 18 | (join t2) 19 | (join t3) 20 | (join t4) 21 | (join t5) 22 | (join t6) 23 | (join t7) 24 | (join t8) 25 | (join t9) 26 | (join t10) 27 | (join t11)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count12.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4))) 10 | (t5 (fork (thread 5))) 11 | (t6 (fork (thread 6))) 12 | (t7 (fork (thread 7))) 13 | (t8 (fork (thread 8))) 14 | (t9 (fork (thread 9))) 15 | (t10 (fork (thread 10))) 16 | (t11 (fork (thread 11))) 17 | (t12 (fork (thread 12)))) 18 | (join t1) 19 | (join t2) 20 | (join t3) 21 | (join t4) 22 | (join t5) 23 | (join t6) 24 | (join t7) 25 | (join t8) 26 | (join t9) 27 | (join t10) 28 | (join t11) 29 | (join t12)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count13.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4))) 10 | (t5 (fork (thread 5))) 11 | (t6 (fork (thread 6))) 12 | (t7 (fork (thread 7))) 13 | (t8 (fork (thread 8))) 14 | (t9 (fork (thread 9))) 15 | (t10 (fork (thread 10))) 16 | (t11 (fork (thread 11))) 17 | (t12 (fork (thread 12))) 18 | (t13 (fork (thread 13)))) 19 | (join t1) 20 | (join t2) 21 | (join t3) 22 | (join t4) 23 | (join t5) 24 | (join t6) 25 | (join t7) 26 | (join t8) 27 | (join t9) 28 | (join t10) 29 | (join t11) 30 | (join t12) 31 | (join t13)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count14.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4))) 10 | (t5 (fork (thread 5))) 11 | (t6 (fork (thread 6))) 12 | (t7 (fork (thread 7))) 13 | (t8 (fork (thread 8))) 14 | (t9 (fork (thread 9))) 15 | (t10 (fork (thread 10))) 16 | (t11 (fork (thread 11))) 17 | (t12 (fork (thread 12))) 18 | (t13 (fork (thread 13))) 19 | (t14 (fork (thread 14)))) 20 | (join t1) 21 | (join t2) 22 | (join t3) 23 | (join t4) 24 | (join t5) 25 | (join t6) 26 | (join t7) 27 | (join t8) 28 | (join t9) 29 | (join t10) 30 | (join t11) 31 | (join t12) 32 | (join t13) 33 | (join t14)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count15.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4))) 10 | (t5 (fork (thread 5))) 11 | (t6 (fork (thread 6))) 12 | (t7 (fork (thread 7))) 13 | (t8 (fork (thread 8))) 14 | (t9 (fork (thread 9))) 15 | (t10 (fork (thread 10))) 16 | (t11 (fork (thread 11))) 17 | (t12 (fork (thread 12))) 18 | (t13 (fork (thread 13))) 19 | (t14 (fork (thread 14))) 20 | (t15 (fork (thread 15)))) 21 | (join t1) 22 | (join t2) 23 | (join t3) 24 | (join t4) 25 | (join t5) 26 | (join t6) 27 | (join t7) 28 | (join t8) 29 | (join t9) 30 | (join t10) 31 | (join t11) 32 | (join t12) 33 | (join t13) 34 | (join t14) 35 | (join t15)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2)))) 8 | (join t1) 9 | (join t2)) 10 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count3.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3)))) 9 | (join t1) 10 | (join t2) 11 | (join t3)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count4.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4)))) 10 | (join t1) 11 | (join t2) 12 | (join t3) 13 | (join t4)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count5.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4))) 10 | (t5 (fork (thread 5)))) 11 | (join t1) 12 | (join t2) 13 | (join t3) 14 | (join t4) 15 | (join t5)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count6.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4))) 10 | (t5 (fork (thread 5))) 11 | (t6 (fork (thread 6)))) 12 | (join t1) 13 | (join t2) 14 | (join t3) 15 | (join t4) 16 | (join t5) 17 | (join t6)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count7.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4))) 10 | (t5 (fork (thread 5))) 11 | (t6 (fork (thread 6))) 12 | (t7 (fork (thread 7)))) 13 | (join t1) 14 | (join t2) 15 | (join t3) 16 | (join t4) 17 | (join t5) 18 | (join t6) 19 | (join t7)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count8.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4))) 10 | (t5 (fork (thread 5))) 11 | (t6 (fork (thread 6))) 12 | (t7 (fork (thread 7))) 13 | (t8 (fork (thread 8)))) 14 | (join t1) 15 | (join t2) 16 | (join t3) 17 | (join t4) 18 | (join t5) 19 | (join t6) 20 | (join t7) 21 | (join t8)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/count9.scm: -------------------------------------------------------------------------------- 1 | (letrec ((i 100) 2 | (thread (lambda (n) 3 | (if (<= i 0) 4 | #t 5 | (begin (set! i (- i 1)) (thread n))))) 6 | (t1 (fork (thread 1))) 7 | (t2 (fork (thread 2))) 8 | (t3 (fork (thread 3))) 9 | (t4 (fork (thread 4))) 10 | (t5 (fork (thread 5))) 11 | (t6 (fork (thread 6))) 12 | (t7 (fork (thread 7))) 13 | (t8 (fork (thread 8))) 14 | (t9 (fork (thread 9)))) 15 | (join t1) 16 | (join t2) 17 | (join t3) 18 | (join t4) 19 | (join t5) 20 | (join t6) 21 | (join t7) 22 | (join t8) 23 | (join t9)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/incdec2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (lock (new-lock)) 3 | (inc (lambda () 4 | (acquire lock) 5 | (set! counter (+ counter 1)) 6 | (release lock))) 7 | (dec (lambda () 8 | (acquire lock) 9 | (set! counter (- counter 1)) 10 | (release lock))) 11 | (t1 (fork (inc))) 12 | (t2 (fork (dec)))) 13 | (join t1) 14 | (join t2)) 15 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/incdec3.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (lock (new-lock)) 3 | (inc (lambda () 4 | (acquire lock) 5 | (set! counter (+ counter 1)) 6 | (release lock))) 7 | (dec (lambda () 8 | (acquire lock) 9 | (set! counter (- counter 1)) 10 | (release lock))) 11 | (t1 (fork (inc))) 12 | (t2 (fork (dec))) 13 | (t3 (fork (inc)))) 14 | (join t1) 15 | (join t2) 16 | (join t3)) 17 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/incdec4.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (lock (new-lock)) 3 | (inc (lambda () 4 | (acquire lock) 5 | (set! counter (+ counter 1)) 6 | (release lock))) 7 | (dec (lambda () 8 | (acquire lock) 9 | (set! counter (- counter 1)) 10 | (release lock))) 11 | (t1 (fork (inc))) 12 | (t2 (fork (dec))) 13 | (t3 (fork (inc))) 14 | (t4 (fork (dec)))) 15 | (join t1) 16 | (join t2) 17 | (join t3) 18 | (join t4)) 19 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/incdec5.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (lock (new-lock)) 3 | (inc (lambda () 4 | (acquire lock) 5 | (set! counter (+ counter 1)) 6 | (release lock))) 7 | (dec (lambda () 8 | (acquire lock) 9 | (set! counter (- counter 1)) 10 | (release lock))) 11 | (t1 (fork (inc))) 12 | (t2 (fork (dec))) 13 | (t3 (fork (inc))) 14 | (t4 (fork (dec))) 15 | (t5 (fork (inc)))) 16 | (join t1) 17 | (join t2) 18 | (join t3) 19 | (join t4) 20 | (join t5)) 21 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/incdec6.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (lock (new-lock)) 3 | (inc (lambda () 4 | (acquire lock) 5 | (set! counter (+ counter 1)) 6 | (release lock))) 7 | (dec (lambda () 8 | (acquire lock) 9 | (set! counter (- counter 1)) 10 | (release lock))) 11 | (t1 (fork (inc))) 12 | (t2 (fork (dec))) 13 | (t3 (fork (inc))) 14 | (t4 (fork (dec))) 15 | (t5 (fork (inc))) 16 | (t6 (fork (dec)))) 17 | (join t1) 18 | (join t2) 19 | (join t3) 20 | (join t4) 21 | (join t5) 22 | (join t6)) 23 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/mutex2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((lock #f) 2 | (acq (lambda () 3 | (if (cas lock #f #t) 4 | #t 5 | (acq)))) 6 | (rel (lambda () 7 | (set! lock #f))) 8 | (counter 0) 9 | (inc (lambda () 10 | (acq) 11 | (set! counter (+ counter 1)) 12 | (rel))) 13 | (t1 (fork (inc))) 14 | (t2 (fork (inc)))) 15 | (join t1) 16 | (join t2) 17 | #t) 18 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/mutex3.scm: -------------------------------------------------------------------------------- 1 | (letrec ((lock #f) 2 | (acq (lambda () 3 | (if (cas lock #f #t) 4 | #t 5 | (acq)))) 6 | (rel (lambda () 7 | (set! lock #f))) 8 | (counter 0) 9 | (inc (lambda () 10 | (acq) 11 | (set! counter (+ counter 1)) 12 | (rel))) 13 | (t1 (fork (inc))) 14 | (t2 (fork (inc))) 15 | (t3 (fork (inc)))) 16 | (join t1) 17 | (join t2) 18 | (join t3) 19 | #t) 20 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/mutex4.scm: -------------------------------------------------------------------------------- 1 | (letrec ((lock #f) 2 | (acq (lambda () 3 | (if (cas lock #f #t) 4 | #t 5 | (acq)))) 6 | (rel (lambda () 7 | (set! lock #f))) 8 | (counter 0) 9 | (inc (lambda () 10 | (acq) 11 | (set! counter (+ counter 1)) 12 | (rel))) 13 | (t1 (fork (inc))) 14 | (t2 (fork (inc))) 15 | (t3 (fork (inc))) 16 | (t4 (fork (inc)))) 17 | (join t1) 18 | (join t2) 19 | (join t3) 20 | (join t4) 21 | #t) 22 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/mutex5.scm: -------------------------------------------------------------------------------- 1 | (letrec ((lock #f) 2 | (acq (lambda () 3 | (if (cas lock #f #t) 4 | #t 5 | (acq)))) 6 | (rel (lambda () 7 | (set! lock #f))) 8 | (counter 0) 9 | (inc (lambda () 10 | (acq) 11 | (set! counter (+ counter 1)) 12 | (rel))) 13 | (t1 (fork (inc))) 14 | (t2 (fork (inc))) 15 | (t3 (fork (inc))) 16 | (t4 (fork (inc))) 17 | (t5 (fork (inc)))) 18 | (join t1) 19 | (join t2) 20 | (join t3) 21 | (join t4) 22 | (join t5) 23 | #t) 24 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/mutex6.scm: -------------------------------------------------------------------------------- 1 | (letrec ((lock #f) 2 | (acq (lambda () 3 | (if (cas lock #f #t) 4 | #t 5 | (acq)))) 6 | (rel (lambda () 7 | (set! lock #f))) 8 | (counter 0) 9 | (inc (lambda () 10 | (acq) 11 | (set! counter (+ counter 1)) 12 | (rel))) 13 | (t1 (fork (inc))) 14 | (t2 (fork (inc))) 15 | (t3 (fork (inc))) 16 | (t4 (fork (inc))) 17 | (t5 (fork (inc))) 18 | (t6 (fork (inc)))) 19 | (join t1) 20 | (join t2) 21 | (join t3) 22 | (join t4) 23 | (join t5) 24 | (join t6) 25 | #t) 26 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter10.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4))) 12 | (t5 (fork (thread 5))) 13 | (t6 (fork (thread 6))) 14 | (t7 (fork (thread 7))) 15 | (t8 (fork (thread 8))) 16 | (t9 (fork (thread 9))) 17 | (t10 (fork (thread 10)))) 18 | (join t1) 19 | (join t2) 20 | (join t3) 21 | (join t4) 22 | (join t5) 23 | (join t6) 24 | (join t7) 25 | (join t8) 26 | (join t9) 27 | (join t10)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter11.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4))) 12 | (t5 (fork (thread 5))) 13 | (t6 (fork (thread 6))) 14 | (t7 (fork (thread 7))) 15 | (t8 (fork (thread 8))) 16 | (t9 (fork (thread 9))) 17 | (t10 (fork (thread 10))) 18 | (t11 (fork (thread 11)))) 19 | (join t1) 20 | (join t2) 21 | (join t3) 22 | (join t4) 23 | (join t5) 24 | (join t6) 25 | (join t7) 26 | (join t8) 27 | (join t9) 28 | (join t10) 29 | (join t11)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter12.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4))) 12 | (t5 (fork (thread 5))) 13 | (t6 (fork (thread 6))) 14 | (t7 (fork (thread 7))) 15 | (t8 (fork (thread 8))) 16 | (t9 (fork (thread 9))) 17 | (t10 (fork (thread 10))) 18 | (t11 (fork (thread 11))) 19 | (t12 (fork (thread 12)))) 20 | (join t1) 21 | (join t2) 22 | (join t3) 23 | (join t4) 24 | (join t5) 25 | (join t6) 26 | (join t7) 27 | (join t8) 28 | (join t9) 29 | (join t10) 30 | (join t11) 31 | (join t12)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter13.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4))) 12 | (t5 (fork (thread 5))) 13 | (t6 (fork (thread 6))) 14 | (t7 (fork (thread 7))) 15 | (t8 (fork (thread 8))) 16 | (t9 (fork (thread 9))) 17 | (t10 (fork (thread 10))) 18 | (t11 (fork (thread 11))) 19 | (t12 (fork (thread 12))) 20 | (t13 (fork (thread 13)))) 21 | (join t1) 22 | (join t2) 23 | (join t3) 24 | (join t4) 25 | (join t5) 26 | (join t6) 27 | (join t7) 28 | (join t8) 29 | (join t9) 30 | (join t10) 31 | (join t11) 32 | (join t12) 33 | (join t13)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter14.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4))) 12 | (t5 (fork (thread 5))) 13 | (t6 (fork (thread 6))) 14 | (t7 (fork (thread 7))) 15 | (t8 (fork (thread 8))) 16 | (t9 (fork (thread 9))) 17 | (t10 (fork (thread 10))) 18 | (t11 (fork (thread 11))) 19 | (t12 (fork (thread 12))) 20 | (t13 (fork (thread 13))) 21 | (t14 (fork (thread 14)))) 22 | (join t1) 23 | (join t2) 24 | (join t3) 25 | (join t4) 26 | (join t5) 27 | (join t6) 28 | (join t7) 29 | (join t8) 30 | (join t9) 31 | (join t10) 32 | (join t11) 33 | (join t12) 34 | (join t13) 35 | (join t14)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter15.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4))) 12 | (t5 (fork (thread 5))) 13 | (t6 (fork (thread 6))) 14 | (t7 (fork (thread 7))) 15 | (t8 (fork (thread 8))) 16 | (t9 (fork (thread 9))) 17 | (t10 (fork (thread 10))) 18 | (t11 (fork (thread 11))) 19 | (t12 (fork (thread 12))) 20 | (t13 (fork (thread 13))) 21 | (t14 (fork (thread 14))) 22 | (t15 (fork (thread 15)))) 23 | (join t1) 24 | (join t2) 25 | (join t3) 26 | (join t4) 27 | (join t5) 28 | (join t6) 29 | (join t7) 30 | (join t8) 31 | (join t9) 32 | (join t10) 33 | (join t11) 34 | (join t12) 35 | (join t13) 36 | (join t14) 37 | (join t15)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2)))) 10 | (join t1) 11 | (join t2)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter3.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3)))) 11 | (join t1) 12 | (join t2) 13 | (join t3)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter4.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4)))) 12 | (join t1) 13 | (join t2) 14 | (join t3) 15 | (join t4)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter5.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4))) 12 | (t5 (fork (thread 5)))) 13 | (join t1) 14 | (join t2) 15 | (join t3) 16 | (join t4) 17 | (join t5)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter6.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4))) 12 | (t5 (fork (thread 5))) 13 | (t6 (fork (thread 6)))) 14 | (join t1) 15 | (join t2) 16 | (join t3) 17 | (join t4) 18 | (join t5) 19 | (join t6)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter7.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4))) 12 | (t5 (fork (thread 5))) 13 | (t6 (fork (thread 6))) 14 | (t7 (fork (thread 7)))) 15 | (join t1) 16 | (join t2) 17 | (join t3) 18 | (join t4) 19 | (join t5) 20 | (join t6) 21 | (join t7)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter8.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4))) 12 | (t5 (fork (thread 5))) 13 | (t6 (fork (thread 6))) 14 | (t7 (fork (thread 7))) 15 | (t8 (fork (thread 8)))) 16 | (join t1) 17 | (join t2) 18 | (join t3) 19 | (join t4) 20 | (join t5) 21 | (join t6) 22 | (join t7) 23 | (join t8)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/pcounter9.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (thread (lambda (n) 3 | (letrec ((old counter) 4 | (new (+ old 1))) 5 | (if (cas counter old new) 6 | #t 7 | (thread n))))) 8 | (t1 (fork (thread 1))) 9 | (t2 (fork (thread 2))) 10 | (t3 (fork (thread 3))) 11 | (t4 (fork (thread 4))) 12 | (t5 (fork (thread 5))) 13 | (t6 (fork (thread 6))) 14 | (t7 (fork (thread 7))) 15 | (t8 (fork (thread 8))) 16 | (t9 (fork (thread 9)))) 17 | (join t1) 18 | (join t2) 19 | (join t3) 20 | (join t4) 21 | (join t5) 22 | (join t6) 23 | (join t7) 24 | (join t8) 25 | (join t9)) -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/race2.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (inc (lambda () 3 | (set! counter (+ counter 1)))) 4 | (dec (lambda () 5 | (set! counter (- counter 1)))) 6 | (t1 (fork (inc))) 7 | (t2 (fork (dec)))) 8 | (join t1) 9 | (join t2) 10 | counter) 11 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/race3.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (inc (lambda () 3 | (set! counter (+ counter 1)))) 4 | (dec (lambda () 5 | (set! counter (- counter 1)))) 6 | (t1 (fork (inc))) 7 | (t2 (fork (dec))) 8 | (t3 (fork (inc)))) 9 | (join t1) 10 | (join t2) 11 | (join t3) 12 | counter) 13 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/race4.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (inc (lambda () 3 | (set! counter (+ counter 1)))) 4 | (dec (lambda () 5 | (set! counter (- counter 1)))) 6 | (t1 (fork (inc))) 7 | (t2 (fork (dec))) 8 | (t3 (fork (inc))) 9 | (t4 (fork (dec)))) 10 | (join t1) 11 | (join t2) 12 | (join t3) 13 | (join t4) 14 | counter) 15 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/race5.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (inc (lambda () 3 | (set! counter (+ counter 1)))) 4 | (dec (lambda () 5 | (set! counter (- counter 1)))) 6 | (t1 (fork (inc))) 7 | (t2 (fork (dec))) 8 | (t3 (fork (inc))) 9 | (t4 (fork (dec))) 10 | (t5 (fork (inc)))) 11 | (join t1) 12 | (join t2) 13 | (join t3) 14 | (join t4) 15 | (join t5) 16 | counter) 17 | -------------------------------------------------------------------------------- /test/concurrentScheme/threads/variations/race6.scm: -------------------------------------------------------------------------------- 1 | (letrec ((counter 0) 2 | (inc (lambda () 3 | (set! counter (+ counter 1)))) 4 | (dec (lambda () 5 | (set! counter (- counter 1)))) 6 | (t1 (fork (inc))) 7 | (t2 (fork (dec))) 8 | (t3 (fork (inc))) 9 | (t4 (fork (dec))) 10 | (t5 (fork (inc))) 11 | (t6 (fork (dec)))) 12 | (join t1) 13 | (join t2) 14 | (join t3) 15 | (join t4) 16 | (join t5) 17 | (join t6) 18 | counter) 19 | --------------------------------------------------------------------------------