├── .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 |
--------------------------------------------------------------------------------