├── .gitignore
├── LICENSE
├── README.md
├── abcs
    ├── 00-primordia
    │   ├── array-trait.cant
    │   ├── list-trait.cant
    │   ├── map-trait.cant
    │   ├── miranda-trait.cant
    │   ├── runtime.cant
    │   ├── sink-trait.cant
    │   ├── sugar.cant
    │   └── types
    │   │   ├── array.cant
    │   │   ├── bool.cant
    │   │   ├── box.cant
    │   │   ├── cps.cant
    │   │   ├── ejector.cant
    │   │   ├── link.cant
    │   │   ├── map.cant
    │   │   ├── nil.cant
    │   │   ├── number.cant
    │   │   ├── procedure.cant
    │   │   ├── rune.cant
    │   │   ├── script.cant
    │   │   ├── setting.cant
    │   │   ├── sink.cant
    │   │   ├── source.cant
    │   │   ├── symbol.cant
    │   │   ├── term.cant
    │   │   ├── text.cant
    │   │   ├── void.cant
    │   │   └── zilch.cant
    ├── 20-cant.cant
    ├── 21-sequels.cant
    ├── 30-functions.cant
    ├── 40-library.cant
    ├── 50-top.cant
    └── README.md
├── attic
    ├── Makefile
    ├── another-old-compiler-sketch.scm
    ├── benchmark
    ├── bob.scm
    ├── intset.rkt
    ├── mplus.scm
    ├── new-kernel.scm
    ├── new-parse.scm
    ├── new-self-terp-simplified.rkt
    ├── new-self-terp.scm
    ├── new.scm
    ├── pair.scm
    ├── search-problem.scm
    └── stdlib-attic.scm
├── bless-tests
├── cant.scm
├── examples
    ├── advent-of-code
    │   ├── 2018
    │   │   ├── 01.cant
    │   │   ├── 02.cant
    │   │   ├── 03.cant
    │   │   ├── 04.cant
    │   │   ├── 05.cant
    │   │   ├── 06.cant
    │   │   ├── 07.cant
    │   │   ├── 08.cant
    │   │   ├── 09.cant
    │   │   ├── 10.cant
    │   │   ├── 11.cant
    │   │   ├── 12.cant
    │   │   ├── 13.cant
    │   │   ├── 14.cant
    │   │   ├── 15.cant
    │   │   ├── 16.cant
    │   │   ├── 17.cant
    │   │   ├── 18.cant
    │   │   ├── 19.cant
    │   │   ├── 20.cant
    │   │   ├── 21.cant
    │   │   ├── 22.cant
    │   │   ├── 23.cant
    │   │   ├── 24.cant
    │   │   ├── 25.cant
    │   │   ├── README.md
    │   │   ├── data
    │   │   │   ├── 01.in
    │   │   │   ├── 02.in
    │   │   │   ├── 03.in
    │   │   │   ├── 04.in
    │   │   │   ├── 05.in
    │   │   │   ├── 06.in
    │   │   │   ├── 06.test
    │   │   │   ├── 07.in
    │   │   │   ├── 07.test
    │   │   │   ├── 08.in
    │   │   │   ├── 08.test
    │   │   │   ├── 09.in
    │   │   │   ├── 10.in
    │   │   │   ├── 10.test
    │   │   │   ├── 11.in
    │   │   │   ├── 12.in
    │   │   │   ├── 12.test
    │   │   │   ├── 13.in
    │   │   │   ├── 13.test
    │   │   │   ├── 13.test1
    │   │   │   ├── 13.test2
    │   │   │   ├── 14.in
    │   │   │   ├── 15.combat1
    │   │   │   ├── 15.combat2
    │   │   │   ├── 15.combat3
    │   │   │   ├── 15.combat4
    │   │   │   ├── 15.combat5
    │   │   │   ├── 15.in
    │   │   │   ├── 15.movement
    │   │   │   ├── 15.movement2
    │   │   │   ├── 15.test
    │   │   │   ├── 15.test-movement
    │   │   │   ├── 16.in
    │   │   │   ├── 16.test
    │   │   │   ├── 17.in
    │   │   │   ├── 17.test
    │   │   │   ├── 18.in
    │   │   │   ├── 18.test
    │   │   │   ├── 19.in
    │   │   │   ├── 19.test
    │   │   │   ├── 20.in
    │   │   │   ├── 21.in
    │   │   │   ├── 22.in
    │   │   │   ├── 22.test
    │   │   │   ├── 23.in
    │   │   │   ├── 24.in
    │   │   │   ├── 24.test
    │   │   │   ├── 25.in
    │   │   │   ├── 25.test0
    │   │   │   ├── 25.test1
    │   │   │   ├── 25.test2
    │   │   │   ├── 25.test3
    │   │   │   └── 25.test4
    │   │   ├── elfcode.cant
    │   │   └── run.cant
    │   ├── 2019
    │   │   ├── 01.cant
    │   │   ├── 02.cant
    │   │   ├── 03.cant
    │   │   ├── 04.cant
    │   │   ├── 05.cant
    │   │   ├── 06.cant
    │   │   ├── data
    │   │   │   ├── 01.in
    │   │   │   ├── 02.in
    │   │   │   ├── 03.in
    │   │   │   ├── 04.in
    │   │   │   ├── 05.in
    │   │   │   └── 06.in
    │   │   ├── intcode.cant
    │   │   └── run.cant
    │   ├── 2020
    │   │   ├── 01.cant
    │   │   ├── 02.cant
    │   │   ├── 03.cant
    │   │   ├── 04.cant
    │   │   ├── 05.cant
    │   │   ├── 06.cant
    │   │   ├── 07.cant
    │   │   ├── 08.cant
    │   │   ├── 09.cant
    │   │   ├── 10.cant
    │   │   ├── 11.cant
    │   │   ├── 12.cant
    │   │   ├── 13.cant
    │   │   ├── 14.cant
    │   │   ├── 15.cant
    │   │   ├── 16.cant
    │   │   ├── 17.cant
    │   │   ├── 18.cant
    │   │   ├── 19.cant
    │   │   ├── 20.cant
    │   │   ├── data
    │   │   │   ├── 01.in
    │   │   │   ├── 02.in
    │   │   │   ├── 03.in
    │   │   │   ├── 04.in
    │   │   │   ├── 05.in
    │   │   │   ├── 06.in
    │   │   │   ├── 07.in
    │   │   │   ├── 08.in
    │   │   │   ├── 09.in
    │   │   │   ├── 10.in
    │   │   │   ├── 11.in
    │   │   │   ├── 12.in
    │   │   │   ├── 13.in
    │   │   │   ├── 14.in
    │   │   │   ├── 15.in
    │   │   │   ├── 16.in
    │   │   │   ├── 17.in
    │   │   │   ├── 18.in
    │   │   │   ├── 19.in
    │   │   │   └── 20.in
    │   │   └── run.cant
    │   ├── 2021
    │   │   ├── 01.cant
    │   │   ├── 02.cant
    │   │   ├── 03.cant
    │   │   ├── 04.cant
    │   │   ├── 05.cant
    │   │   ├── 06.cant
    │   │   ├── 07.cant
    │   │   ├── data
    │   │   │   ├── 01.in
    │   │   │   ├── 02.in
    │   │   │   ├── 03.in
    │   │   │   ├── 04.in
    │   │   │   ├── 05.in
    │   │   │   ├── 06.in
    │   │   │   └── 07.in
    │   │   ├── run.cant
    │   │   └── template.cant
    │   ├── 2023
    │   │   ├── 01.cant
    │   │   ├── 02.cant
    │   │   ├── 03.cant
    │   │   ├── 04.cant
    │   │   ├── 05.cant
    │   │   ├── 06.cant
    │   │   ├── 07.cant
    │   │   ├── 08.cant
    │   │   ├── 09.cant
    │   │   ├── 10.cant
    │   │   ├── data
    │   │   │   ├── 01.in
    │   │   │   ├── 02.in
    │   │   │   ├── 03.in
    │   │   │   ├── 04.in
    │   │   │   ├── 05.in
    │   │   │   ├── 06.in
    │   │   │   ├── 07.in
    │   │   │   ├── 08.in
    │   │   │   └── 09.in
    │   │   ├── run.cant
    │   │   └── template.cant
    │   ├── adventget.py
    │   └── utils.cant
    ├── automata
    │   ├── elementary-ca.cant
    │   ├── fractran.cant
    │   ├── game-of-life.cant
    │   ├── popcode.cant
    │   ├── slow-life.cant
    │   ├── text-register-machine.cant
    │   └── turing-machine.cant
    ├── beer.cant
    ├── benchmarks
    │   ├── dumb-prime-benchmark.cant
    │   └── sieve.cant
    ├── brainfuck
    │   ├── brainfuck.cant
    │   └── hello.bf
    ├── cant.cant
    ├── capability-patterns
    │   └── revoke.cant
    ├── code-golf
    │   ├── README.md
    │   ├── christmas-trees.cant
    │   └── squiggly-sequence.cant
    ├── coding-theory
    │   ├── hamming-codes.cant
    │   ├── huffman-coding.cant
    │   ├── lzw-compression.cant
    │   └── weighted-code.cant
    ├── csv.cant
    ├── cult-of-the-bound-variable.cant
    ├── dole-editor
    │   ├── README.md
    │   ├── buffer.cant
    │   ├── console.cant
    │   ├── display.cant
    │   ├── dole.cant
    │   ├── editor.cant
    │   ├── fundamental-mode.cant
    │   ├── key-map.cant
    │   ├── keyboard.cant
    │   └── rune-set.cant
    ├── exercises-and-puzzles
    │   ├── cryptarithmetic-brute.cant
    │   ├── cryptarithmetic-csp.cant
    │   ├── ghost.cant
    │   ├── max-path-sum.cant
    │   ├── max-subsegment-sum.cant
    │   ├── n-queens.cant
    │   ├── send-more-money.cant
    │   ├── sicp1.cant
    │   └── sicp2.cant
    ├── failing.cant
    ├── fizzbuzz.cant
    ├── forthish-sort-of.cant
    ├── functional-geometry.cant
    ├── games
    │   ├── 2048.cant
    │   ├── animals.cant
    │   ├── animals.data
    │   ├── chess-play.cant
    │   ├── chess.cant
    │   ├── connect4.cant
    │   ├── cryptogram.cant
    │   ├── glutton
    │   │   ├── glutton.cant
    │   │   └── glutton.maze
    │   ├── hunt-the-wumpus.cant
    │   ├── lol-robots.cant
    │   ├── microban
    │   ├── sat-puzzle
    │   │   ├── README.md
    │   │   ├── factoring2.dimacs
    │   │   ├── factoring6.dimacs
    │   │   ├── sat-puzzle.cant
    │   │   ├── subsetsum_random.dimacs
    │   │   └── trivial.dimacs
    │   ├── sokoban.cant
    │   ├── tictactoe.cant
    │   └── wordles.cant
    ├── intset1.cant
    ├── intset2.cant
    ├── j-bob-proof-checker
    │   ├── README.md
    │   ├── prelude.cant
    │   ├── run-trivi-bob.cant
    │   ├── runtime.cant
    │   ├── smoketest.cant
    │   └── trivi-bob.cant
    ├── lambda-calculus
    │   ├── README.md
    │   ├── compact-lambda.cant
    │   ├── compiler1.cant
    │   ├── examples
    │   │   ├── church.lambda
    │   │   ├── elementary-ca.lambda
    │   │   ├── factorial.lambda
    │   │   ├── reverse.lambda
    │   │   ├── trivial1.lambda
    │   │   ├── trivial2.lambda
    │   │   └── turing-scott.lambda
    │   ├── interpreter.cant
    │   ├── lambdacompiler.cant
    │   ├── lambdaterp.cant
    │   ├── parser.cant
    │   └── prelude.cant
    ├── maze.cant
    ├── miasma-x86-toolkit
    │   ├── README.md
    │   ├── c
    │   │   └── asm_stuff.h
    │   ├── code-gen.cant
    │   ├── parse.cant
    │   ├── python
    │   │   └── x86_stub.py
    │   ├── registers.cant
    │   └── tables
    │   │   ├── i386.scm
    │   │   ├── i387.scm
    │   │   ├── i486.scm
    │   │   ├── i586.scm
    │   │   ├── i586mmx.scm
    │   │   ├── i686.scm
    │   │   └── problems.scm
    ├── nand-circuit-optimizer.cant
    ├── prefix-to-infix.cant
    ├── primes.cant
    ├── project-oiler
    │   ├── 01.cant
    │   ├── 02.cant
    │   ├── 03.cant
    │   ├── 04.cant
    │   ├── 05.cant
    │   ├── 06.cant
    │   ├── 07.cant
    │   ├── 08.cant
    │   ├── 09.cant
    │   ├── 10.cant
    │   ├── 11.cant
    │   ├── 12.cant
    │   ├── 13.cant
    │   ├── 14.cant
    │   ├── 15.cant
    │   ├── 16.cant
    │   ├── 17.cant
    │   ├── 18.cant
    │   ├── 19.cant
    │   ├── 20.cant
    │   ├── 21.cant
    │   ├── 22.cant
    │   ├── 23.cant
    │   ├── 24.cant
    │   ├── 25.cant
    │   ├── 26.cant
    │   ├── 27.cant
    │   ├── 28.cant
    │   ├── 29.cant
    │   ├── 30.cant
    │   ├── 31.cant
    │   ├── 32.cant
    │   ├── 33.cant
    │   ├── 34.cant
    │   ├── 35.cant
    │   ├── 36.cant
    │   ├── 37.cant
    │   ├── 38.cant
    │   ├── 39.cant
    │   ├── 40.cant
    │   ├── 41.cant
    │   ├── 42.cant
    │   ├── 43.cant
    │   ├── README.md
    │   ├── p022_names.comma.txt
    │   ├── p042_words.comma.txt
    │   └── utils.cant
    ├── refactoring
    │   ├── search-cant-code.cant
    │   └── search-for-list-pats.cant
    ├── rosetta-code
    │   ├── floyd-triangle.cant
    │   ├── hundred-doors.cant
    │   └── jewels-and-stones.cant
    ├── smalltalk72ish-sort-of.cant
    ├── squickcheck-examples.cant
    ├── squirm
    │   ├── README.md
    │   ├── examples
    │   │   ├── hello.squirm
    │   │   ├── mutex.squirm
    │   │   └── universal_server.squirm
    │   ├── library
    │   │   └── foo.cant
    │   ├── prelude.squirm
    │   ├── squirm-interpreter.cant
    │   ├── squirm.cant
    │   └── test
    │   │   ├── error-test.squirm
    │   │   ├── mod-test.squirm
    │   │   ├── monitor-test.squirm
    │   │   ├── partner-test.squirm
    │   │   ├── quasiquote-test.squirm
    │   │   ├── recur-test.squirm
    │   │   ├── silly.squirm
    │   │   ├── smoke-test.squirm
    │   │   ├── throw-test.squirm
    │   │   └── timeout-test.squirm
    ├── terminal
    │   ├── echo.cant
    │   └── typing-drill.cant
    └── text
    │   ├── anagram-words.cant
    │   ├── kwic.cant
    │   ├── markov-text.cant
    │   ├── most-common.cant
    │   ├── oodles.cant
    │   ├── spelling.cant
    │   └── spelling.train.text
├── guide.md
├── incant
├── library
    ├── ansi-terminal.cant
    ├── bag.cant
    ├── bdd.cant
    ├── binary-relations.cant
    ├── bounded-writer.cant
    ├── calendar.cant
    ├── cant-source-walker.cant
    ├── chaos.cant
    ├── complex.cant
    ├── csp.cant
    ├── cycle-write.cant
    ├── dd.cant
    ├── debugger.cant
    ├── english-numbers.cant
    ├── factoring.cant
    ├── flexarray.cant
    ├── flextext.cant
    ├── format-tables.cant
    ├── grid-2d.cant
    ├── memoize.cant
    ├── minikanren.cant
    ├── mostly-linear.cant
    ├── pairing-heap.cant
    ├── parse.cant
    ├── parson-core.cant
    ├── parson.cant
    ├── polynomials.cant
    ├── pretty-layout.cant
    ├── pretty-print.cant
    ├── queue.cant
    ├── ratio.cant
    ├── regex-gen.cant
    ├── regex-match.cant
    ├── regex-parse.cant
    ├── roman.cant
    ├── sort.cant
    ├── squickcheck.cant
    ├── sset.cant
    ├── sturm.cant
    ├── text-find.cant
    ├── text-wrap.cant
    ├── traceback.cant
    └── unify.cant
├── player
    ├── abcs.scm
    ├── ast.scm
    ├── elaborate.scm
    ├── equality.scm
    ├── macros.scm
    ├── nonmeta-primitives.scm
    ├── parse.scm
    ├── player.scm
    ├── primordia.scm
    ├── read.scm
    ├── setting.scm
    ├── source.scm
    ├── thing.scm
    └── util.scm
├── plug-ins
    ├── cant-mode.el
    └── cant.st
├── run-tests
├── system-goals.md
├── t
└── test
    ├── smoke-test.cant
    ├── test-2048.cant
    ├── test-bag.cant
    ├── test-catch.cant
    ├── test-complex.cant
    ├── test-continuations.cant
    ├── test-cycle-write.cant
    ├── test-dd.cant
    ├── test-english-numbers.cant
    ├── test-export-import.cant
    ├── test-factor.cant
    ├── test-flexarray.cant
    ├── test-flextext.cant
    ├── test-format-tables.cant
    ├── test-format.cant
    ├── test-hashmap.cant
    ├── test-hashset.cant
    ├── test-huffman-coding.cant
    ├── test-lambda.cant
    ├── test-memoize.cant
    ├── test-metacircular.cant
    ├── test-module-for-use.cant
    ├── test-n-queens.cant
    ├── test-oiler-further.cant
    ├── test-oiler.cant
    ├── test-omnibus.cant
    ├── test-pairing-heap.cant
    ├── test-parse.cant
    ├── test-parson-squared.cant
    ├── test-parson.cant
    ├── test-pattern-matching.cant
    ├── test-pretty-print.cant
    ├── test-quasiquote.cant
    ├── test-quick.cant
    ├── test-random.cant
    ├── test-ratio.cant
    ├── test-regex-gen.cant
    ├── test-regex-match-painfully.cant
    ├── test-regex-match.cant
    ├── test-roman.cant
    ├── test-sokoban.cant
    ├── test-sort.cant
    ├── test-squirm.cant
    ├── test-sset.cant
    ├── test-text-find.cant
    ├── test-text-wrap.cant
    ├── test-texts.cant
    ├── test-unify.cant
    └── test-use.cant


/.gitignore:
--------------------------------------------------------------------------------
 1 | *~
 2 | *.expected
 3 | *.out
 4 | 
 5 | benchmark-log
 6 | 
 7 | junk/
 8 | notes/
 9 | old/
10 | others/
11 | paip/
12 | save/
13 | 
14 | # Object files
15 | *.o
16 | *.ko
17 | *.obj
18 | *.elf
19 | 
20 | # Precompiled Headers
21 | *.gch
22 | *.pch
23 | 
24 | # Libraries
25 | *.lib
26 | *.a
27 | *.la
28 | *.lo
29 | 
30 | # Shared objects (inc. Windows DLLs)
31 | *.dll
32 | *.so
33 | *.so.*
34 | *.dylib
35 | 
36 | # Executables
37 | *.exe
38 | *.out
39 | *.app
40 | *.i*86
41 | *.x86_64
42 | *.hex
43 | 
44 | # Debug files
45 | *.dSYM/
46 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/miranda-trait.cant:
--------------------------------------------------------------------------------
1 | ;; The default trait for scripts without an explicit trait.
2 | 
3 | (make-trait miranda-trait me
4 | 
5 |   (to (~ .selfie sink) (sink .display (__depict me)))
6 | 
7 |   (to message (oops "Match failure" me message)))
8 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/sink-trait.cant:
--------------------------------------------------------------------------------
 1 | (make-trait sink-trait sink
 2 | 
 3 |   (to (~ .write a)
 4 |     (a .selfie sink))
 5 | 
 6 |   ;; TODO include this as a default?:
 7 |   ;; (to (~ .display a) (sink .write a))
 8 | 
 9 |   ;; TODO .say is a lousy name, but:
10 |   ;;  - needs to be distinct from text .format, and I haven't
11 |   ;;    thought of a good other name
12 |   ;;  - the whole format-text paradigm isn't quite in keeping with
13 |   ;;    the plain-language style I'm aiming for, so consider this
14 |   ;;    temporary
15 |   (to (~ .say format-text @arguments)
16 |     (format .to-sink sink format-text @arguments))
17 | 
18 |   (to ~.newline
19 |     (sink .display #\newline))
20 | 
21 |   (to (~ .print a)                      ;TODO ugh the name
22 |     (sink .write a)
23 |     sink.newline)
24 | 
25 |   (to (~ .displayln a)                  ;TODO ugh the name
26 |     (sink .display a)
27 |     sink.newline)
28 | 
29 |   (to (~ .display-lines lines) ;; To go with source.read-lines
30 |     (each! ||(sink .displayln it) lines))
31 | 
32 |   (to message
33 |     (miranda-trait sink message)))
34 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/sugar.cant:
--------------------------------------------------------------------------------
 1 | ;; Definitions used by desugared code
 2 | 
 3 | (to (as-list seq)            ;XXX naming convention for coercions?
 4 |   (if (list? seq)            ;XXX doesn't check the whole list, only the first link
 5 |       seq
 6 |       (do copying [seq]
 7 |         (if seq.none?
 8 |             '()
 9 |             (link seq.first (copying seq.rest))))))
10 | 
11 | (to (array<-list xs)
12 |   (__array<-list (as-list xs)))
13 | 
14 | (to (array<- @elements)
15 |   (__array<-list elements))
16 | 
17 | (to (map<- @items)
18 |   (map<-items items))
19 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/array.cant:
--------------------------------------------------------------------------------
 1 | (make-trait array-primitive me
 2 | 
 3 |   (to ~.none?         (= 0 me.count))   ;redundant definition(s) for speed
 4 |   (to (~ .set! i val) (__vector-set! me i val))
 5 |   (to ~.count         (__vector-length me))
 6 |   (to (~ i)           (__vector-ref me i))
 7 |   (to (~ .maps? i)    (__vector-maps? me i))
 8 |   (to (~ .chain v)    (__vector-append me v))
 9 |   (to ~.values        (__vector->list me))
10 |   (to (~ .from i)     (__subvector me i me.count))
11 |   (to (~ .from i j)   (__subvector me i j))
12 | 
13 |   (to (-- (~ .move! dst source lo bound)
14 |           message)
15 |     ;; Block-copy source[lo..bound) to me[dst..dst+(bound-lo)).
16 |     (if (array? source)
17 |         (__vector-move! me dst source lo bound)
18 |         (array-trait me message)))
19 | 
20 |   (to ~.copy          (__vector-copy me))
21 | 
22 |   (to (~ .selfie sink)
23 |     (sink .display "[")
24 |     (when (< 0 me.count)
25 |       (sink .write (me 0))
26 |       (for each! [(x ((__vector->list me) .rest))]
27 |         (sink .display #\space)
28 |         (sink .write x)))
29 |     (sink .display "]"))
30 | 
31 |   (to ~.first         (oops "no .first on array" me))
32 |   (to ~.rest          (oops "no .rest on array" me))
33 | 
34 |   (to message
35 |     (array-trait me message))) ;XXX use trait syntax instead
36 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/bool.cant:
--------------------------------------------------------------------------------
 1 | (make-trait bool-primitive me
 2 | 
 3 |   (to ~.count          (if me 1 0))
 4 | 
 5 |   (to (~ .selfie sink) (sink .display (if me "#yes" "#no")))
 6 | 
 7 |   (to (~ .compare a)
 8 |     (may a
 9 |       (be #no  (if me '> '=))
10 |       (be #yes (if me '= '<))
11 |       (else #no)))
12 | 
13 |   )
14 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/box.cant:
--------------------------------------------------------------------------------
 1 | ;; TODO: should a box be a collection?
 2 | (make-trait box-primitive me
 3 | 
 4 |   (to ~.^             (__box-value me))
 5 |   (to (~ .^= value)   (__box-value-set! me value))
 6 | 
 7 |   (to (~ .update f) ;TODO better name? I left out the '!' to emphasize it returns the value
 8 |     (let value (f me.^))
 9 |     (me .^= value)
10 |     value)                              ;TODO return void instead?
11 | 
12 |   (to ~.+1! (me .update ~.+1)) ;; (questionably worth it; name inconsistent with the above note)
13 |   (to ~.-1! (me .update ~.-1))
14 | 
15 |   (to (~ .+= n)   ;; XXX inconsistent in return value wrt ~.+1!
16 |     (me .^= (+ me.^ n)))
17 |   (to (~ .-= n)
18 |     (me .^= (- me.^ n)))
19 | 
20 |   (to (~ .selfie sink)
21 |     (sink .display "<box ")
22 |     (sink .write me.^)
23 |     (sink .display ">"))
24 | 
25 |   )
26 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/cps.cant:
--------------------------------------------------------------------------------
 1 | ;; A cps-primitive is like a procedure-primitive, but following a
 2 | ;; different internal calling convention than the usual Scheme
 3 | ;; procedures like __+ and so on.
 4 | 
 5 | ;; There's a magical behavior internal to the player, not expressed in
 6 | ;; this script: if the message is a tuple, then handle it with the
 7 | ;; Scheme code of this cps-primitive. For all other message types,
 8 | ;; use the script below.
 9 | 
10 | (make-trait cps-primitive me
11 | 
12 |   (to (~ .selfie sink)
13 |     (sink .display "#<primitive ")
14 |     (sink .display (__cps-primitive-name me))
15 |     (sink .display ">"))
16 | 
17 |   )
18 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/ejector.cant:
--------------------------------------------------------------------------------
 1 | (make-trait ejector-primitive me
 2 | 
 3 |   (to (~ .eject value)
 4 |     (__eject me value))
 5 | 
 6 |   (to (~ .selfie sink)
 7 |     (sink .display "#<ejector>"))       ;TODO show enabledness
 8 | 
 9 |   )
10 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/link.cant:
--------------------------------------------------------------------------------
 1 | (make-trait link-primitive me
 2 | 
 3 |   (to ~.none?       #no)
 4 |   (to ~.first       (__car me))
 5 |   (to ~.rest        (__cdr me))
 6 |   (to ~.count       (__length me))
 7 |   (to (~ i)         (__list-ref me i))    ;XXX just use the trait method? then can e.g. mix lazy and eager list nodes
 8 |   (to (~ .chain a)  (__append me a)) ;TODO fall back to list-trait if a is not a list
 9 | 
10 |   (to (~ .selfie sink)
11 |     (may me
12 |       (be `(quote ,x)
13 |         (sink .display "'")
14 |         (sink .write x))
15 |       (else
16 |        (sink .display "(")
17 |        (sink .write me.first)
18 |        (do printing [(r me.rest)]
19 |          (hm (when (link? r)
20 |                (sink .display " ")
21 |                (sink .write r.first)
22 |                (printing r.rest))
23 |              (when (null? r))
24 |              (else
25 |                (sink .display " . ")       ;XXX we're not supporting this in read, iirc
26 |                (sink .write r))))
27 |        (sink .display ")"))))
28 | 
29 |   (to message
30 |     (list-trait me message))) ;XXX use trait syntax instead
31 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/map.cant:
--------------------------------------------------------------------------------
 1 | ;; Immutable maps, placeholder implementation
 2 | ;; N.B. (export foo bar) gets expanded into code like
 3 | ;;   (map<- (~ 'foo foo) (~ 'bar bar))
 4 | ;; (but hygienic, when I get to fixing the current bad hygiene).
 5 | 
 6 | (make-trait map-primitive map
 7 | 
 8 |   (to (~ key)
 9 |     (may (__mapi-get key map)
10 |       (be #no (oops "Missing key" map key))
11 |       (be (~ _ v) v)))
12 | 
13 |   (to (~ .get key @(optional default))
14 |     (may (__mapi-get key map)
15 |       (be #no default)
16 |       (be (~ _ v) v)))
17 | 
18 |   (to (~ .maps? key)
19 |     (not (not (__mapi-get key map))))
20 | 
21 |   (to ~.none?
22 |     (null? (__mapi-items map)))
23 | 
24 |   (to ~.items
25 |     (__mapi-items map))
26 | 
27 |   (to (~ .selfie sink)
28 |     (sink .display "#<map")
29 |     (for each! [(item map.items)]
30 |       (sink .display #\space)
31 |       (sink .write item))
32 |     (sink .display ">"))
33 | 
34 |   (to message
35 |     (map-trait map message)))
36 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/nil.cant:
--------------------------------------------------------------------------------
 1 | (make-trait nil-primitive me
 2 | 
 3 |   (to ~.none?          #yes)
 4 |   (to ~.first          (oops "Empty list" '.first))
 5 |   (to ~.rest           (oops "Empty list" '.rest))
 6 |   (to ~.count          0)
 7 |   (to (~ i)            (oops "Empty list" 'nth i))
 8 |   (to (~ .chain a)     a)
 9 |   (to (~ .selfie sink) (sink .display "()"))
10 | 
11 |   (to message          (list-trait me message))) ;XXX use trait syntax instead
12 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/procedure.cant:
--------------------------------------------------------------------------------
 1 | ;; An ordinary Scheme procedure like __+ and so on.
 2 | 
 3 | ;; There's a magical behavior internal to the player, not expressed in
 4 | ;; this script: if the message is a tuple, then handle it with the
 5 | ;; Scheme code of this procedure-primitive. For all other message
 6 | ;; types, use the script below (which in practice means to use
 7 | ;; miranda-trait).
 8 | 
 9 | (make-trait procedure-primitive me
10 |   )
11 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/script.cant:
--------------------------------------------------------------------------------
 1 | (make-trait script-primitive me
 2 | 
 3 |   (to ~.name    (__script-name me))
 4 |   (to ~.trait   (__script-trait me))
 5 |   (to ~.clauses (__script-clauses me))
 6 | 
 7 |   (to (~ .selfie sink)
 8 |     (sink .display "<script ")
 9 |     (sink .display me.name)
10 |     (sink .display ">"))
11 | 
12 |   )
13 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/setting.cant:
--------------------------------------------------------------------------------
 1 | ;; XXX especially temporary defs
 2 | (make-trait setting-primitive setting
 3 | 
 4 |   (to (~ variable)                      ;TODO different name?
 5 |     (__setting-lookup setting variable))
 6 | 
 7 |   (to (~ .resolve! variable value)
 8 |     (__setting-resolve! setting variable value))
 9 | 
10 |   (to (~ .extend variables values)
11 |     (__setting-extend variables (array<-list values) setting))
12 | 
13 |   (to (~ .extend-promises variables)
14 |     (__setting-extend-promises setting variables))
15 | 
16 |   (to ~.extend-mutable
17 |     (__setting-extend-mutable setting))
18 | 
19 |   (to (~ .binds? variable)
20 |     ;; TODO what's the answer for a not-yet-resolved variable?
21 |     (__setting-binds? setting variable))
22 | 
23 |   (to ~.?parent
24 |     (__setting-parent setting))
25 | 
26 |   (to ~.inner-variables
27 |     (__setting-inner-variables setting))
28 |   
29 |   (to (~ .resolve-each! resolve variables)
30 |     (for each! [(name variables)]
31 |       (setting .resolve! name (resolve name))))
32 | 
33 |   (to (~ .extend-map map) ;TODO just call this one .extend, and drop the other?
34 |     (setting .extend map.keys map.values))
35 | 
36 |   (to (~ .selfie sink)
37 |     (sink .display "#<setting ")
38 |     (sink .write setting.inner-variables)
39 |     (when setting.?parent
40 |       (sink .display " ..."))
41 |     (sink .display ">"))
42 | 
43 |   ;; TODO .map method?
44 |   )
45 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/sink.cant:
--------------------------------------------------------------------------------
 1 | (make-trait sink-primitive me
 2 | 
 3 |   (to (~ .display a)   (unless (__display a me) (me .write a))) ; TODO is this dangerous? longer-term, design the whole display/write thing differently
 4 | 
 5 |   (to (~ .write-u8 u8) (__put-u8 me u8))
 6 | 
 7 |   (to ~.close          (__close-sink me))
 8 | 
 9 |   (to ~.output-text                 ;XXX for text-sink only
10 |     (__get-output-string me))
11 | 
12 |   (to message
13 |     (sink-trait me message)))
14 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/source.cant:
--------------------------------------------------------------------------------
 1 | (make-trait source-primitive me
 2 | 
 3 |   (to ~.read-rune   (__read-char me))
 4 |   (to ~.read-u8     (__get-u8 me))
 5 |   (to ~.read-all    (__read-all me))
 6 |   (to ~.peek-rune   (__peek-char me))
 7 | 
 8 |   (to ~.close       (__close-source me))
 9 | 
10 |   (to ~.ready?      (__char-ready? me))
11 | 
12 |   (to ~.read-line
13 |     (if (zilch? (let rune me.read-rune))
14 |         rune
15 |         (text<-list
16 |          (do reading [rune]
17 |            (if (or (zilch? rune) (= rune #\newline))
18 |                '()
19 |                (link rune (reading me.read-rune)))))))
20 | 
21 |   (to ~.read-lines
22 |     (do reading []
23 |       (if (zilch? (let line me.read-line))
24 |           '()
25 |           (link line (reading)))))
26 | 
27 |   )
28 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/symbol.cant:
--------------------------------------------------------------------------------
 1 | (make-trait symbol-primitive me
 2 | 
 3 |   (to ~.text           (__symbol->string me))
 4 | 
 5 |   (to (~ .compare a)   (and (symbol? a)
 6 |                             (me.text .compare a.text)))
 7 | 
 8 |   (to (~ .selfie sink) (sink .display me.text))
 9 | 
10 |   ;; TODO experiment:
11 |   (to ~.term<-         (on (@arguments) (term<- me arguments)))
12 |   (to ~.term           (term<- me '()))
13 |   (to ~.method         (on (actor @arguments) ;TODO experiment; vs. method<- in stdlib
14 |                          (call actor (term<- me arguments))))
15 | 
16 |   ;; Some silly conveniences for sturm:
17 |   (to ~.lowercase      (symbol<- me.text.lowercase))
18 |   (to ~.uppercase      (symbol<- me.text.uppercase))
19 | 
20 |   )
21 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/term.cant:
--------------------------------------------------------------------------------
 1 | (make-trait term-primitive me
 2 | 
 3 |   (to (~ receiver)     (call receiver me))
 4 | 
 5 |   (to ~.tag            (__term-tag me))
 6 |   (to ~.parts          (__term-parts me))
 7 |   (to (~ .part n)      ((__term-parts me) n))
 8 | 
 9 |   (to (~ .selfie sink)
10 |     (sink .display "{")
11 |     (sink .write me.tag)
12 |     (for each! [(arg me.parts)]
13 |       (sink .display " ")
14 |       (sink .write arg))
15 |     (sink .display "}"))
16 | 
17 |   (to (~ .compare t)
18 |     ((link me.tag me.parts) .compare (link t.tag t.parts)))
19 | 
20 |   )
21 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/void.cant:
--------------------------------------------------------------------------------
1 | (make-trait void-primitive me
2 |   ;; A Scheme type returned by some of the Scheme operations.
3 |   )
4 | 


--------------------------------------------------------------------------------
/abcs/00-primordia/types/zilch.cant:
--------------------------------------------------------------------------------
 1 | (make-trait zilch-primitive me
 2 |   ;; The zilch (end-of-file) object. Just a marker with no interesting
 3 |   ;; behavior.
 4 |   
 5 |   ;; Zilch quacks like a rune wrt to basic rune predicates, but we
 6 |   ;; don't try to pretend further. Maybe this convenience is a bad
 7 |   ;; idea? I've had like one occasion to take advantage of it so far;
 8 |   ;; more commonly we read a line or an s-expression instead.
 9 |   (to ~.letter?       #no)
10 |   (to ~.digit?        #no)
11 |   (to ~.whitespace?   #no)
12 |   (to ~.alphanumeric? #no)
13 |   (to ~.lowercase?    #no)
14 |   (to ~.uppercase?    #no)
15 |   (to ~.lowercase     me)
16 |   (to ~.uppercase     me)
17 |   (to ~.printable?    #no)
18 |   )
19 | 


--------------------------------------------------------------------------------
/abcs/README.md:
--------------------------------------------------------------------------------
1 | The 'primer' for a newborn Cant system. It must learn these ABCs
2 | first to be able to use the `library/`.
3 | 
4 | The source files here get specially loaded in the order they're
5 | numbered. Early in the loading sequence, some basic workings are not
6 | yet in place, putting limits on what kind of code can go there, beyond
7 | just avoiding library functions not yet defined. See the comments.
8 | 


--------------------------------------------------------------------------------
/attic/Makefile:
--------------------------------------------------------------------------------
1 | # A failed attempt to make a faster-starting binary. TODO revisit this
2 | 
3 | cant-binary: cant.scm player/util.scm player/macros.scm player/read.scm player/parse.scm player/env.scm player/elaborate.scm player/primitives.scm player/terp.scm 
4 | 	echo '(compile-program "cant.scm" "cant-binary")' | scheme -q
5 | 


--------------------------------------------------------------------------------
/attic/benchmark:
--------------------------------------------------------------------------------
 1 | #!/bin/bash
 2 | set -euo pipefail; shopt -s failglob  # 'Bash strict mode'
 3 | 
 4 | # Benchmark runner. Yes, it's absurdly crude.
 5 | 
 6 | echo "Reminder:"
 7 | echo "Run on unloaded system -- no web browser."
 8 | echo "Plug in the power."
 9 | echo ""
10 | date
11 | echo ""
12 | echo euler:;   ./t euler
13 | echo ""
14 | echo nqueens:; ./t nqueens
15 | echo ""
16 | echo quick:;   ./t quick
17 | 


--------------------------------------------------------------------------------
/attic/intset.rkt:
--------------------------------------------------------------------------------
 1 | #lang racket
 2 | 
 3 | ;; An example from William Cook's essay on OOP vs. ADTs
 4 | ;; http://www.cs.utexas.edu/~wcook/Drafts/2009/essay.pdf
 5 | 
 6 | (define empty
 7 |   (new (class object%
 8 |          (super-new)
 9 |          (define/public (empty?)   true)
10 |          (define/public (has? k)   false)
11 |          (define/public (adjoin k) (adjoin<- k empty))
12 |          (define/public (merge s)  s))))
13 | 
14 | (define (adjoin<- n s)
15 |   (if (send s has? n)
16 |       s
17 |       (make extension% [n n] [s s])))
18 | 
19 | (define extension%
20 |   (class object%
21 |     (init n s)
22 |     (define my-n n)
23 |     (define my-s s)
24 |     (super-new)
25 |     (define/public (empty?)   false)
26 |     (define/public (has? k)   (or (= my-n k) (send my-s has? k)))
27 |     (define/public (adjoin k) (adjoin<- k this))
28 |     (define/public (merge s)  (new merge% [s1 this] [s2 s]))))
29 | 
30 | (define merge%
31 |   (class object%
32 |     (init s1 s2)
33 |     (define my-s1 s1)
34 |     (define my-s2 s2)
35 |     (super-new)
36 |     (define/public (empty?)   (and (send my-s1 empty?) (send my-s2 empty?)))
37 |     (define/public (has? k)   (or (send my-s1 has? k) (send my-s2 has? k)))
38 |     (define/public (adjoin k) (adjoin<- k this))
39 |     (define/public (merge s)  (new merge% [s1 this] [s2 s]))))
40 | 
41 | ;; Smoke test
42 | 
43 | (let [(eg (send (send empty adjoin 6) adjoin 5))]
44 |   (print (send eg has? 5))
45 |   (print (send eg has? 6))
46 |   (print (send eg has? 7)))
47 | 


--------------------------------------------------------------------------------
/attic/stdlib-attic.scm:
--------------------------------------------------------------------------------
1 | ;; From lib/stdlib.scm but currently unused. To consider some more.
2 | 
3 | (to (remove xs unwanted) ;TODO different arg order? N.B. almost unused
4 |   (for those ((x xs))
5 |     (not= x unwanted)))
6 | 
7 | 


--------------------------------------------------------------------------------
/bless-tests:
--------------------------------------------------------------------------------
1 | ./t omnibus; cp omnibus.out omnibus.expected
2 | ./t quick;   cp quick.out quick.expected
3 | 


--------------------------------------------------------------------------------
/cant.scm:
--------------------------------------------------------------------------------
 1 | #!chezscheme
 2 | (import (chezscheme)
 3 |   (player abcs)
 4 |   (player player))
 5 | 
 6 | ;; The Cant interpreter
 7 | 
 8 | (if (load-abcs)
 9 |     (display "Bailing after oops in start-up.\n")
10 |     (cant-interpret `(start-playing ',(cdr (command-line)))))
11 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/01.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let changes (with-input-file read-all data-file))
 4 | 
 5 | 
 6 | (out .display "Part 1\n")
 7 | 
 8 | (out .print (sum changes))
 9 | 
10 | 
11 | (out .display "\nPart 2\n")
12 | 
13 | (let freqs (amassing$ + 0 changes.cycle))
14 | (out .print (~.first (duplicates<- freqs)))
15 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/02.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input (with-input-file ~.read-lines data-file))
 4 | 
 5 | 
 6 | (out .display "Part 1\n")
 7 | 
 8 | (to (checksum ids)
 9 |   (let bags (each bag<- ids))
10 |   (* (tally-by (~ .find? 2) bags)
11 |      (tally-by (~ .find? 3) bags)))
12 | 
13 | (out .print (checksum input))
14 | 
15 | 
16 | (out .display "Part 2\n")
17 | 
18 | (out .print (chain @(~.first (duplicates<- (gather deletions<- input)))))
19 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/03.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input (with-input-file ~.read-lines data-file))
 4 | 
 5 | (let parse
 6 |   (like "'#' :count ' @ ' :count ',' :count ': ' :count 'x' :count"))
 7 | 
 8 | (let claims (each parse input))
 9 | 
10 | 
11 | (out .display "Part 1\n")
12 | 
13 | (to (area<- `(,_ ,x0 ,y0 ,w ,h))
14 |   (grid* (x0 .span w) (y0 .span h)))
15 | 
16 | (let covered-area (bag<- (gather area<- claims)))
17 | 
18 | (let n-conflicts (for tally-by [(n covered-area.values)]
19 |                    (< 1 n)))
20 | (out .print `(the area is ,n-conflicts))
21 | 
22 | 
23 | (out .display "Part 2\n")
24 | 
25 | (to (undisputed? claim)
26 |   (for every [(point (area<- claim))]
27 |     (= 1 (covered-area point))))
28 | 
29 | (out .print `(the undisputed claims are ,(keep undisputed? claims)))
30 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/05.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input (~.text (with-input-file read data-file)))
 4 | 
 5 | (to (reacts? c d)
 6 |   (and (= c.uppercase d.uppercase)
 7 |        (not= c d)))
 8 | 
 9 | (to (reduce polymer)
10 |   (for fold [(c polymer) (r '())]
11 |     (if (and r.some? (reacts? c r.first))
12 |         r.rest
13 |         (link c r))))
14 | 
15 | (let reduced (reduce input))
16 | (out .say "part 1 ~w\n" reduced.count)
17 | 
18 | (to (scour atom)
19 |   (for skip [(c reduced)]
20 |     (= atom c.uppercase)))
21 | 
22 | (to (try atom)
23 |   (~.count (reduce (scour atom))))
24 | 
25 | (out .say "part 2 ~w\n" (min @(each try (#\A .thru #\Z))))
26 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/08.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | ;; TODO: use parson instead? semantic feedback is awkward
 4 | (to (read-tree source)
 5 |   (do parsing []
 6 |     (let (-- nc (-> zilch? #no)) (read source))
 7 |     (let (-- nm (-> zilch? #no)) (read source))
 8 |     {node (for each/seq [(_ nc.till)]
 9 |             (parsing))
10 |           (for each/seq [(_ nm.till)]
11 |             (read source))}))
12 | 
13 | (to (each/seq f xs) ;force calls in left-to-right order. kinda embarrassing.
14 |   (let results (flexarray<-))
15 |   (for each! [(x xs)] (results .push! (f x)))
16 |   results.values)
17 | 
18 | (let input (with-input-file read-tree data-file))
19 | 
20 | (out .say "Part 1\n")
21 | 
22 | (to (sum-metadata {node children metadata})
23 |   (+ (sum metadata)
24 |      (sum-by sum-metadata children)))
25 | 
26 | (out .say "result 1: ~w\n" (sum-metadata input))
27 | 
28 | 
29 | (out .display "\nPart 2\n")
30 | 
31 | (to (value<- {node children metadata})
32 |   (sum (if children.none?
33 |            metadata
34 |            (for yeahs [(n metadata)]
35 |              (mayhap value<- (children .get n.-1))))))
36 | 
37 | (out .say "result 2: ~w\n" (value<- input))
38 | 
39 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/10.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input (with-input-file ~.read-lines data-file))
 4 | 
 5 | (let parse
 6 |   (like
 7 |    "'position=<'_ :integer ','_ :integer :list ['> velocity=<'_ :integer ','_ :integer '>' :list]"))
 8 | 
 9 | (let states (each parse input))
10 | 
11 | 
12 | (out .display "\nPart 1\n")
13 | 
14 | ;; TODO just skip ahead using x = v*t
15 | 
16 | (to (part1)
17 |   (let `(,ps0 ,vs) (transpose states))
18 |   (show ps0)
19 |   (do stepping [(t 1) (ps ps0)]
20 |     (when (t .even? 100)
21 |       (out .say "time ~w\n" t))
22 |     (let next (each vector+ ps vs))
23 |     (when (< 10500 t)
24 |       (out .say "After ~w seconds:\n" t)
25 |       (if #yes ;(compact? next)
26 |           (show next)
27 |           (out .say "spread\n")))
28 |     (when (< t 11000)
29 |       (stepping t.+1 next))))
30 | 
31 | (to (compact? ps)
32 |   (let `((,xl ,yl) (,xh ,yh)) (bounds<- ps))
33 |   (let dy (- yh yl))
34 |   (< dy 50))
35 | ;;couldn't that use `each` too?
36 | 
37 | (to (show points)
38 |   (let `((,xl ,yl) (,xh ,yh)) (bounds<- points))
39 |   (let dx (- xh xl))
40 |   (let dy (- yh yl))
41 |   (out .say "spread: ~w ~w\n" dx dy)
42 |   (when (< dx 100)
43 |     (let set (set<-list points))
44 |     (for each! [(y (yl .thru yh))]
45 |       (for each! [(x (xl .thru xh))]
46 |         (out .display (if (set .maps? `(,x ,y)) #\# #\.)))
47 |       out.newline)
48 |     out.newline))
49 | 
50 | (out .say "~w\n" (part1))
51 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/12.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input (with-input-file ~.read-lines data-file))
 4 | 
 5 | (let parse (like "{5} ' => ' {1}"))
 6 | 
 7 | (let initial-lineup (input.first .from ("initial state: " .count)))
 8 | (let inputs (each parse input.rest.rest))
 9 | 
10 | 
11 | (out .display "\nPart 1\n")
12 | 
13 | (let rules
14 |   (~.range (where (be? "#") (map<-lists inputs))))
15 | 
16 | (to (state<-lineup lineup)
17 |   (~.range (where (be? #\#) lineup)))
18 | 
19 | (to (part1)
20 |   (let state0 (state<-lineup initial-lineup))
21 |   (let state (after-generations 20 state0))
22 |   (sum state.keys))
23 | 
24 | (to (after-generations n state0)
25 |   (for amass [(state state0) (i n.till)]
26 |     (out .say "~w: sum ~w\n" i (sum state.keys))
27 |     (generate state)))
28 | 
29 | (to (generate state)
30 |   (hm (if state.none? state)
31 |       (else (let `(,lo ,hi) (bounds-1d<- state.keys))
32 |             (~.range (for keep [(pot ((- lo 2) .thru (+ hi 2)))]
33 |                        (generate-1 state pot))))))
34 | 
35 | (to (generate-1 state pot)
36 |   (let key (text<- (at state (- pot 2))
37 |                    (at state (- pot 1))
38 |                    (at state pot)
39 |                    (at state (+ pot 1))
40 |                    (at state (+ pot 2))))
41 |   (rules key))
42 | 
43 | (to (at state pot)
44 |   (if (state pot) #\# #\.))
45 | 
46 | (out .say "~w\n" (part1))
47 | 
48 | ;; part2 done by letting part1 run longer, extrapolating the sums by inspection
49 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/23.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input (with-input-file ~.read-lines data-file))
 4 | 
 5 | (let parse
 6 |   (like
 7 |    "'pos=<' [:integer ',' :integer ',' :integer :list] '>, r=' :integer"))
 8 | 
 9 | (let inputs (each parse input))
10 | 
11 | (let `(,strongest-p ,strongest-r) (max-by (on (`(,p ,r)) r)
12 |                                           inputs))
13 | 
14 | (let n-near-strongest (for tally-by [(`(,p ,_) inputs)]
15 |                         (<= (manhattan-distance<- p strongest-p)
16 |                             strongest-r)))
17 |                         
18 | 
19 | (out .display "\nPart 1\n")
20 | 
21 | (to (part-1)
22 |   n-near-strongest)
23 | 
24 | (out .say "~w\n" (part-1))
25 | 
26 | 
27 | (out .display "\nPart 2\n")
28 | 
29 | (to (part-2)
30 |   'xxx)
31 | 
32 | (out .say "~w\n" (part-2))
33 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/README.md:
--------------------------------------------------------------------------------
 1 | Solutions for https://adventofcode.com/ 2018.
 2 | 
 3 | They're more or less refactored from my contest-time answers (though,
 4 | at this writing, mostly less after the first 10 or so). I'm using this
 5 | as a workout to improve Cant, so I care the most about good
 6 | solutions being writable, not that they be the first I can think of.
 7 | 
 8 | Expect bugs: while I've tried to keep this directory's code up to date
 9 | with changes to the language (because examples help me work out the
10 | language design), it hasn't been practical to test it in more than the
11 | most superficial way, because I didn't unit-test in here, and
12 | rerunning the Advent of Code problem inputs takes too long (thanks to
13 | Cant's amazing slowness). If I do AoC again I should set it up to
14 | easily re-check the sample input/output pairs from the problem
15 | statements.
16 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/06.in:
--------------------------------------------------------------------------------
 1 | 227, 133
 2 | 140, 168
 3 | 99, 112
 4 | 318, 95
 5 | 219, 266
 6 | 134, 144
 7 | 306, 301
 8 | 189, 188
 9 | 58, 334
10 | 337, 117
11 | 255, 73
12 | 245, 144
13 | 102, 257
14 | 255, 353
15 | 303, 216
16 | 141, 167
17 | 40, 321
18 | 201, 50
19 | 60, 188
20 | 132, 74
21 | 125, 199
22 | 176, 307
23 | 204, 218
24 | 338, 323
25 | 276, 278
26 | 292, 229
27 | 109, 228
28 | 85, 305
29 | 86, 343
30 | 97, 254
31 | 182, 151
32 | 110, 292
33 | 285, 124
34 | 43, 223
35 | 153, 188
36 | 285, 136
37 | 334, 203
38 | 84, 243
39 | 92, 185
40 | 330, 223
41 | 259, 275
42 | 106, 199
43 | 183, 205
44 | 188, 212
45 | 231, 150
46 | 158, 95
47 | 174, 212
48 | 279, 97
49 | 172, 131
50 | 247, 320
51 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/06.test:
--------------------------------------------------------------------------------
1 | 1, 1
2 | 1, 6
3 | 8, 3
4 | 3, 4
5 | 5, 5
6 | 8, 9
7 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/07.test:
--------------------------------------------------------------------------------
1 | Step C must be finished before step A can begin.
2 | Step C must be finished before step F can begin.
3 | Step A must be finished before step B can begin.
4 | Step A must be finished before step D can begin.
5 | Step B must be finished before step E can begin.
6 | Step D must be finished before step E can begin.
7 | Step F must be finished before step E can begin.
8 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/08.test:
--------------------------------------------------------------------------------
1 | 2 3 0 3 10 11 12 1 1 0 1 99 2 1 1 2
2 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/09.in:
--------------------------------------------------------------------------------
1 | 465 players; last marble is worth 71940 points
2 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/10.test:
--------------------------------------------------------------------------------
 1 | position=< 9,  1> velocity=< 0,  2>
 2 | position=< 7,  0> velocity=<-1,  0>
 3 | position=< 3, -2> velocity=<-1,  1>
 4 | position=< 6, 10> velocity=<-2, -1>
 5 | position=< 2, -4> velocity=< 2,  2>
 6 | position=<-6, 10> velocity=< 2, -2>
 7 | position=< 1,  8> velocity=< 1, -1>
 8 | position=< 1,  7> velocity=< 1,  0>
 9 | position=<-3, 11> velocity=< 1, -2>
10 | position=< 7,  6> velocity=<-1, -1>
11 | position=<-2,  3> velocity=< 1,  0>
12 | position=<-4,  3> velocity=< 2,  0>
13 | position=<10, -3> velocity=<-1,  1>
14 | position=< 5, 11> velocity=< 1, -2>
15 | position=< 4,  7> velocity=< 0, -1>
16 | position=< 8, -2> velocity=< 0,  1>
17 | position=<15,  0> velocity=<-2,  0>
18 | position=< 1,  6> velocity=< 1,  0>
19 | position=< 8,  9> velocity=< 0, -1>
20 | position=< 3,  3> velocity=<-1,  1>
21 | position=< 0,  5> velocity=< 0, -1>
22 | position=<-2,  2> velocity=< 2,  0>
23 | position=< 5, -2> velocity=< 1,  2>
24 | position=< 1,  4> velocity=< 2,  1>
25 | position=<-2,  7> velocity=< 2, -2>
26 | position=< 3,  6> velocity=<-1, -1>
27 | position=< 5,  0> velocity=< 1,  0>
28 | position=<-6,  0> velocity=< 2,  0>
29 | position=< 5,  9> velocity=< 1, -2>
30 | position=<14,  7> velocity=<-2,  0>
31 | position=<-3,  6> velocity=< 2, -1>
32 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/11.in:
--------------------------------------------------------------------------------
1 | 1718
2 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/12.in:
--------------------------------------------------------------------------------
 1 | initial state: ##.......#.######.##..#...#.#.#..#...#..####..#.##...#....#...##..#..#.##.##.###.##.#.......###....#
 2 | 
 3 | .#### => .
 4 | ....# => .
 5 | ###.. => .
 6 | ..#.# => .
 7 | ##### => #
 8 | ####. => .
 9 | #.##. => #
10 | #.#.# => .
11 | ##.#. => #
12 | .###. => .
13 | #..#. => #
14 | ###.# => .
15 | #.### => .
16 | ##... => #
17 | .#.## => .
18 | ..#.. => .
19 | #...# => #
20 | ..... => .
21 | .##.. => .
22 | ...#. => .
23 | #.#.. => .
24 | .#..# => #
25 | .#.#. => .
26 | .#... => #
27 | ..##. => .
28 | #..## => .
29 | ##.## => #
30 | ...## => #
31 | ..### => #
32 | #.... => .
33 | .##.# => #
34 | ##..# => #
35 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/12.test:
--------------------------------------------------------------------------------
 1 | initial state: #..#.#..##......###...###
 2 | 
 3 | ...## => #
 4 | ..#.. => #
 5 | .#... => #
 6 | .#.#. => #
 7 | .#.## => #
 8 | .##.. => #
 9 | .#### => #
10 | #.#.# => #
11 | #.### => #
12 | ##.#. => #
13 | ##.## => #
14 | ###.. => #
15 | ###.# => #
16 | ####. => #
17 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/13.test:
--------------------------------------------------------------------------------
1 | /->-\        
2 | |   |  /----\
3 | | /-+--+-\  |
4 | | | |  | v  |
5 | \-+-/  \-+--/
6 |   \------/   
7 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/13.test1:
--------------------------------------------------------------------------------
1 | ---><-----
2 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/13.test2:
--------------------------------------------------------------------------------
1 | />-<\  
2 | |   |  
3 | | /<+-\
4 | | | | v
5 | \>+</ |
6 |   |   ^
7 |   \<->/
8 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/14.in:
--------------------------------------------------------------------------------
1 | 157901
2 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/15.combat1:
--------------------------------------------------------------------------------
1 | #######
2 | #G..#E#
3 | #E#E.E#
4 | #G.##.#
5 | #...#E#
6 | #...E.#
7 | #######
8 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/15.combat2:
--------------------------------------------------------------------------------
1 | #######
2 | #E..EG#
3 | #.#G.E#
4 | #E.##E#
5 | #G..#.#
6 | #..E#.#
7 | #######
8 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/15.combat3:
--------------------------------------------------------------------------------
1 | #######
2 | #E.G#.#
3 | #.#G..#
4 | #G.#.G#
5 | #G..#.#
6 | #...E.#
7 | #######
8 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/15.combat4:
--------------------------------------------------------------------------------
1 | #######
2 | #.E...#
3 | #.#..G#
4 | #.###.#
5 | #E#G#G#
6 | #...#G#
7 | #######
8 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/15.combat5:
--------------------------------------------------------------------------------
 1 | #########
 2 | #G......#
 3 | #.E.#...#
 4 | #..##..G#
 5 | #...##..#
 6 | #...#...#
 7 | #.G...G.#
 8 | #.....G.#
 9 | #########
10 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/15.in:
--------------------------------------------------------------------------------
 1 | ################################
 2 | ##########################..####
 3 | #########################...####
 4 | #########################..#####
 5 | ########################G..#####
 6 | #####################.#.....##.#
 7 | #####################..........#
 8 | ##############.#####...........#
 9 | ########G...G#.####............#
10 | #######......G....#.....#......#
11 | #######...G....GG.#............#
12 | #######G.G.............####....#
13 | #######.#.....#####....E.....###
14 | #######......#######.G.......###
15 | #..####..G..#########.###..#####
16 | #........G..#########.##########
17 | #..#..#G....#########.##########
18 | #.###...E...#########.##########
19 | #####...G.G.#########.##########
20 | ########G....#######..##########
21 | ####..........#####...##########
22 | ####......E........G..##########
23 | #.G..................###########
24 | #G...................###########
25 | ###.....##E.......E..###########
26 | ###....#............############
27 | ###.................############
28 | ##G.....#.............##########
29 | ###########...#E..##..##########
30 | ###########.E...###.E.EE.#######
31 | ###########......#.......#######
32 | ################################
33 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/15.movement:
--------------------------------------------------------------------------------
1 | #######
2 | #.E...#
3 | #.....#
4 | #...G.#
5 | #######
6 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/15.movement2:
--------------------------------------------------------------------------------
 1 | #########
 2 | #G..G..G#
 3 | #.......#
 4 | #.......#
 5 | #G..E..G#
 6 | #.......#
 7 | #.......#
 8 | #G..G..G#
 9 | #########
10 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/15.test:
--------------------------------------------------------------------------------
1 | #######
2 | #.G...#
3 | #...EG#
4 | #.#.#G#
5 | #..G#E#
6 | #.....#
7 | #######
8 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/15.test-movement:
--------------------------------------------------------------------------------
 1 | #########
 2 | #G..G..G#
 3 | #.......#
 4 | #.......#
 5 | #G..E..G#
 6 | #.......#
 7 | #.......#
 8 | #G..G..G#
 9 | #########
10 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/16.test:
--------------------------------------------------------------------------------
1 | Before: [3, 2, 1, 1]
2 | 9 2 1 2
3 | After:  [3, 2, 2, 1]
4 | 
5 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/17.test:
--------------------------------------------------------------------------------
1 | x=495, y=2..7
2 | y=7, x=495..501
3 | x=501, y=3..7
4 | x=498, y=2..4
5 | x=506, y=1..2
6 | x=498, y=10..13
7 | x=504, y=10..13
8 | y=13, x=498..504
9 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/18.test:
--------------------------------------------------------------------------------
 1 | .#.#...|#.
 2 | .....#|##|
 3 | .|..|...#.
 4 | ..|#.....#
 5 | #.#|||#|#|
 6 | ...#.||...
 7 | .|....|...
 8 | ||...#|.#|
 9 | |.||||..|.
10 | ...#.|..|.
11 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/19.in:
--------------------------------------------------------------------------------
 1 | #ip 3
 2 | addi 3 16 3
 3 | seti 1 6 1
 4 | seti 1 9 5
 5 | mulr 1 5 2
 6 | eqrr 2 4 2
 7 | addr 2 3 3
 8 | addi 3 1 3
 9 | addr 1 0 0
10 | addi 5 1 5
11 | gtrr 5 4 2
12 | addr 3 2 3
13 | seti 2 4 3
14 | addi 1 1 1
15 | gtrr 1 4 2
16 | addr 2 3 3
17 | seti 1 0 3
18 | mulr 3 3 3
19 | addi 4 2 4
20 | mulr 4 4 4
21 | mulr 3 4 4
22 | muli 4 11 4
23 | addi 2 5 2
24 | mulr 2 3 2
25 | addi 2 1 2
26 | addr 4 2 4
27 | addr 3 0 3
28 | seti 0 3 3
29 | setr 3 6 2
30 | mulr 2 3 2
31 | addr 3 2 2
32 | mulr 3 2 2
33 | muli 2 14 2
34 | mulr 2 3 2
35 | addr 4 2 4
36 | seti 0 8 0
37 | seti 0 8 3
38 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/19.test:
--------------------------------------------------------------------------------
1 | #ip 0
2 | seti 5 0 1
3 | seti 6 0 2
4 | addi 0 1 0
5 | addr 1 2 3
6 | setr 1 0 0
7 | seti 8 0 4
8 | seti 9 0 5
9 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/21.in:
--------------------------------------------------------------------------------
 1 | #ip 5
 2 | seti 123 0 1
 3 | bani 1 456 1
 4 | eqri 1 72 1
 5 | addr 1 5 5
 6 | seti 0 0 5
 7 | seti 0 4 1
 8 | bori 1 65536 4
 9 | seti 12772194 7 1
10 | bani 4 255 3
11 | addr 1 3 1
12 | bani 1 16777215 1
13 | muli 1 65899 1
14 | bani 1 16777215 1
15 | gtir 256 4 3
16 | addr 3 5 5
17 | addi 5 1 5
18 | seti 27 3 5
19 | seti 0 0 3
20 | addi 3 1 2
21 | muli 2 256 2
22 | gtrr 2 4 2
23 | addr 2 5 5
24 | addi 5 1 5
25 | seti 25 5 5
26 | addi 3 1 3
27 | seti 17 4 5
28 | setr 3 4 4
29 | seti 7 1 5
30 | eqrr 1 0 3
31 | addr 3 5 5
32 | seti 5 1 5
33 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/22.in:
--------------------------------------------------------------------------------
1 | depth: 11739
2 | target: 11,718
3 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/22.test:
--------------------------------------------------------------------------------
1 | depth: 510
2 | target: 10,10
3 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/24.test:
--------------------------------------------------------------------------------
1 | Immune System:
2 | 17 units each with 5390 hit points (weak to radiation, bludgeoning) with an attack that does 4507 fire damage at initiative 2
3 | 989 units each with 1274 hit points (immune to fire; weak to bludgeoning, slashing) with an attack that does 25 slashing damage at initiative 3
4 | 
5 | Infection:
6 | 801 units each with 4706 hit points (weak to radiation) with an attack that does 116 bludgeoning damage at initiative 1
7 | 4485 units each with 2961 hit points (immune to radiation; weak to fire, cold) with an attack that does 12 slashing damage at initiative 4
8 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/25.test0:
--------------------------------------------------------------------------------
1 |  0,0,0,0
2 |  3,0,0,0
3 |  0,3,0,0
4 |  0,0,3,0
5 |  0,0,0,3
6 |  0,0,0,6
7 |  9,0,0,0
8 | 12,0,0,0
9 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/25.test1:
--------------------------------------------------------------------------------
 1 | -1,2,2,0
 2 | 0,0,2,-2
 3 | 0,0,0,-2
 4 | -1,2,0,0
 5 | -2,-2,-2,2
 6 | 3,0,2,-1
 7 | -1,3,2,2
 8 | -1,0,-1,0
 9 | 0,2,1,-2
10 | 3,0,0,0
11 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/25.test2:
--------------------------------------------------------------------------------
 1 | 1,-1,0,1
 2 | 2,0,-1,0
 3 | 3,2,-1,0
 4 | 0,0,3,1
 5 | 0,0,-1,-1
 6 | 2,3,-2,0
 7 | -2,2,0,0
 8 | 2,-2,0,-1
 9 | 1,-1,0,-1
10 | 3,2,0,2
11 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/data/25.test3:
--------------------------------------------------------------------------------
 1 | 1,-1,-1,-2
 2 | -2,-2,0,1
 3 | 0,2,1,3
 4 | -2,3,-2,1
 5 | 0,2,3,-2
 6 | -1,-1,1,-2
 7 | 0,-2,-1,0
 8 | -2,2,3,-1
 9 | 1,2,2,0
10 | -1,-2,0,-2
11 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2018/run.cant:
--------------------------------------------------------------------------------
 1 | ;; TODO load into a module instead of main-interactive-setting
 2 | 
 3 | (load "examples/advent-of-code/utils.cant")
 4 | 
 5 | (to (main args)
 6 | 
 7 |   (let stem "examples/advent-of-code/2018")
 8 |   (to (run code-name data-name)
 9 |     (cant .play `(so (let data-name ',data-name)
10 |                      (let data-file ',("~d/data/~d" .format stem data-name)))
11 |                 main-interactive-setting)
12 |     (load ("~d/~d.cant" .format stem code-name)))
13 | 
14 |   (may args
15 |     (be `(,_ ,filename)
16 |       (run filename ("~d.in" .format filename)))
17 |     (be `(,_ ,filename "-data" ,data-name)
18 |       (run filename data-name))
19 |     (be `(,me ,@_)
20 |       (err .say "Usage: cant ~d day [-data data]\n" me)
21 |       (err .say "e.g.:  cant ~d 06 -data 06.test\n" me)
22 |       (os-exit 1))))
23 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2019/01.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input (with-input-file ~.read-lines data-file))
 4 | (let inputs (each ~.number input))
 5 | 
 6 | 
 7 | (out .display "\nPart 1\n")
 8 | 
 9 | (to (fuel<- mass)
10 |   (- (mass .quotient 3) 2))
11 |   
12 | (to (part-1)
13 |   (sum-by fuel<- inputs))
14 | 
15 | (out .say "~w\n" (part-1))
16 | 
17 | 
18 | (out .display "\nPart 2\n")
19 | 
20 | (to (transitive-fuel<- dry-mass)
21 |   (sum (keep-while ~.positive? (~.rest (iterating fuel<- dry-mass)))))
22 | 
23 | (to (part-2)
24 |   (sum-by transitive-fuel<- inputs))
25 | 
26 | (out .say "~w\n" (part-2))
27 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2019/02.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (import (use "intcode") intcode-run)
 4 | 
 5 | (let input (with-input-file ~.read-all data-file))
 6 | (let inputs (each ~.number (input.trim .split ",")))
 7 | 
 8 | 
 9 | (out .display "\nPart 1\n")
10 | 
11 | (to (part-1)
12 |   (let core inputs.array)
13 |   (core .set! 1 12)
14 |   (core .set! 2 2)
15 |   (intcode-run core 0)
16 |   (core 0))
17 | 
18 | (out .say "~w\n" (part-1))
19 | 
20 | 
21 | (out .display "\nPart 2\n")
22 | 
23 | (to (check noun verb)
24 |   (let core inputs.array)
25 |   (core .set! 1 noun)
26 |   (core .set! 2 verb)
27 |   (intcode-run core 0)
28 |   (let result (core 0))
29 |   (and (= result 19690720)
30 |        (+ (* 100 noun) verb)))
31 | 
32 | (to (part-2)
33 |   (~.first (yeahs$ ||(check @it) (grid*$ 100.till 100.till))))
34 | 
35 | (out .say "~w\n" (part-2))
36 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2019/04.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input (with-input-file ~.read-all data-file))
 4 | (let parse (like "(:count | :skip)*"))
 5 | (let inputs (parse input))
 6 | 
 7 | 
 8 | (out .display "\nPart 1\n")
 9 | 
10 | (to (part-1)
11 |   (to (valid? n)
12 |     (let digits n.digits)
13 |     (and (<= @digits) (doubled? digits digits.count)))
14 |   (to (doubled? xs n)
15 |     (and (<= 2 n)
16 |          (or (= (xs 0) (xs 1))
17 |              (doubled? xs.rest n.-1))))
18 |   (tally-by valid? (march<- @inputs)))
19 | 
20 | (out .say "~w\n" (part-1))
21 | 
22 | 
23 | (out .display "\nPart 2\n")
24 | 
25 | (to (part-2)
26 |   (to (valid? n)
27 |     (let digits n.digits)
28 |     (and (<= @digits) (only-doubled? digits digits.count)))
29 |   (to (only-doubled? xs n)
30 |     (and (<= 2 n)
31 |          (if (= (xs 0) (xs 1))
32 |              (or (not= (xs 0) (xs .get 2))
33 |                  (do [(rest (xs.rest .remove xs.first))]
34 |                    (only-doubled? rest rest.count)))
35 |              (only-doubled? xs.rest n.-1))))
36 |   (tally-by valid? (march<- @inputs)))
37 | 
38 | (out .say "~w\n" (part-2))
39 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2019/05.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (import (use "intcode") intcode-run)
 4 | (let input (with-input-file ~.read-all data-file))
 5 | (to (parse line) (each ~.number (line.trim .split ",")))
 6 | (let inputs (parse input))
 7 | 
 8 | ;; TODO virtualize I/O
 9 | 
10 | 
11 | (out .display "\nPart 1\n")
12 | 
13 | (to (part-1)
14 |   (intcode-run inputs.array 0))
15 | 
16 | (out .say "~w\n" (part-1))
17 | 
18 | 
19 | (out .display "\nPart 2\n")
20 | 
21 | (let initial-core inputs.array)
22 | 
23 | (to (part-2)
24 |   'XXX)
25 | 
26 | (out .say "~w\n" (part-2))
27 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2019/06.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input (with-input-file ~.read-lines data-file))
 4 | (let inputs (each (~ .split ")") input))
 5 | 
 6 | (let places (map<-items (collect (each ~.tuple inputs))))
 7 | 
 8 | 
 9 | (out .display "\nPart 1\n")
10 | 
11 | (to (part-1)
12 | ;;  (let roots (places.domain .difference (~.range (each (~ 1) inputs))))
13 | ;;  (out .print roots) ; Turned out to be just "COM".
14 |   (to (count-orbits depth x)
15 |     (+ depth (for sum-by [(y (places .get x '()))]
16 |                (count-orbits depth.+1 y))))
17 |   (count-orbits 0 "COM"))
18 | 
19 | (out .say "~w\n" (part-1))
20 | 
21 | 
22 | (out .display "\nPart 2\n")
23 | 
24 | (to (part-2)
25 |   
26 |   ;; Map from each place to its path to COM (not including the place itself).
27 |   (let paths (!map<-))
28 |   (do walking [(path '()) (here "COM")]
29 |     (paths .set! here path)
30 |     (for each! [(next (places .get here '()))]
31 |       (walking (link here path) next)))
32 |   
33 |   (let santa-set ((paths "SAN") .range))
34 | 
35 |   ;; Walk from YOU towards COM until also on the SAN path.
36 |   ;; Then sum the steps just walked plus the steps from SAN to here.
37 |   (let (~ i here) (for detect [((~ _ here) ((paths "YOU") .items))]
38 |                     (santa-set .maps? here)))
39 |   (+ i ((paths "SAN") .find here)))
40 | 
41 | (out .say "~w\n" (part-2))
42 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2019/data/01.in:
--------------------------------------------------------------------------------
  1 | 121656
  2 | 110933
  3 | 80850
  4 | 137398
  5 | 76307
  6 | 50450
  7 | 124691
  8 | 86449
  9 | 145386
 10 | 148648
 11 | 68909
 12 | 134697
 13 | 109636
 14 | 115718
 15 | 134485
 16 | 89267
 17 | 64829
 18 | 109070
 19 | 84257
 20 | 109010
 21 | 97574
 22 | 98363
 23 | 123029
 24 | 105568
 25 | 114500
 26 | 92041
 27 | 128869
 28 | 148350
 29 | 144605
 30 | 91862
 31 | 134417
 32 | 54710
 33 | 147843
 34 | 121914
 35 | 127855
 36 | 74545
 37 | 89596
 38 | 106562
 39 | 69863
 40 | 147082
 41 | 135724
 42 | 111637
 43 | 68869
 44 | 103685
 45 | 99453
 46 | 80908
 47 | 136020
 48 | 64974
 49 | 125159
 50 | 87504
 51 | 62499
 52 | 73294
 53 | 128811
 54 | 121567
 55 | 54673
 56 | 66647
 57 | 66871
 58 | 71228
 59 | 101622
 60 | 130675
 61 | 69025
 62 | 146118
 63 | 79970
 64 | 118267
 65 | 122279
 66 | 89523
 67 | 62965
 68 | 148036
 69 | 119625
 70 | 127056
 71 | 54980
 72 | 143581
 73 | 103274
 74 | 83064
 75 | 125131
 76 | 54362
 77 | 115851
 78 | 139103
 79 | 140674
 80 | 69616
 81 | 81353
 82 | 116441
 83 | 73898
 84 | 51403
 85 | 137019
 86 | 93146
 87 | 67273
 88 | 138182
 89 | 126680
 90 | 148683
 91 | 127805
 92 | 111741
 93 | 102219
 94 | 99603
 95 | 90453
 96 | 147581
 97 | 102136
 98 | 109913
 99 | 144899
100 | 140572
101 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2019/data/02.in:
--------------------------------------------------------------------------------
1 | 1,0,0,3,1,1,2,3,1,3,4,3,1,5,0,3,2,1,13,19,1,9,19,23,2,13,23,27,2,27,13,31,2,31,10,35,1,6,35,39,1,5,39,43,1,10,43,47,1,5,47,51,1,13,51,55,2,55,9,59,1,6,59,63,1,13,63,67,1,6,67,71,1,71,10,75,2,13,75,79,1,5,79,83,2,83,6,87,1,6,87,91,1,91,13,95,1,95,13,99,2,99,13,103,1,103,5,107,2,107,10,111,1,5,111,115,1,2,115,119,1,119,6,0,99,2,0,14,0
2 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2019/data/04.in:
--------------------------------------------------------------------------------
1 | 171309-643603
2 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2019/run.cant:
--------------------------------------------------------------------------------
 1 | ;; TODO support runs on test data without changing the day's code
 2 | ;; TODO support running only part1 or part2 if desired
 3 | ;; TODO support -i mode
 4 | ;; TODO load into a module instead of main-interactive-setting
 5 | 
 6 | (load "examples/advent-of-code/utils.cant")
 7 | 
 8 | (to (main args)
 9 | 
10 |   (let stem "examples/advent-of-code/2019")
11 |   (to (run code-name data-name)
12 |     (cant .play `(so (let data-name ',data-name)
13 |                      (let data-file ',("~d/data/~d" .format stem data-name)))
14 |                 main-interactive-setting)
15 |     (load ("~d/~d.cant" .format stem code-name)))
16 | 
17 |   (may args
18 |     (be `(,_ ,filename)
19 |       (run filename ("~d.in" .format filename)))
20 |     (be `(,_ ,filename "-data" ,data-name)
21 |       (run filename data-name))
22 |     (be `(,me ,@_)
23 |       (err .say "Usage: cant ~d day [-data data]\n" me)
24 |       (err .say "e.g.:  cant ~d 06 -data 06.test\n" me)
25 |       (os-exit 1))))
26 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/01.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-lines)
 4 | (let inputs (each ~.number input))
 5 | 
 6 | (to (part1)
 7 |   (for some [(`(,a ,b) (inputs .k-sets 2))]
 8 |     (and (= (+ a b) 2020)
 9 |          (* a b))))
10 | 
11 | (to (part2)
12 |   (let s inputs.range)
13 |   ;; originally (for some [(`(,a ,b ,c) (inputs .k-sets 3))]
14 |   ;; but that was almost too slow
15 |   (for some [(`(,a ,b) (inputs .k-sets 2))]
16 |     (let c (- 2020 a b))
17 |     (and (s .maps? c)
18 |          (* a b c))))
19 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/02.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-lines)
 4 | (let parse (like ":count '-' :count _ {:letter} ': ' {:letter*}"))
 5 | (let inputs (each parse input))
 6 | 
 7 | 
 8 | (to (part1)
 9 |   (tally-by valid? inputs))
10 | 
11 | (to (valid? `(,lo ,hi ,policy ,password))
12 |   (let p (policy 0))
13 |   (let n (tally-by ||(= it p) password))
14 |   (<= lo n hi))
15 | 
16 | (to (part2)
17 |   (tally-by valid2? inputs))
18 | 
19 | (to (valid2? `(,lo ,hi ,policy ,password))
20 |   (let p (policy 0))
21 |   (not= (= p (password lo.-1))
22 |         (= p (password hi.-1))))
23 | 
24 | ;;(out .print (valid2? '(1 3 "a" "abcde")))
25 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/03.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-lines.array)
 4 | 
 5 | (to (part1)
 6 |   (slide 3 1))
 7 | 
 8 | (to (slide dx dy)
 9 |   (do sliding [(x 0) (y 0) (ntrees 0)]
10 |     (may (input .get y)
11 |       (be #no ntrees)
12 |       (be row
13 |         (let tree? (= #\# (row (row .ity x))))
14 |         (sliding (+ x dx) (+ y dy) (+ ntrees tree?.count))))))
15 | 
16 | (to (part2)
17 |   (* (slide 1 1)
18 |      (slide 3 1)
19 |      (slide 5 1)
20 |      (slide 7 1)
21 |      (slide 1 2)))
22 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/04.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-all)
 4 | (let inputs (for each [(chunk (input .split "\n\n"))]
 5 |               (each (~ .split ":") chunk.split)))
 6 | 
 7 | (to (part1)
 8 |   (tally-by valid1? inputs))
 9 | 
10 | (to (valid1? passport)
11 |   (let keys ((each (~ 0) passport) .range))
12 |   (required-keys .subset-of? keys))
13 | 
14 | (let required-keys "byr iyr eyr hgt hcl ecl pid".split.range)
15 | 
16 | (to (part2)
17 |   (tally-by valid2? inputs))
18 | 
19 | (to (valid2? passport)
20 |   (and (valid1? passport)
21 |        (for every [(`(,k ,v) passport)]
22 |          (may k
23 |            (be "byr" (<= 1920 v.number 2002))
24 |            (be "iyr" (<= 2010 v.number 2020))
25 |            (be "eyr" (<= 2020 v.number 2030))
26 |            (be "hgt" (may ((hgt-pattern .parse v) .?results)
27 |                        (be `(,n "cm") (<= 150 n 193))
28 |                        (be `(,n "in") (<= 59 n 76))
29 |                        (else #no)))
30 |            (be "hcl" (and (v .prefix? "#")
31 |                           (= v.count 7)
32 |                           (yeah? (number<-text (v .from 1) 16)))) ;; (lenient about uppercase though...)
33 |            (be "ecl" ('("amb" "blu" "brn" "gry" "grn" "hzl" "oth") .find? v))
34 |            (be "pid" (and (= v.count 9)
35 |                           (every ~.digit? v)))
36 |            (be "cid" #yes)
37 |            (else #no)))))
38 | 
39 | (let hgt-pattern (like ":count {'cm'|'in'}"))
40 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/05.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-lines)
 4 | 
 5 | (to (part1)
 6 |   (max @(each convert input)))
 7 | 
 8 | (to (convert line)
 9 |   (number<-text (text-by binarize line) 2))
10 | 
11 | (let binarize (map<-items (zip "FBLR" "0101")))
12 | 
13 | (to (part2)
14 |   (let ids (each convert input))
15 |   (let seats ((min @ids) .thru (max @ids)))
16 |   ((seats.range .difference ids.range) .keys))
17 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/06.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-all)
 4 | (let inputs (each ~.split (input .split "\n\n")))
 5 | 
 6 | (to (part1)
 7 |   (for tally-by [(group inputs)]
 8 |     (~.range (chain @group))))
 9 | 
10 | (to (part2)
11 |   (for tally-by [(group inputs)]
12 |     (intersect @(each ~.range group))))
13 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/07.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-lines)
 4 | 
 5 | (let g (grammar<- "
 6 | rule: bag _ 'contain' _ [bags :list] '.' :end.
 7 | bag: {word _ word} _ ('bags'|'bag').
 8 | bags: 'no' _ 'other' _ 'bags' | [:count _ bag :list] ++ (','_).
 9 | word: :letter+.
10 | _: :whitespace.
11 | "))
12 | (let parser (-> (map<-) g (~ 'rule) ~.parse-it))
13 | (let holdings (map<-lists (each parser input)))
14 | 
15 | ;; dim chartreuse bags contain 1 faded indigo bag.
16 | ;; --> ("dim chartreuse" ((1 "faded indigo")))
17 | 
18 | (to (part1)
19 |   (let deep-gold?
20 |     (memoize (on (bag)
21 |                (for some [(`(,_ ,sub-bag) (holdings bag))]
22 |                  (or (= sub-bag "shiny gold")
23 |                      (deep-gold? sub-bag))))))
24 |   (tally-by deep-gold? holdings.keys))
25 | 
26 | (to (part2)
27 |   (do deep-counting [(bag "shiny gold")]
28 |     (for sum-by [(`(,n ,sub-bag) (holdings bag))]
29 |       (* n (+ 1 (deep-counting sub-bag))))))
30 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/08.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-lines)
 4 | (let parse (like "{:letter+} _ :integer"))
 5 | (let inputs (~.array (each parse input)))
 6 | 
 7 | (to (part1)
 8 |   (run inputs))
 9 | 
10 | (to (part2)
11 |   (some flip inputs.keys))
12 | 
13 | (to (flip pc)
14 |   (let code inputs.copy)
15 |   (may (code pc)
16 |     (be `("acc" ,n)
17 |       #no)
18 |     (else
19 |       (may (code pc)
20 |         (be `("nop" ,n) (code .set! pc `("jmp" ,n)))
21 |         (be `("jmp" ,n) (code .set! pc `("nop" ,n))))
22 |       (may (run code)
23 |         (be {finished acc}
24 |           acc)
25 |         (else #no)))))
26 | 
27 | (to (run code)
28 |   (let seen (set<-))
29 |   (let end code.count)
30 |   (do running [(pc 0) (acc 0)]
31 |     (hm (if (= pc end)       {finished acc})
32 |         (if (seen .maps? pc) {looped acc})
33 |         (so (seen .add! pc))
34 |         (may (code pc)
35 |           (be `("acc" ,n) (running pc.+1 (+ acc n)))
36 |           (be `("nop" ,n) (running pc.+1 acc))
37 |           (be `("jmp" ,n) (running (+ pc n) acc))))))
38 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/10.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-lines)
 4 | (let adapters (each ~.number input))
 5 | 
 6 | (let goal (+ 3 (max @adapters)))
 7 | 
 8 | (to (part1)
 9 |   (let joltages (sort adapters))
10 |   (let diffs (bag<- (each - `(,@joltages ,goal) `(0 ,@joltages))))
11 |   (* (diffs 1) (diffs 3)))
12 | 
13 | (to (part2)
14 |   (let count-ways
15 |     (memoize (on (joltage)
16 |                (for sum-by [(decr '(1 2 3))]
17 |                  (let j (- joltage decr))
18 |                  (hm (if (= j 0) 1)
19 |                      (if (< j 0) 0)
20 |                      (if (adapters .find? j) (count-ways j))
21 |                      (else 0))))))
22 |   (count-ways goal))
23 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/14.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-lines)
 4 | (let parse (like "'mask = ' {1*} | 'mem[' :count '] = ' :count"))
 5 | (let program (each parse input))
 6 | 
 7 | (to (part1)
 8 |   (sum-run part1-do-mem))
 9 | 
10 | (to (part2)
11 |   (sum-run part2-do-mem))
12 | 
13 | (to (sum-run do-mem)
14 |   (let memory (!map<-))
15 |   (run memory do-mem)
16 |   (sum memory.values))
17 | 
18 | (to (run memory do-mem)
19 |   (for amass [(mask void) (insn program)]
20 |     (may insn
21 |       (be `(,new-mask) new-mask)
22 |       (be `(,addr ,value)
23 |         (each! (~ memory) (do-mem mask addr value))
24 |         mask))))
25 | 
26 | (to (part1-do-mem mask addr value)
27 |   (list<- (~ .set! addr (enmask1 mask value))))
28 | 
29 | (to (enmask1 mask value)
30 |   (let masked (for each [(m mask) (b ("~036b" .format value))]
31 |                 (may m
32 |                   (be #\X b)
33 |                   (else   m))))
34 |   (number<-text masked.text 2))
35 | 
36 | (to (part2-do-mem mask addr value)
37 |   (for each [(a (enmask2 mask addr))]
38 |     (~ .set! a value)))
39 | 
40 | (to (enmask2 mask addr)
41 |   (let bit-values (for each [(m mask) (rune ("~036b" .format addr))]
42 |                     (may m
43 |                       (be #\0 `(,rune))
44 |                       (be #\1 '(#\1))
45 |                       (be #\X '(#\0 #\1)))))
46 |   (for each [(bits (grid* @bit-values))]
47 |     (number<-text bits.text 2)))
48 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/15.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-line)
 4 | 
 5 | (to (part1)
 6 |   (play input 2020))
 7 | 
 8 | (to (play line nsteps)
 9 |   (let numbers (each ~.number (line .split ",")))
10 |   (let sightings numbers.but-last.inverse.copy)
11 |   (for amass [(n numbers.last)
12 |               (i (numbers.count.-1 .till nsteps.-1))]
13 |     (hey (- i (sightings .get n i))
14 |          ||(sightings .set! n i))))
15 | 
16 | (to (part2)
17 |   (play input 30000000))
18 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/18.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-lines)
 4 | 
 5 | (let g1 (grammar<- "
 6 | line: expr :end.
 7 | expr: factor (_ '*' _ factor :mul | _ '+' _ factor :add)*.
 8 | factor: :integer | '(' expr ')'.
 9 | _: :whitespace.
10 | "))
11 | (let g2 (grammar<- "
12 | line: expr :end.
13 | expr: e1 (_ '*' _ e1 :mul)*.
14 | e1: factor (_ '+' _ factor :add)*.
15 | factor: :integer | '(' expr ')'.
16 | _: :whitespace.
17 | "))
18 | (let semantics (map<- (~ 'add (feed +)) (~ 'mul (feed *))))
19 | (to (parser<- grammar)
20 |   (-> semantics grammar (~ 'line) ~.parse-it))
21 | 
22 | (to (part1)
23 |   (sum (gather (parser<- g1) input)))
24 | 
25 | (to (part2)
26 |   (sum (gather (parser<- g2) input)))
27 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/19.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-all)
 4 | (let `(,rule-text ,data) (input .split "\n\n"))
 5 | 
 6 | (let g1 (grammar<- "
 7 | start: main :end.
 8 | main: :count ': ' rhs.
 9 | rhs: '\"' {1} '\"' :Lit | alt.
10 | alt: seq ('|'_ alt :Alt)?.
11 | seq: :count :Ref _ (seq :Seq)?.
12 | _: :whitespace*.
13 | "))
14 | 
15 | (to ((Ref n) rules text i)
16 |   ((rules n) rules text i))
17 | 
18 | (to ((Lit t) rules text i)
19 |   (if (= t (text .from i i.+1))
20 |       `(,i.+1)
21 |       '()))
22 | 
23 | (to ((Alt p q) rules text i)
24 |   (chain (p rules text i) (q rules text i)))
25 | 
26 | (to ((Seq p q) rules text i)
27 |   (for gather [(j (p rules text i))]
28 |     (q rules text j)))
29 | 
30 | (to (End rules text i)
31 |   (if (= text.count i) `(,i) '()))
32 | 
33 | (let semantics (each-value feed (export Lit Alt Seq Ref)))
34 | (let parse (-> semantics g1 (~ 'start) ~.parse-it))
35 | 
36 | (to (part1)
37 |   (let rules (map<-lists (each parse rule-text.split-lines)))
38 |   (let rule0 (Seq (rules 0) End))
39 |   (tally-by ||(~.some? (rule0 rules it 0))
40 |             data.split-lines))
41 | 
42 | (to (part2)
43 |   (let rules1 (map<-lists (each parse rule-text.split-lines)))
44 |   (let new-rule-text "\
45 | 8: 42 | 42 8
46 | 11: 42 31 | 42 11 31")
47 |   (let new-rules (map<-lists (each parse new-rule-text.split-lines)))
48 |   (let rules2 (new-rules .override rules1))
49 |   (let rule0 (Seq (rules2 0) End))
50 |   (tally-by ||(~.some? (rule0 rules2 it 0))
51 |             data.split-lines))
52 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/data/10.in:
--------------------------------------------------------------------------------
 1 | 54
 2 | 91
 3 | 137
 4 | 156
 5 | 31
 6 | 70
 7 | 143
 8 | 51
 9 | 50
10 | 18
11 | 1
12 | 149
13 | 129
14 | 151
15 | 95
16 | 148
17 | 41
18 | 144
19 | 7
20 | 125
21 | 155
22 | 14
23 | 114
24 | 108
25 | 57
26 | 118
27 | 147
28 | 24
29 | 25
30 | 73
31 | 26
32 | 8
33 | 115
34 | 44
35 | 12
36 | 47
37 | 106
38 | 120
39 | 132
40 | 121
41 | 35
42 | 105
43 | 60
44 | 9
45 | 6
46 | 65
47 | 111
48 | 133
49 | 38
50 | 138
51 | 101
52 | 126
53 | 39
54 | 78
55 | 92
56 | 53
57 | 119
58 | 136
59 | 154
60 | 140
61 | 52
62 | 15
63 | 90
64 | 30
65 | 40
66 | 64
67 | 67
68 | 139
69 | 76
70 | 32
71 | 98
72 | 113
73 | 80
74 | 13
75 | 104
76 | 86
77 | 27
78 | 61
79 | 157
80 | 79
81 | 122
82 | 59
83 | 150
84 | 89
85 | 158
86 | 107
87 | 77
88 | 112
89 | 5
90 | 83
91 | 58
92 | 21
93 | 2
94 | 66
95 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/data/13.in:
--------------------------------------------------------------------------------
1 | 1007125
2 | 13,x,x,41,x,x,x,x,x,x,x,x,x,569,x,29,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,19,x,x,x,23,x,x,x,x,x,x,x,937,x,x,x,x,x,37,x,x,x,x,x,x,x,x,x,x,17
3 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/data/15.in:
--------------------------------------------------------------------------------
1 | 0,5,4,1,10,14,7
2 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2020/data/17.in:
--------------------------------------------------------------------------------
1 | ..##.#.#
2 | .#####..
3 | #.....##
4 | ##.##.#.
5 | ..#...#.
6 | .#..##..
7 | .#...#.#
8 | #..##.##
9 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2021/01.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input (each ~.number data-file.read-lines))
 4 | 
 5 | (to (count-increases nums)
 6 |   (tally-by ||(< @it) (nums .k-slices 2)))
 7 | 
 8 | (to (part1)
 9 |   (count-increases input))
10 | 
11 | (to (part2)
12 |   (count-increases (each sum (input .k-slices 3))))
13 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2021/02.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let input data-file.read-lines)
 4 | (let commands (for each [(line input)]
 5 |                 (read (text-source<- (chain "{" line "}")))))
 6 | 
 7 | (to (update-1 (~ pos depth) command)
 8 |   (may command
 9 |     (be {forward n} (~ (+ pos n) depth))
10 |     (be {up n}      (~ pos (- depth n)))
11 |     (be {down n}    (~ pos (+ depth n)))))
12 | 
13 | (to (part1)
14 |   (let (~ pos depth) (amass update-1 (~ 0 0) commands))
15 |   (* pos depth))
16 | 
17 | (to (update-2 (~ pos depth aim) command)
18 |   (may command
19 |     (be {forward n} (~ (+ pos n)
20 |                        (+ depth (* aim n))
21 |                        aim))
22 |     (be {up n}      (~ pos depth (- aim n)))
23 |     (be {down n}    (~ pos depth (+ aim n)))))
24 | 
25 | (to (part2)
26 |   (let (~ pos depth aim) (amass update-2 (~ 0 0 0) commands))
27 |   (* pos depth))
28 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2021/05.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let parse (like "(:count | :skip)*"))
 4 | 
 5 | (let sample-lines ("\
 6 | 0,9 -> 5,9
 7 | 8,0 -> 0,8
 8 | 9,4 -> 3,4
 9 | 2,2 -> 2,1
10 | 7,0 -> 7,4
11 | 6,4 -> 2,0
12 | 0,9 -> 2,9
13 | 3,4 -> 1,4
14 | 0,0 -> 8,8
15 | 5,5 -> 8,2" .split-lines))
16 | 
17 | (let lines data-file.read-lines)
18 | (let entries (each parse lines))
19 | ;;(let entries (each parse sample-lines))
20 | 
21 | (to (part1)
22 |   (let bag (bag<- (gather draw-1 entries)))
23 |   (tally-by ||(< 1 it) bag.values))
24 | 
25 | (to (draw-1 `(,x1 ,y1 ,x2 ,y2))
26 |   (hm (if (= x1 x2) (each ||(~ x1 it) ((min y1 y2) .thru (max y1 y2))))
27 |       (if (= y1 y2) (each ||(~ it y1) ((min x1 x2) .thru (max x1 x2))))
28 |       (else         '())))
29 | 
30 | (to (part2)
31 |   (let bag (bag<- (gather draw-2 entries)))
32 |   (tally-by ||(< 1 it) bag.values))
33 | 
34 | (to (draw-2 `(,x1 ,y1 ,x2 ,y2))
35 |   (hm (if (= x1 x2) (each ||(~ x1 it) ((min y1 y2) .thru (max y1 y2))))
36 |       (if (= y1 y2) (each ||(~ it y1) ((min x1 x2) .thru (max x1 x2))))
37 |       (else         (zip (thru x1 x2) (thru y1 y2)))))
38 | 
39 | (to (thru i j)
40 |   (hm (if (<= i j) (i .thru j))
41 |       (else (reverse (j .thru i)))))
42 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2021/06.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let parse (like "(:count | :skip)*"))
 4 | 
 5 | (let example "3,4,3,1,2")
 6 | (let input data-file.read-all)
 7 | 
 8 | ;;(let data (parse example))
 9 | (let data (parse input))
10 | 
11 | (to (part1) ((simulating data) 80))
12 | (to (part2) ((simulating data) 256))
13 | 
14 | (to (simulating list-of-timers)
15 |   (each$ ~.total (iterating update (bag<- list-of-timers))))
16 | 
17 | (to (update state)
18 |   (let next (bag<-))
19 |   (for each! [((~ t n) state.items)]
20 |     (may t
21 |       (be 0
22 |         (next .add! 8 n)
23 |         (next .add! 6 n))
24 |       (else
25 |         (next .add! t.-1 n))))
26 |   next)
27 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2021/07.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let parse (like "(:count | :skip)*"))
 4 | 
 5 | (let input data-file.read-all)
 6 | (let sample "16,1,2,0,4,2,7,1,2,14")
 7 | 
 8 | (let inputs (parse input))
 9 | ;;(let inputs (parse sample))
10 | 
11 | (to (part1)
12 |   (let targets ((min @inputs) .thru (max @inputs)))
13 |   (min @(each cost-1<- targets)))
14 | 
15 | (to (cost-1<- target)
16 |   (sum-by ||(distance<- it target) inputs))
17 | 
18 | (to (distance<- i j)
19 |   ((- j i) .magnitude))
20 | 
21 | (to (part2)
22 |   (let targets ((min @inputs) .thru (max @inputs)))
23 |   (min @(each cost-2<- targets)))
24 | 
25 | (to (cost-2<- target)
26 |   (sum-by ||(sum-thru (distance<- it target))
27 |           inputs))
28 | 
29 | (to (sum-thru d)
30 |   (/ (* d d.+1) 2))
31 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2021/data/06.in:
--------------------------------------------------------------------------------
1 | 1,4,1,1,1,1,5,1,1,5,1,4,2,5,1,2,3,1,1,1,1,5,4,2,1,1,3,1,1,1,1,1,1,1,2,1,1,1,1,1,5,1,1,1,1,1,1,1,1,1,4,1,1,1,1,5,1,4,1,1,4,1,1,1,1,4,1,1,5,5,1,1,1,4,1,1,1,1,1,3,2,1,1,1,1,1,2,3,1,1,2,1,1,1,3,1,1,1,2,1,2,1,1,2,1,1,3,1,1,1,3,3,5,1,4,1,1,5,1,1,4,1,5,3,3,5,1,1,1,4,1,1,1,1,1,1,5,5,1,1,4,1,2,1,1,1,1,2,2,2,1,1,2,2,4,1,1,1,1,3,1,2,3,4,1,1,1,4,4,1,1,1,1,1,1,1,4,2,5,2,1,1,4,1,1,5,1,1,5,1,5,5,1,3,5,1,1,5,1,1,2,2,1,1,1,1,1,1,1,4,3,1,1,4,1,4,1,1,1,1,4,1,4,4,4,3,1,1,3,2,1,1,1,1,1,1,1,4,1,3,1,1,1,1,1,1,1,5,2,4,2,1,4,4,1,5,1,1,3,1,3,1,1,1,1,1,4,2,3,2,1,1,2,1,5,2,1,1,4,1,4,1,1,1,4,4,1,1,1,1,1,1,4,1,1,1,2,1,1,2
2 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2021/template.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | ;(let input data-file.read-lines)
 4 | ;(let input data-file.read-all)
 5 | 
 6 | ;(let parse (like "(:count | :skip)*"))
 7 | ;(let parse (like "[{:letter} :count :tuple] ** ','"))
 8 | ;(let parse ~.number)
 9 | 
10 | ;(let inputs (each parse input))
11 | 
12 | (to (part1)
13 |   1)
14 | 
15 | ;;(to (part2)
16 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2023/01.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let eg1 "1abc2
 4 | pqr3stu8vwx
 5 | a1b2c3d4e5f
 6 | treb7uchet".split-lines)
 7 | 
 8 | (let eg2 "two1nine
 9 | eightwothree
10 | abcone2threexyz
11 | xtwone3four
12 | 4nineeightseven2
13 | zoneight234
14 | 7pqrstsixteen".split-lines)
15 | 
16 | (let data
17 |   data-file.read-lines)
18 |   ;;eg2)
19 | 
20 | (to (part1)
21 |   (for sum-by [(line data)]
22 |     (let digits (keep ~.digit? line))
23 |     (~.number (text<- digits.first digits.last))))
24 | 
25 | (import (use 'english-numbers) numeralize)
26 | 
27 | (let numeral-patterns (map<-values numeralize (1 .thru 9)))
28 | (let digit-patterns   (map<-values ~.text (1 .thru 9)))
29 | (let patterns (digit-patterns .override numeral-patterns))
30 | 
31 | (to (part2)
32 |   (for sum-by [(line data)]
33 |     (let digits (for yeahs [(suffix line.suffixes)]
34 |                   (for some [((~ key val) patterns.items)]
35 |                     (and (suffix .prefix? key) val))))
36 |     (count<-digits (list<- digits.first digits.last))))
37 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2023/02.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let eg1 "Game 1: 3 blue, 4 red; 1 red, 2 green, 6 blue; 2 green
 4 | Game 2: 1 blue, 2 green; 3 green, 4 blue, 1 red; 1 green, 1 blue
 5 | Game 3: 8 green, 6 blue, 20 red; 5 blue, 4 red, 13 green; 5 green, 1 red
 6 | Game 4: 1 green, 3 red, 6 blue; 3 green, 6 red; 3 green, 15 blue, 14 red
 7 | Game 5: 6 red, 1 blue, 3 green; 2 blue, 1 red, 2 green")
 8 | 
 9 | (let input
10 |   data-file.read-all)
11 | ;;  eg1)
12 | 
13 | (let parse
14 |   (like "'Game'_ :count ':'_ [[:count _ {:letter+} :reverse :tuple]**', ' :bag]**'; '"
15 |         (~ 'bag (feed-list bag<-items))))
16 | (let games (each parse input.split-lines))
17 | 
18 | (to (part1)
19 |   (let limit (bag<-items (list<- (~ "red" 12) (~ "green" 13) (~ "blue" 14))))
20 |   (sum (for yeahs [((link game bags) games)]
21 |          (and (every (~ .subset-of? limit) bags)
22 |               game))))
23 | 
24 | (to (part2)
25 |   (for sum-by [((link game bags) games)]
26 |     (let rgb-values (each (~ .part 1) (collect (gather ~.items bags))))
27 |     (* @(each ||(max @it) rgb-values))))
28 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2023/03.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let eg1 "\
 4 | 467..114..
 5 | ...*......
 6 | ..35..633.
 7 | ......#...
 8 | 617*......
 9 | .....+.58.
10 | ..592.....
11 | ......755.
12 | ...$.*....
13 | .664.598..")
14 | 
15 | (let input
16 |   data-file.read-all)
17 | ;;  eg1)
18 | 
19 | (let number-values ;; map from each number's position to its numeric value
20 |   (-> input (like "([:position :count :tuple] | :skip)*") map<-items))
21 | (let number-starts ;; map from each position of a digit to the position of its number
22 |   (map<-items (for gather [((~ pos n) number-values.items)]
23 |                 (each ||(~ it pos) (pos .span n.text.count)))))
24 | 
25 | (to (symbol-rune? rune)
26 |   (not (".\n0123456789" .find? rune)))
27 | 
28 | (let symbols-at (where symbol-rune? input)) ;; list of symbol positions
29 | 
30 | (let neighborhood ;; list of offsets from a position to its neighbors
31 |   (do [(w ((input .find #\newline) .+1))] ;; width
32 |     (list<- (- w.+1) (- w) (- w.-1) -1 1 w.-1 w w.+1)))
33 | 
34 | (to (neighbors<- pos)
35 |   (~.nub (for yeahs [(offset neighborhood)]
36 |            (number-starts .get (+ pos offset)))))
37 | 
38 | (to (part1)
39 |   (sum-by number-values
40 |           ((gather neighbors<- symbols-at) .nub)))
41 | 
42 | (to (part2)
43 |   (let gears (for yeahs [(pos symbols-at)]
44 |                (let neighbors (neighbors<- pos))
45 |                (and (= 2 neighbors.count) neighbors)))
46 |   (sum-by ||(* @(each number-values it))
47 |           gears))
48 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2023/04.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let eg1 "\
 4 | Card 1: 41 48 83 86 17 | 83 86  6 31 17  9 48 53
 5 | Card 2: 13 32 20 16 61 | 61 30 68 82 17 32 24 19
 6 | Card 3:  1 21 53 59 44 | 69 82 63 72 16 21 14  1
 7 | Card 4: 41 92 73 84 69 | 59 84 76 51 58  5 54 83
 8 | Card 5: 87 83 26 28 32 | 88 30 70 12 93 22 82 36
 9 | Card 6: 31 18 13 56 72 | 74 77 10 23 35 67 36 11")
10 | 
11 | (let input
12 |   data-file.read-all)
13 | ;;  eg1)
14 | 
15 | (let parse (like "'Card'_ :count ':'_ [:count**_ :list]_ '|'_ [:count**_ :list]"))
16 | (let inputs (each parse input.split-lines))
17 | 
18 | (let scores (for each [((list<- card-id winning-ns my-ns) inputs)]
19 |               (~.count (winning-ns.range .intersect my-ns.range))))
20 | 
21 | (to (part1)
22 |   (sum-by ||(2 .** it.-1) (scores .remove 0)))
23 |       
24 | (to (part2)
25 |   (do [(scores scores.array)]
26 |     (let fecundity
27 |       (memoize (on (i)
28 |                  (+ 1 (sum-by fecundity (i.+1 .thru (min scores.count.-1
29 |                                                          (+ i (scores i)))))))))
30 |     (sum-by fecundity scores.keys)))
31 | 
32 | ;; This approach seemed easier to work out in the moment:
33 | (when #no
34 |   (to (part2-first-approach)
35 |     (let n-copies ((each ||1 inputs) .array))
36 |     (for each! [((~ i score) scores.items)]
37 |       (for each! [(j (i.+1 .thru (min inputs.count.-1 (+ i score))))]
38 |         (n-copies .update j (~ .+ (n-copies i)))))
39 |     (sum n-copies.values))
40 |   (out .print (part2-first-approach)))
41 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2023/06.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let eg1 "\
 4 | Time:      7  15   30
 5 | Distance:  9  40  200")
 6 | 
 7 | (let input
 8 | ;;  eg1)
 9 |   data-file.read-all)
10 | 
11 | (to (part1)
12 |   (let races (transpose (for each [(line input.split-lines)]
13 |                           (each ~.number line.split.rest))))
14 |   (let n-ways-to-beat
15 |     (for each [(race races)]
16 |       (count-ways-to-beat/brute @race)))
17 |   (* @n-ways-to-beat))
18 | 
19 | ;; Your move: choose v, 0 <= v <= t.
20 | ;; Your distance v(t - v) must exceed d.
21 | (to (count-ways-to-beat/brute t d)
22 |   (for tally-by [(v (1 .till t))]
23 |     (< d (* v (- t v)))))
24 | 
25 | (to (part2)
26 |   (let numbers (for each [(line input.split-lines)]
27 |                  (-> (keep ~.digit? line) ~.text ~.number)))
28 |   (count-ways-to-beat/faster @numbers))
29 | 
30 | (import (use 'polynomials) poly<-s-expr find-root)
31 | 
32 | ;; Solve the equation v(t-v)-d = 0 for v, and return the width between the roots.
33 | (to (count-ways-to-beat/faster t d)
34 |   (let excess (poly<-s-expr `(- (* v (- ,t v))
35 |                                 ,d)))
36 |   (let `(,lo ,hi) (each ||(find-root excess it)
37 |                         (list<- 0 t))) ;; starting guesses on either side of the peak
38 |   ((lo.ceiling.exact .thru hi.floor.exact) .count))
39 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2023/08.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let eg1 "\
 4 | RL
 5 | 
 6 | AAA = (BBB, CCC)
 7 | BBB = (DDD, EEE)
 8 | CCC = (ZZZ, GGG)
 9 | DDD = (DDD, DDD)
10 | EEE = (EEE, EEE)
11 | GGG = (GGG, GGG)
12 | ZZZ = (ZZZ, ZZZ)")
13 | 
14 | (let eg2 "\
15 | LLR
16 | 
17 | AAA = (BBB, BBB)
18 | BBB = (AAA, ZZZ)
19 | ZZZ = (ZZZ, ZZZ)")
20 | 
21 | (let eg3 "\
22 | LR
23 | 
24 | 11A = (11B, XXX)
25 | 11B = (XXX, 11Z)
26 | 11Z = (11B, XXX)
27 | 22A = (22B, XXX)
28 | 22B = (22C, 22C)
29 | 22C = (22Z, 22Z)
30 | 22Z = (22B, 22B)
31 | XXX = (XXX, XXX)")
32 | 
33 | (let input
34 | ;;  eg1)
35 | ;;  eg2)
36 | ;;  eg3)
37 |   data-file.read-all)
38 | 
39 | (let parse (like "{3} ' = (' [{3} ', ' {3} :list] ')'"))
40 | 
41 | (let {inputs turns nodes} (do [(lines input.split-lines)]
42 |                             {inputs lines.first (map<-lists (each parse lines.rest.rest))}))
43 | 
44 | (to (step pos dir)
45 |   ((nodes pos) ("LR" .find dir)))
46 | 
47 | (to (part1)
48 |   (let steps (amassing$ step "AAA" turns.cycle))
49 |   ((keep-until (be? "ZZZ") steps) .count))
50 | 
51 | (to (part2)
52 |   (to (period<- start)
53 |     (let steps (amassing$ step start turns.cycle))
54 |     ((keep-until (~ .suffix? "Z") steps) .count))
55 | 
56 |   (lcm @(each period<- (keep (~ .suffix? "A") nodes.keys))))
57 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2023/09.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | (let eg1 "\
 4 | 0 3 6 9 12 15
 5 | 1 3 6 10 15 21
 6 | 10 13 16 21 30 45")
 7 | 
 8 | (let input
 9 | ;;  eg1)
10 |   data-file.read-all)
11 | 
12 | (let inputs (each ||(each ~.number it.split) input.split-lines))
13 | 
14 | (to (part1)
15 |   (sum-by extrapolate inputs))
16 | 
17 | (to (extrapolate ns)
18 |   (sum-by ~.last (history ns)))
19 | 
20 | (to (delta ns)
21 |   (each - ns.rest ns.but-last))
22 | 
23 | (to (history ns)
24 |   (keep-until$ ||(every (be? 0) it) (iterating delta ns)))
25 | 
26 | (to (part2)
27 |   (sum-by extrapolate-2 inputs))
28 | 
29 | (to (extrapolate-2 ns)
30 |   (for fold [(rows (history ns)) (z 0)]
31 |     (- rows.first z)))
32 | 
33 | ;;  x y
34 | ;;   z
35 | 
36 | ;; z = -x+y; x = y-z
37 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2023/data/06.in:
--------------------------------------------------------------------------------
1 | Time:        56     97     77     93
2 | Distance:   499   2210   1097   1440
3 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/2023/template.cant:
--------------------------------------------------------------------------------
 1 | ;; (Use run.cant to run this.)
 2 | 
 3 | ;;(import (use 'x) y)
 4 | 
 5 | (let eg1 "\
 6 | ")
 7 | 
 8 | (let input
 9 |   eg1)
10 | ;;  data-file.read-all)
11 | 
12 | ;(let parse (like "(:count | :skip)*"))
13 | 
14 | ;(let inputs (each parse input.split-lines))
15 | 
16 | (to (part1)
17 |   1)
18 | 


--------------------------------------------------------------------------------
/examples/advent-of-code/adventget.py:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env python
 2 | """
 3 | Adapted from https://github.com/ambertests/advent_of_code_2018/blob/master/aoc_day01.py
 4 | For other ways see also https://old.reddit.com/r/adventofcode/comments/a2lesz/2018_day_3_solutions/eb1hd1z/
 5 | To be run from ../.. (the main Cant dir).
 6 | """
 7 | 
 8 | import os, requests
 9 | 
10 | # Grab the session cookie from the https://adventofcode.com/ site:
11 | # right-click, Inspect, Application tab, Cookies, session.
12 | session = os.environ['ADVENT_SESSION']
13 | 
14 | def download(day, year):
15 |     text = fetch(day, year)
16 |     with open('examples/advent-of-code/%d/data/%02d.in' % (year, day), 'w') as f:
17 |          f.write(text)
18 | 
19 | def fetch(day, year):
20 |     url = 'https://adventofcode.com/%d/day/%d/input' % (year, day)
21 |     headers = {
22 | 	'cookie': "session=" + session
23 |     }
24 |     input = requests.request('GET', url, headers=headers)
25 |     return input.text
26 | 
27 | if __name__ == '__main__':
28 |     import sys
29 |     year = 2023                 # default
30 |     if sys.argv[1:2] == ['-y'] and 3 <= len(sys.argv):
31 |         year = int(sys.argv[2])
32 |         del sys.argv[1:3]
33 |     if len(sys.argv) != 2:
34 |         raise Exception("usage: %s [-y year] day" % sys.argv[0])
35 |     day = int(sys.argv[1])
36 |     download(day, year)
37 | 


--------------------------------------------------------------------------------
/examples/automata/elementary-ca.cant:
--------------------------------------------------------------------------------
 1 | ;; 1-d cellular automata, 'elementary' in Wolfram's sense.
 2 | ;; (That is, with 1-bit states and a neighborhood of three cells
 3 | ;; including the middle one.)
 4 | 
 5 | (to (run rule start-bits n-steps)
 6 |   (to (step bits)
 7 |     (each rule
 8 |           `(0 0 ,@bits)
 9 |           `(0 ,@bits 0)
10 |           `(,@bits 0 0)))
11 |   (-> n-steps
12 |       (for iterating [(state start-bits)]
13 |         (show state)
14 |         (step state))
15 |       show))
16 | 
17 | (to (show bits)
18 |   (out .displayln ((text-by "-*" bits) .center 79)))
19 | 
20 | ;; There are 2**8 possible elementary CA's. Return the update rule
21 | ;; for the given-numbered one.
22 | (to (rule<-index n)
23 |   (on (left center right)
24 |     (n .bit (+ (* left 4) (* center 2) right))))
25 | 
26 | (run (rule<-index 110) '(1) 30)
27 | 


--------------------------------------------------------------------------------
/examples/automata/fractran.cant:
--------------------------------------------------------------------------------
 1 | ;; https://en.wikipedia.org/wiki/FRACTRAN
 2 | ;; A Turing-complete esoteric language based on factoring of natural numbers.
 3 | 
 4 | (import (use 'ratio)
 5 |   ratio? ratio<- r-integer? integer<-ratio ratio-parse r* ratio-compare)
 6 | 
 7 | ;; Run a FRACTRAN program.
 8 | (to (fractran fractions input)
 9 |   ;; The program is a list of positive fractions.
10 |   (surely (every ratio? fractions))
11 |   (surely (every r-positive? fractions))
12 |   ;; The input is a positive integer.
13 |   (surely (and (integer? input) (< 0 input)))
14 | 
15 |   (do loop [(subject (ratio<- input))]
16 |     ;; Look for a whole-number product, from left to right:
17 |     (may (keep$ r-integer? (each$ ||(r* subject it) fractions))
18 |       (be (? ~.none?) (integer<-ratio subject))  ; None, so we're done.
19 |       (be products    (loop products.first)))))  ; Repeat with the first one found.
20 | 
21 | (to (r-positive? r)
22 |   (= '> (ratio-compare r (ratio<- 0))))
23 | 
24 | (to (fractran-parse text)
25 |   (each ratio-parse text.split))
26 | 
27 | 
28 | ;; Smoke test
29 | 
30 | (import (use 'factoring) factor)
31 | 
32 | ;; Program from https://scienceblogs.com/goodmath/2006/10/27/prime-number-pathology-fractra
33 | (let eg-program "385/13 13/21 1/7 3/11 7/2 1/3")
34 | 
35 | (let (~ a b) (~ 4 6))
36 | (let eg-input (* (2 .** a) (3 .** b)))
37 | 
38 | (let eg-result (fractran (fractran-parse eg-program) eg-input))
39 | 
40 | (out .say "Program: ~d\n" eg-program)
41 | (out .say "~w * ~w -> ~w\n" a b (~.count (factor eg-result)))
42 | 


--------------------------------------------------------------------------------
/examples/beer.cant:
--------------------------------------------------------------------------------
 1 | ;; Since everyone loves the beer song
 2 | 
 3 | (let bottles (chain (each ||("~w bottles" .format it) (99 .down-thru 2))
 4 |                     '("1 bottle" "No more bottles" "99 bottles")))
 5 | (let actions (chain ('("Take one down and pass it around") .repeat 99)
 6 |                     '("Go to the store and buy some more")))
 7 | 
 8 | (for each! [(`(,n ,n-1) (bottles .k-slices 2))
 9 |             (action actions)]
10 |   (out .say "~d of beer on the wall,\n~d of beer.\n" n n)
11 |   (out .say "~d,\n~d of beer on the wall.\n\n" action n-1))
12 | 


--------------------------------------------------------------------------------
/examples/benchmarks/dumb-prime-benchmark.cant:
--------------------------------------------------------------------------------
 1 | ;; http://www.retroprogramming.com/2010/01/8-bit-home-computer-benchmarks.html
 2 | ;; user	0m0.560s
 3 | ;; vs. Apple IIe, 1.0 MHz 6502, Applesoft BASIC: 211s
 4 | ;; TI 99/4A, 3.0 MHz: 226s
 5 | ;; So no, we're no longer quite *that* slow, if we ever were.
 6 | 
 7 | (let w 500)
 8 | (let f (array<-count w.+1 0))
 9 | 
10 | (to (square n)
11 |   (* n n))
12 | 
13 | (do L20 [(a 3) (p 1)]
14 |   (f .set! p a)
15 |   (when (< p w)
16 |     (do L30 [(a0 a)]
17 |       (let a (+ a0 2))
18 |       (do L40 [(x 1)]
19 |         (if (a .even? (f x))
20 |             (L30 a)
21 |             (do [(x x.+1)]
22 |               (if (and (<= x p)
23 |                        (<= (square (f x)) a))
24 |                   (L40 x)
25 |                   (L20 a p.+1))))))))
26 | 
27 | (when #no
28 |   (for each! [((~ i fi) f.items.rest)]
29 |     (out .say "~3w ~w\n" i fi)))
30 | 


--------------------------------------------------------------------------------
/examples/benchmarks/sieve.cant:
--------------------------------------------------------------------------------
 1 | ;; Sieve of Eratosthenes benchmark.
 2 | 
 3 | (let SIZE 8191)  ; (original defined SIZE as inclusive upper bound)
 4 | 
 5 | (let flags (array<-count SIZE #no))      
 6 | 
 7 | (to (main _)
 8 |   (out .say "10 iterations\n")
 9 |   (let count (box<- 0))
10 |   (for each! [(_ 10.till)]
11 |     (count .^= 0)
12 |     (for each! [(i SIZE.till)]     ;TODO .fill! method
13 |       (flags .set! i #yes))
14 |     (for each! [(i SIZE.till)]
15 |       (when (flags i)
16 |         (let prime (+ i i 3))
17 |         (for each! [(k ((+ i prime) .till SIZE prime))]
18 |           (flags .set! k #no))
19 |         count.+1!)))
20 |   (out .say "~w primes\n" count.^))
21 | 


--------------------------------------------------------------------------------
/examples/capability-patterns/revoke.cant:
--------------------------------------------------------------------------------
 1 | ;; A small example of a capability pattern.
 2 | 
 3 | ;; For the sake of the example, imagine Alice is some entity you
 4 | ;; wouldn't trust all your powers to, but you can give Alice a
 5 | ;; particular power `x` by calling `(send-alice x)`.
 6 | 
 7 | (to (send-alice x)                      ; A stand-in for the example
 8 |   (out .say "Hey Alice, here's your ~w\n" x))
 9 | 
10 | ;; You want to give a power to Alice, but only until you change your mind:
11 | 
12 | (to (revocable<- power)
13 |   (let box (box<- power))
14 |   (to (revoke!) (box .^= void))
15 |   (make forwarder
16 |     (to message (call box.^ message)))
17 |   (~ revoke! forwarder))
18 | 
19 | ;; Let's say this power is just the stdout capability:
20 | (let (~ revoke-alices-out! alices-out) (revocable<- out))
21 | ;; You give it to Alice:
22 | (send-alice alices-out)
23 | ;; Notice you did not send revoke-alices-out! to Alice or anyone else.
24 | ;; Only you get to revoke it.
25 | 
26 | ;; ... Ok, let's wait while Alice is doing stuff like:
27 | (alices-out .say "Yo\n")
28 | 
29 | ;; ... until you get fed up with her yo-dude shenanigans:
30 | (revoke-alices-out!)
31 | ;; Of course your own `out` still works:
32 | (out .say "My own `out` is still here.\n")
33 | ;; but this will fail because void has no .say method:
34 | (alices-out .say "duuude\n")
35 | 


--------------------------------------------------------------------------------
/examples/code-golf/README.md:
--------------------------------------------------------------------------------
1 | Technically these aren't golfed, but the problems come from code-golf
2 | sites.
3 | 


--------------------------------------------------------------------------------
/examples/code-golf/christmas-trees.cant:
--------------------------------------------------------------------------------
 1 | ;; https://code.golf/christmas-trees
 2 | ;; Print a size-ascending range of Christmas trees using asterisks,
 3 | ;; ranging from size 3 to size 9, each tree separated by a blank line.
 4 | 
 5 | (to (xmas-tree n)
 6 |   (let center (~ .center (+ n.-1 1 n.-1)))
 7 |   ("\n" .join (for each [(w (chain n.till '(0)))]
 8 |                 (center ("*" .repeat (+ w 1 w))))))
 9 | 
10 | (out .displayln ("\n\n" .join (each xmas-tree (3 .thru 9))))
11 | 


--------------------------------------------------------------------------------
/examples/code-golf/squiggly-sequence.cant:
--------------------------------------------------------------------------------
1 | ;; https://codegolf.stackexchange.com/questions/91725/the-squiggly-sequence
2 | ;; Given positive integer n, if n is odd, repeat / that many times; if
3 | ;; n is even, repeat \ that many times.
4 | 
5 | (to (squiggly n)
6 |   (-> (n .and 1) ["\\" "/"] (~ .repeat n)))
7 | 
8 | (out .display-lines (each squiggly (1 .thru 6)))
9 | 


--------------------------------------------------------------------------------
/examples/csv.cant:
--------------------------------------------------------------------------------
 1 | ;; Just imitating a Ruby example from (iirc) _Seven languages in seven weeks_.
 2 | ;; Represent a CSV file as an object which responds to the column names as getters.
 3 | 
 4 | (to (csv<-file filename)
 5 |   (csv<-lines (with-input-file ~.read-lines filename)))
 6 | 
 7 | (to (csv<-lines lines)
 8 |   (table<- (parse-csv-line lines.first)
 9 |            (each parse-csv-line lines.rest)))
10 | 
11 | (to (parse-csv-line line)
12 |   (line .split ","))                    ;TODO quoting
13 | 
14 | (to (table<- header rows)
15 |   (let columns (~.inverse (for each [(column header)]
16 |                             (~.symbol (chain "." column)))))
17 |   (to (column? x) (columns .maps? x))
18 |   (to (row<- entries)
19 |     (make row
20 |       (to `{,(? column? tag)}
21 |         (entries (columns tag))) ;; A bit clumsy, looking the tag up twice...
22 |       (to message
23 |         (call entries message))))
24 |   (make table
25 |     (to ~.rows
26 |       (each row<- rows))))
27 | 
28 | 
29 | ;; Example
30 | 
31 | (let csv (csv<-lines '("one,two"
32 |                        "lion,tiger")))
33 | 
34 | (out .print csv)
35 | (out .print csv.rows)
36 | (out .print csv.rows.first.two)
37 | (out .print csv.rows.first.one)
38 | 


--------------------------------------------------------------------------------
/examples/dole-editor/README.md:
--------------------------------------------------------------------------------
1 | Text editor. Starting as a port of github.com/darius/dole.
2 | 


--------------------------------------------------------------------------------
/examples/dole-editor/console.cant:
--------------------------------------------------------------------------------
 1 | ;; A debugging console
 2 | 
 3 | (let logs (box<- '()))
 4 | 
 5 | (to (log format-text @arguments)
 6 |   (let m (format-text .format @arguments))
 7 |   (logs .^= (link m logs.^)))
 8 | 
 9 | (export log logs)
10 | 


--------------------------------------------------------------------------------
/examples/dole-editor/dole.cant:
--------------------------------------------------------------------------------
1 | ;; Main program
2 | 
3 | (import (use "editor") dole)
4 | 
5 | (to (main args)
6 |   (dole args.rest.maybe)) ;TODO this is a cheap hack since you don't
7 |                           ;get an informative oops on wrong # of args
8 | 


--------------------------------------------------------------------------------
/examples/dole-editor/editor.cant:
--------------------------------------------------------------------------------
 1 | ;; The top-level text editor
 2 | 
 3 | (import ((use 'sturm) (export console))
 4 |   raw-mode)
 5 | (import (use "keyboard")         read-key)
 6 | (import (use "fundamental-mode") fundamental-mode<-)
 7 | 
 8 | (to (dole ?filename)
 9 |    (let buffer (fundamental-mode<-))
10 |    (when ?filename
11 |      (buffer .visit ?filename))
12 |    (for raw-mode []
13 |      (edit buffer))
14 |    out.newline)
15 | 
16 | (to (edit buffer)
17 |   (do editing []
18 |     buffer.redisplay
19 |     (let key (read-key))
20 |     (may (buffer.key-map key)
21 |       (be 'exit)
22 |       (be (? term? message)
23 |         ;; As a convenience, a command may be a message like
24 |         ;; ~.next-line in place of a function.
25 |         (message buffer)
26 |         (editing))
27 |       (be action
28 |         (action key)
29 |         (editing)))))
30 |    
31 | (export dole edit)
32 | 


--------------------------------------------------------------------------------
/examples/dole-editor/fundamental-mode.cant:
--------------------------------------------------------------------------------
 1 | ;; Hi, I'd like a buffer with all the usuals, please.
 2 | 
 3 | (import (use "buffer")  buffer<-)
 4 | (import (use "key-map") ctrl)
 5 | 
 6 | (let C ctrl)
 7 | 
 8 | (to (fundamental-mode<-)
 9 |   (hey (buffer<-)
10 |        (~ .add-bindings!
11 |           `((,(C #\B)  {.move-rune -1})
12 |             (left      {.move-rune -1})
13 |             (,(C #\F)  {.move-rune  1})
14 |             (right     {.move-rune  1})
15 |             (,(C #\N)  {.next-line})
16 |             (down      {.next-line})
17 |             (,(C #\P)  {.previous-line})
18 |             (up        {.previous-line})
19 |             (,(C #\Q)  exit)
20 |             (,(C #\M)  {.insert "\n"})
21 |             (backspace {.backward-delete-rune})
22 |             (del       {.forward-delete-rune})
23 |             (end       {.end-of-line})
24 |             (home      {.beginning-of-line})
25 |             (pg-up     {.previous-page})
26 |             (pg-dn     {.next-page})))))
27 | 
28 | (export fundamental-mode<-)
29 | 


--------------------------------------------------------------------------------
/examples/dole-editor/key-map.cant:
--------------------------------------------------------------------------------
 1 | ;; Binding keys to commands
 2 | 
 3 | (to (ctrl rune)                           ;XXX duplicate code
 4 |   (- rune.uppercase 64))
 5 | 
 6 | (to (meta rune)
 7 |   (text<- esc rune))
 8 | 
 9 | (let esc (rune<- 27))
10 | 
11 | (to (key-map<- default-command)
12 |   (let bindings (!map<-))
13 |   (make key-map
14 |     (to (~ .set! key command)
15 |       (bindings .set! key command))
16 |     (to (~ key)
17 |       (if (zilch? key)
18 |           'exit
19 |           (bindings .get key default-command)))
20 |     ))
21 | 
22 | (export
23 |   ctrl meta
24 |   key-map<-)
25 | 


--------------------------------------------------------------------------------
/examples/dole-editor/keyboard.cant:
--------------------------------------------------------------------------------
1 | ;; Read the keyboard
2 | 
3 | (import ((use 'sturm) (export console))
4 |   get-key)
5 | 
6 | (let read-key get-key)
7 | 
8 | (export read-key)
9 | 


--------------------------------------------------------------------------------
/examples/dole-editor/rune-set.cant:
--------------------------------------------------------------------------------
 1 | ;; Sets of runes
 2 | 
 3 | (to (rune-set<- @runes)
 4 |   (let set runes.range)
 5 |   (make rune-set
 6 |     (to (~ .maps? rune) (set .maps? rune))
 7 |     ))
 8 |     
 9 | (export
10 |   rune-set<-)
11 | 


--------------------------------------------------------------------------------
/examples/exercises-and-puzzles/cryptarithmetic-brute.cant:
--------------------------------------------------------------------------------
 1 | ;; Sort-of-generic cryptarithmetic solver.
 2 | 
 3 | ;; Assign distinct digits to letters to make "word1+word2=word3" a
 4 | ;; correct decimal sum. (Leading zeros not allowed.)
 5 | 
 6 | ;; Example: "send+more=money"
 7 | 
 8 | (import (use 'parson) like)
 9 | (import (use 'format-tables) format-table)
10 | 
11 | (let parse-puzzle (like "{:letter+} '+' {:letter+} '=' {:letter+}"))
12 | 
13 | ;; Brute-force method: just try every assignment of distinct digits.
14 | 
15 | (to (main `(,me ,puzzle-text))
16 |   (let (-- words `(,word1 ,word2 ,total))
17 |     (parse-puzzle puzzle-text))
18 |   (let variables ((chain @words) .nub))
19 |   (let indices variables.inverse)
20 |   (let nonzeros ((each ~.first words) .nub))
21 |   (to (realize word values)
22 |     (count<-digits (each (compose values indices) word)))
23 |   (for each! [(values ((0 .thru 9) .k-permutations variables.count))]
24 |     (when (for every [(v nonzeros)]
25 |             (not= 0 (values (indices v))))
26 |       (when (= (+ (realize word1 values) (realize word2 values))
27 |                (realize total values))
28 |         (let line (text-by ||"-" total))
29 |         (let table [[(realize word1 values) word1]
30 |                     [(realize word2 values) word2]
31 |                     [line                   line]
32 |                     [(realize total values) total]])
33 |         (out .display-lines (format-table table "  " ('.pad-left .method)))
34 |         out.newline))))
35 | 


--------------------------------------------------------------------------------
/examples/exercises-and-puzzles/ghost.cant:
--------------------------------------------------------------------------------
 1 | ;; Problem from Miller & Wu, Daily Coding Problem, p. 238
 2 | 
 3 | ;; In the game of Ghost, players alternate appending a letter to a
 4 | ;; word-prefix. A move loses if it creates either a dictionary word
 5 | ;; or a non-prefix of any dictionary word.
 6 | 
 7 | (let lexicon "cat coat dog bear".split.range)
 8 | (let alphabet ((chain @lexicon.keys) .nub))
 9 | (let prefixes ((gather ~.prefixes lexicon.keys) .range))
10 | 
11 | ;; List all winning moves from this prefix
12 | (to (win prefix)
13 |   (for yeahs [(letter alphabet)]
14 |     (let next (chain prefix letter.text))
15 |     (and (not (lexicon .maps? next))
16 |          (prefixes .maps? next)
17 |          ((win next) .none?)
18 |          letter)))
19 | 
20 | (out .print (win ""))
21 | 


--------------------------------------------------------------------------------
/examples/exercises-and-puzzles/max-path-sum.cant:
--------------------------------------------------------------------------------
 1 | ;; Find the maximum sum of values along any path in a binary tree.
 2 | ;; tree ::= {leaf} | {branch value tree tree}
 3 | 
 4 | (to (max-path-sum tree)
 5 |   (let (~ best _) (solve tree))
 6 |   best)
 7 | 
 8 | ;; Return (~ max-sum-of-any-path
 9 | ;;           max-sum-of-any-path-ending-at-root).
10 | (to (solve tree)
11 |   (may tree
12 |     (be {leaf}
13 |       (~ 0 0))
14 |     (be {branch value L R}
15 |       (let (~ L-sum L-top) (solve L))
16 |       (let (~ R-sum R-top) (solve R))
17 |       (let my-sum (+ value L-top R-top))       ; max sum that goes through me
18 |       (let my-top (+ value (max L-top R-top))) ; max nonempty sum that ends at me
19 |       (~ (max L-sum R-sum my-sum)
20 |          (max 0 my-top)))))
21 | 
22 | (out .print
23 |      (max-path-sum
24 |       {branch -10
25 |               {branch 2 {branch 3 {leaf} {leaf}} {branch -1 {leaf} {leaf}}}
26 |               {branch 3 {leaf} {leaf}}}))
27 | 


--------------------------------------------------------------------------------
/examples/exercises-and-puzzles/max-subsegment-sum.cant:
--------------------------------------------------------------------------------
 1 | ;; "Maximum subsegment sum" problem:
 2 | ;; Given a list of numbers, find the greatest sum of any slice of it.
 3 | ;; (Since an empty slice has sum 0, the max can't be any less.)
 4 | 
 5 | ;; Brute force method:
 6 | (to (mss-naive ns)
 7 |   (max @(each sum ns.slices)))
 8 | 
 9 | ;; Kadane's O(n) algorithm:
10 | (to (mss ns)
11 |   (max @(for amassing [(ssum 0) (n ns)]
12 |           (max 0 (+ ssum n)))))
13 | 
14 | ;; Test case from Rosetta code
15 | (for each! [(example '((-1 -2 3 5 6 -2 -1 4 -4 2 -1)))]
16 |   (yo (mss-naive example))
17 |   (yo (mss example)))
18 | 


--------------------------------------------------------------------------------
/examples/exercises-and-puzzles/send-more-money.cant:
--------------------------------------------------------------------------------
 1 | ;; A cryptarithmetic puzzle:
 2 | ;; Find distinct digits that make "SEND+MORE=MONEY" a correct decimal sum.
 3 | ;; (A leading 0 is not allowed.)
 4 | 
 5 | ;; Brute-force, but quick-to-code: just try every assignment of
 6 | ;; distinct digits. One improvement: notice the leading digit must be
 7 | ;; 1.
 8 | 
 9 | (let m 1)
10 | (let digits ((0 .thru 9) .remove 1))
11 | (for each! [((list<- d e n o r s y) (digits .k-permutations 7))]
12 |   (let send (count<-digits (list<- s e n d)))
13 |   (let more (count<-digits (list<- m o r e)))
14 |   (let money (count<-digits (list<- m o n e y)))
15 |   (when (= (+ send more) money)
16 |     (out .say " ~w   SEND\n" send)
17 |     (out .say "+~w  +MORE\n" more)
18 |     (out .say "-----  -----\n")
19 |     (out .say "~w  MONEY\n" money)
20 |     out.newline))
21 | 


--------------------------------------------------------------------------------
/examples/exercises-and-puzzles/sicp1.cant:
--------------------------------------------------------------------------------
 1 | ;; SICP exercise 2.29
 2 | ;; (I renamed 'total-weight' to just 'weight'.)
 3 | 
 4 | ;; Algebraic-data version
 5 | ;; tree ::= number | {mobile branch branch}
 6 | ;; branch ::= {branch length tree}
 7 | ;; length ::= number
 8 | 
 9 | (to (balanced? tree)
10 |   (may tree
11 |     (be (? number?)
12 |       #yes)
13 |     (be {mobile left right}
14 |       (and (branch-balanced? left)
15 |            (branch-balanced? right)
16 |            (= (torque left) (torque right))))))
17 | 
18 | (to (branch-balanced? {branch _ tree})
19 |   (balanced? tree))
20 | 
21 | (to (torque {branch length tree})
22 |   (* length (weight tree)))
23 | 
24 | (to (weight tree)
25 |   (may tree
26 |     (be (? number?)
27 |       tree)
28 |     (be {mobile left right}
29 |       (+ (branch-weight left) (branch-weight right)))))
30 | 
31 | (to (branch-weight {branch _ thing})
32 |   (weight thing))
33 | 
34 | (let test-mobile
35 |   {mobile {branch 1 10}
36 |           {branch 2 {mobile {branch 3 20}
37 |                             {branch 4 30}}}})
38 | 
39 | (let test-balanced-mobile
40 |   {mobile {branch 7 10}
41 |           {branch 1 {mobile {branch 3 40}
42 |                             {branch 4 30}}}})
43 | 
44 | (out .print (balanced? test-mobile))
45 | (out .print (balanced? test-balanced-mobile))
46 | 


--------------------------------------------------------------------------------
/examples/exercises-and-puzzles/sicp2.cant:
--------------------------------------------------------------------------------
 1 | ;; SICP exercise 2.29
 2 | ;; (I renamed 'total-weight' to just 'weight'.)
 3 | 
 4 | ;; OO version
 5 | 
 6 | (to (mobile<- left right)
 7 |   (make _
 8 |     (to ~.weight    (+ left.weight right.weight))
 9 |     (to ~.balanced? (and left.balanced?
10 |                          right.balanced?
11 |                          (= left.torque right.torque)))))
12 | 
13 | (to (branch<- length submobile)
14 |   (let structure (if (number? submobile) (weight<- submobile) submobile))
15 |   (make _
16 |     (to ~.torque    (* length structure.weight))
17 |     (to message     (call structure message))))  ;XXX keep miranda methods
18 | 
19 | (to (weight<- value)
20 |   (make _
21 |     (to ~.weight    value)
22 |     (to ~.balanced? #yes)))
23 | 
24 | (let test-mobile
25 |   (mobile<- (branch<- 1 10)
26 |             (branch<- 2 (mobile<- (branch<- 3 20)
27 |                                   (branch<- 4 30)))))
28 | 
29 | (let test-balanced-mobile
30 |   (mobile<- (branch<- 7 10)
31 |             (branch<- 1 (mobile<- (branch<- 3 40)
32 |                                   (branch<- 4 30)))))
33 | 
34 | (out .print test-mobile.balanced?)
35 | (out .print test-balanced-mobile.balanced?)
36 | 


--------------------------------------------------------------------------------
/examples/failing.cant:
--------------------------------------------------------------------------------
 1 | ;; An example failing computation, to exercise debugging introspection.
 2 | ;; This turned into essentially a repeat of test-continuations.scm.
 3 | 
 4 | (import ((use 'traceback) (export out))
 5 |   on-oops-traceback)
 6 | 
 7 | (to (factorial n)
 8 |   (if (= 0 n)
 9 |       (oops "I don't know 0!")
10 |       (* n (factorial (- n 1)))))
11 | 
12 | (to (complain-and-resume sequel evil)
13 |   (on-oops-traceback sequel evil)
14 |   (out .say "About to resume, pretending 0! = 10\n")
15 |   (sequel .answer 10))
16 | 
17 | (with-signal-handler complain-and-resume
18 |                      ($ (out .print (factorial 5))))
19 | 


--------------------------------------------------------------------------------
/examples/fizzbuzz.cant:
--------------------------------------------------------------------------------
1 | ;; The classic interview problem.
2 | 
3 | (for each! [(n (1 .thru 30))]
4 |   (out .displayln (may [(3 .ity n) (5 .ity n)]
5 |                     (be [0 0] "FizzBuzz")
6 |                     (be [0 _] "Fizz")
7 |                     (be [_ 0] "Buzz")
8 |                     (else     n))))
9 | 


--------------------------------------------------------------------------------
/examples/games/animals.data:
--------------------------------------------------------------------------------
1 | {choose "Does it live in the sea?" "a dolphin" "a horse"}
2 | 


--------------------------------------------------------------------------------
/examples/games/chess-play.cant:
--------------------------------------------------------------------------------
1 | (import (use "chess") chess-main)
2 | (import (use 'chaos) chaos)         ;for now
3 | 
4 | (to (main args)
5 |   (chess-main (export console chaos) args))
6 | 


--------------------------------------------------------------------------------
/examples/games/glutton/glutton.maze:
--------------------------------------------------------------------------------
 1 | Derived from MyMan's pac.asc: "Inspired by Toru Iwatani/Namco's Pac-Man/Puckman"
 2 | +------------++------------+
 3 | |............||............|
 4 | |.+--+.+---+.||.+---+.+--+.|
 5 | |o|--|.|---|.||.|---|.|--|o|
 6 | |.+--+.+---+.++.+---+.+--+.|
 7 | |..........................|
 8 | |.+--+.++.+------+.++.+--+.|
 9 | |.+--+.||.+--++--+.||.+--+.|
10 | |......||....||....||......|
11 | +----+.|+--+ || +--+|.+----+
12 | -----|.|+--+ ++ +--+|.|-----
13 | -----|.||          ||.|-----
14 | -----|.|| +--==--+ ||.|-----
15 | -----+.++ |-    -| ++.+-----
16 |       .   |-    -|   .      
17 | -----+.++ |-    -| ++.+-----
18 | -----|.|| +------+ ||.|-----
19 | -----|.||          ||.|-----
20 | -----|.|| +------+ ||.|-----
21 | +----+.++ +--++--+ ++.+----+
22 | |............||............|
23 | |.+--+.+---+.||.+---+.+--+.|
24 | |.+-+|.+---+.++.+---+.|+-+.|
25 | |o..||.......  .......||..o|
26 | +-+.||.++.+------+.++.||.+-+
27 | +-+.++.||.+--++--+.||.++.+-+
28 | |..P...||....||....||......|
29 | |.+----++--+.||.+--++----+.|
30 | |.+--------+.++.+--------+.|
31 | |..........................|
32 | +--------------------------+
33 | 


--------------------------------------------------------------------------------
/examples/games/microban:
--------------------------------------------------------------------------------
 1 | Microban, by David Skinner (truncated)
 2 | ####  
 3 | # .#  
 4 | #  ###
 5 | #@i  #
 6 | #  o #
 7 | #  ###
 8 | ####  
 9 | 
10 | ######
11 | #    #
12 | # #i #
13 | # o@ #
14 | # .@ #
15 | #    #
16 | ######
17 | 
18 |   ####   
19 | ###  ####
20 | #     o #
21 | # #  #o #
22 | # . .#i #
23 | #########
24 | 
25 | ########
26 | #      #
27 | # .@@oi#
28 | #      #
29 | #####  #
30 |     ####
31 | 
32 |  #######
33 |  #     #
34 |  # .o. #
35 | ## oio #
36 | #  .o. #
37 | #      #
38 | ########
39 | 
40 | ###### #####
41 | #    ###   #
42 | # oo     #i#
43 | # o #...   #
44 | #   ########
45 | #####       
46 | 
47 | #######
48 | #     #
49 | # .o. #
50 | # o.o #
51 | # .o. #
52 | # o.o #
53 | #  i  #
54 | #######
55 | 
56 |   ######
57 |   # ..i#
58 |   # oo #
59 |   ## ###
60 |    # #  
61 |    # #  
62 | #### #  
63 | #    ## 
64 | # #   # 
65 | #   # # 
66 | ###   # 
67 |   ##### 
68 | 


--------------------------------------------------------------------------------
/examples/games/sat-puzzle/README.md:
--------------------------------------------------------------------------------
1 | A crude human interface for SAT solving -- I want to see if it can
2 | make a fun puzzle game.
3 | 
4 | Adapted from https://github.com/darius/sturm/blob/master/satgame.py
5 | 
6 | There are pathnames hardwired in the code -- it assumes we run from
7 | the main Cant directory.
8 | 


--------------------------------------------------------------------------------
/examples/games/sat-puzzle/factoring6.dimacs:
--------------------------------------------------------------------------------
 1 | p cnf 14 38
 2 | c Factors encoded in variables 1-2 and 3-4
 3 | 2 0
 4 | 4 0
 5 | -5 0
 6 | 6 0
 7 | -11 8 9 0
 8 | -11 -8 -9 0
 9 | 11 8 -9 0
10 | 11 -8 9 0
11 | -8 -9 12 0
12 | 8 9 -12 0
13 | 8 -12 0
14 | 9 -12 0
15 | -13 10 12 0
16 | -13 -10 -12 0
17 | 13 10 -12 0
18 | 13 -10 12 0
19 | -10 -12 14 0
20 | 10 12 -14 0
21 | 10 -14 0
22 | 12 -14 0
23 | 7 -1 -3 0
24 | -7 1 0
25 | -7 3 0
26 | 8 -2 -3 0
27 | -8 2 0
28 | -8 3 0
29 | 9 -1 -4 0
30 | -9 1 0
31 | -9 4 0
32 | 10 -2 -4 0
33 | -10 2 0
34 | -10 4 0
35 | 7 -5 0
36 | -7 5 0
37 | 11 -6 0
38 | -11 6 0
39 | 13 -6 0
40 | -13 6 0
41 | 


--------------------------------------------------------------------------------
/examples/games/sat-puzzle/trivial.dimacs:
--------------------------------------------------------------------------------
1 | p cnf 2 3
2 | 1 -2 0
3 | 1 0
4 | 2 0
5 | 


--------------------------------------------------------------------------------
/examples/intset1.cant:
--------------------------------------------------------------------------------
 1 | ;; An example from William Cook's essay on OOP vs. ADTs
 2 | ;; http://www.cs.utexas.edu/~wcook/Drafts/2009/essay.pdf
 3 | ;; Sets of integers, in an OO style.
 4 | 
 5 | (make empty-set
 6 |   (to ~.empty?      #yes)
 7 |   (to (~ .has? _)   #no)
 8 |   (to (~ .adjoin k) (adjoin<- k empty-set))
 9 |   (to (~ .merge s)  s))
10 | 
11 | (to (adjoin<- n s)
12 |   (if (s .has? n)
13 |       s
14 |       (make extension
15 |         (to ~.empty?      #no)
16 |         (to (~ .has? k)   (or (= n k) (s .has? k)))
17 |         (to (~ .adjoin k) (adjoin<- k extension))
18 |         (to (~ .merge s)  (merge<- extension s)))))
19 | 
20 | (to (merge<- s1 s2)
21 |   (make meld
22 |     (to ~.empty?      (and s1.empty? s2.empty?))
23 |     (to (~ .has? k)   (or (s1 .has? k) (s2 .has? k)))
24 |     (to (~ .adjoin k) (adjoin<- k meld))
25 |     (to (~ .merge s)  (merge<- meld s))))
26 | 
27 | ;; Smoke test
28 | 
29 | (do [(eg ((empty-set .adjoin 6) .adjoin 5))]
30 |   (out .print (eg .has? 5))
31 |   (out .print (eg .has? 6))
32 |   (out .print (eg .has? 7))
33 | )
34 | 


--------------------------------------------------------------------------------
/examples/intset2.cant:
--------------------------------------------------------------------------------
 1 | ;; An example from William Cook's essay on OOP vs. ADTs
 2 | ;; http://www.cs.utexas.edu/~wcook/Drafts/2009/essay.pdf
 3 | ;; Sets of integers, represented by an algebraic datatype.
 4 | ;; We don't yet support abstract datatypes (need 'synergy') --
 5 | ;; we could actually hack that up in terms of =, but it'd be
 6 | ;; nicer with a primitive.
 7 | 
 8 | (let empty-set {empty})
 9 | 
10 | (to (adjoin<- n s)
11 |   (if (has? s n)
12 |       s
13 |       {extension n s}))
14 | 
15 | (to (merge<- s1 s2)
16 |   (may s1
17 |     (be {empty} s2)
18 |     (else       {meld s1 s2})))
19 | 
20 | (to (empty? s)
21 |   (may s
22 |     (be {empty}         #yes)
23 |     (be {extension _ _} #no)
24 |     (be {meld s1 s2}    (and (empty? s1) (empty? s2)))))
25 | 
26 | (to (has? s n)
27 |   (may s
28 |     (be {empty}           #no)
29 |     (be {extension n1 s1} (or (= n n1) (has? s1 n)))
30 |     (be {meld s1 s2}      (or (has? s1 n) (has? s2 n)))))
31 | 
32 | ;; Smoke test
33 | 
34 | (do []
35 |   (let eg (adjoin<- 5 (adjoin<- 6 empty-set)))
36 |   (out .print (has? eg 5))
37 |   (out .print (has? eg 6))
38 |   (out .print (has? eg 7)))
39 | 


--------------------------------------------------------------------------------
/examples/j-bob-proof-checker/README.md:
--------------------------------------------------------------------------------
1 | Ported from https://github.com/the-little-prover/j-bob, but I'm going to mess with it.
2 | 


--------------------------------------------------------------------------------
/examples/j-bob-proof-checker/prelude.cant:
--------------------------------------------------------------------------------
 1 | ;; Prelude
 2 | 
 3 | (let x-axioms
 4 |   '(
 5 |     (dethm equal-same (x)
 6 |       (= (= x x) #yes))
 7 | 
 8 |     (dethm equal-swap (x y)
 9 |       (= (= x y) (= y x)))
10 | 
11 |     (dethm equal-if (x y)
12 |       (if (= x y)
13 |           (= x y)
14 |           #yes))
15 | 
16 |     (dethm if-true (x y)
17 |       (= (if #yes x y) x))
18 | 
19 |     (dethm if-false (x y)
20 |       (= (if #no x y) y))
21 | 
22 |     (dethm if-same (x y)
23 |       (= (if x y y) y))
24 | 
25 |     (dethm if-nest-A (x y z)
26 |       (if x
27 |           (= (if x y z) y)
28 |           #yes))
29 | 
30 |     (dethm if-nest-E (x y z)
31 |       (if x
32 |           #yes
33 |           (= (if x y z) z)))
34 | 
35 |     (dethm atom/cons (x y)
36 |       (= (atom? (cons x y)) #no))
37 | 
38 |     (dethm car/cons (x y)
39 |       (= (car (cons x y)) x))
40 | 
41 |     (dethm cdr/cons (x y)
42 |       (= (cdr (cons x y)) y))
43 | 
44 |     (dethm cons/car+cdr (x)
45 |       (if (atom? x)
46 |           #yes
47 |           (= (cons (car x) (cdr x)) x)))
48 | 
49 |     ;; TODO more
50 |     ))
51 | 
52 | (let prelude
53 |   ;; TODO more
54 |   (each parse-def (chain x-ops x-axioms)))
55 | 


--------------------------------------------------------------------------------
/examples/j-bob-proof-checker/run-trivi-bob.cant:
--------------------------------------------------------------------------------
1 | (load "examples/j-bob-proof-checker/runtime.cant")
2 | (load "examples/j-bob-proof-checker/trivi-bob.cant")
3 | (load "examples/j-bob-proof-checker/prelude.cant")
4 | (load "examples/j-bob-proof-checker/smoketest.cant")
5 | 


--------------------------------------------------------------------------------
/examples/j-bob-proof-checker/runtime.cant:
--------------------------------------------------------------------------------
 1 | ;; Runtime.
 2 | 
 3 | (to (atom? x)   (not (link? x)))                      ;XXX right?
 4 | (to (bob-car x) (and (link? x) x.first))
 5 | (to (bob-cdr x) (and (link? x) x.rest))
 6 | (to (nat? x)    (count? x))
 7 | (to (bob+ x y)  (and (number? x) (number? y) (+ x y)))
 8 | (to (bob< x y)  (and (number? x) (number? y) (< x y)))
 9 | 
10 | (to (size x)
11 |   (may x
12 |     (be `(,h ,@t) (+ (size h) (size t)))
13 |     (else         1)))
14 | 
15 | (let x-ops
16 |   `(
17 |     (atom? (x)  ,atom?)
18 |     (atom (x)   ,atom?)
19 |     (car (x)    ,bob-car)
20 |     (cdr (x)    ,bob-cdr)
21 |     (nat? (x)   ,nat?)
22 |     (natp (x)   ,nat?)
23 |     (size (x)   ,size)
24 |     (= (x y)    ,=)
25 |     (cons (x y) ,link)
26 |     (+ (x y)    ,bob+)
27 |     (< (x y)    ,bob<)
28 |     ))
29 | 


--------------------------------------------------------------------------------
/examples/lambda-calculus/README.md:
--------------------------------------------------------------------------------
 1 | Playing with the call-by-value lambda calculus as a lab for how to
 2 | nicely implement fancier languages.
 3 | 
 4 | First: an interpreter.
 5 | 
 6 | Language:
 7 | Just cbv lambda calculus, but with a few conveniences:
 8 |  X constants / primitives for readable I/O
 9 |  X 'let' / 'to'
10 |  X sugar for multiple args/params
11 |  - some form of recursion?
12 | 


--------------------------------------------------------------------------------
/examples/lambda-calculus/compact-lambda.cant:
--------------------------------------------------------------------------------
 1 | ;; 'Compile' cbv lambda calculus without changing much.
 2 | 
 3 | (to (compile lexp)
 4 |   ((parse lexp) .compile '(HALT)))
 5 | 
 6 | (to (parse lexp)
 7 |   (may lexp
 8 |     (be (? symbol?)           (var-ref<- lexp))
 9 |     (be `(lambda (,v) ,body)  (abstraction<- v (parse body)))
10 |     (be `(,operator ,operand) (call<- (parse operator)
11 |                                       (parse operand)))))
12 | 
13 | ;; Variable reference
14 | (to ((var-ref<- v) .compile k)
15 |   `(VAR ,v ,@k))
16 | 
17 | ;; Lambda expression
18 | (to ((abstraction<- v body) .compile k)
19 |   (let code (body .compile '(RET)))
20 |   `(LAM ,v ,code.count ,@code ,@k))
21 | 
22 | ;; Application
23 | (to ((call<- operator operand) .compile k)
24 |   (let code (operator .compile (operand .compile '(CALL))))
25 |   (may k
26 |     (be '(RET) code)
27 |     (else      `(SAVE ,code.count ,@code ,@k))))
28 | 
29 | 
30 | ;; Smoke test
31 | 
32 | (out .print (compile
33 | ;  '(lambda (x) x)
34 | ;  '(lambda (x) y)
35 |   '((lambda (x) (lambda (y) x)) (lambda (z) z))
36 | ))
37 | 


--------------------------------------------------------------------------------
/examples/lambda-calculus/examples/church.lambda:
--------------------------------------------------------------------------------
1 | ;; -*- cant -*-
2 | 
3 | (to (one f x) (f x))
4 | (let two (+ one one))
5 | (let three (church<-count 3))
6 | (count<-church (expt two (* two (+ two three))))
7 | 


--------------------------------------------------------------------------------
/examples/lambda-calculus/examples/elementary-ca.lambda:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | ;; Elementary cellular automata
 4 | 
 5 | (to (snil if-link if-nil) if-nil)
 6 | (to (slink h t if-link if-nil) (if-link h t))
 7 | 
 8 | (to (each! f)
 9 |   (fix ([walking slist]
10 |         (slist ([h t]
11 |                 (let _ (f h))
12 |                 (walking t))
13 |                'ok))))
14 | 
15 | (to (show bits)                         ;TODO: center
16 |   (let _ (each! ([bit] (display (if bit "*" "-")))
17 |                 bits))
18 |   (display "\n"))
19 | 
20 | (to (update rule bits)
21 |   (fix ([neighing a b bits]
22 |         (bits ([first rest]
23 |                (slink (rule a b first)
24 |                       (neighing b first rest)))
25 |               (slink (rule a b no) (slink (rule b no no) snil))))
26 |        no
27 |        no
28 |        bits))
29 | 
30 | (to (run rule start-bits n-steps)
31 |   (to (step bits)
32 |     (let _ (show bits))
33 |     (update rule bits))
34 |   (show (n-steps step start-bits)))
35 | 
36 | ;; rule 110: 0110 1110
37 | (to (rule-110 a b c)
38 |   (if a
39 |       (if b (not c) c)
40 |       (or b c)))
41 | 
42 | (run rule-110 (slink yes snil) (church<-count 10))
43 | 


--------------------------------------------------------------------------------
/examples/lambda-calculus/examples/factorial.lambda:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | ;; Factorial of Church numbers
 4 | 
 5 | (let one (succ zero))
 6 | 
 7 | (to (Pair a b take) (take a b))
 8 | 
 9 | (to (factorial n)
10 |   (to (step pair)
11 |     (pair ([k p]
12 |            (let k1 (succ k))
13 |            (Pair k1 (* k1 p)))))
14 |   (n step
15 |      (Pair zero one)
16 |      ([k p] p)))
17 | 
18 | (count<-church (factorial (church<-count 5)))
19 | 


--------------------------------------------------------------------------------
/examples/lambda-calculus/examples/reverse.lambda:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | (to (chain-reverse xs)
 4 |   ;; step: return a function that takes a tail and chains my reverse to it
 5 |   (to (step x rest-fn)
 6 |     (compose rest-fn (link x)))
 7 |   (xs step itself))
 8 | 
 9 | (to (reverse xs)
10 |   (chain-reverse xs nil))
11 | 
12 | (list<-church (reverse (chain-reverse (church<-list '(1 2 4 8))
13 |                                       (church<-list '(a b c)))))
14 | 


--------------------------------------------------------------------------------
/examples/lambda-calculus/examples/trivial1.lambda:
--------------------------------------------------------------------------------
1 | ;; -*- cant -*-
2 | 
3 | (bool<-church (not (and (church<-bool #yes) (church<-bool #no))))
4 | 


--------------------------------------------------------------------------------
/examples/lambda-calculus/examples/trivial2.lambda:
--------------------------------------------------------------------------------
1 | ;; -*- cant -*-
2 | 
3 | (list<-church (chain (church<-list '(x y z))
4 |                      (link 'a (link 'b nil))))
5 | 


--------------------------------------------------------------------------------
/examples/miasma-x86-toolkit/README.md:
--------------------------------------------------------------------------------
1 | Miasma generates code to emit x86 machine code, using tables of instructions.
2 | This is a port of https://github.com/darius/miasma from Scheme.
3 | 
4 | Provided are emitters to C code and Python code, though I don't expect
5 | to maintain them. If I end up using this it'll probably be as part of
6 | a JIT compiler for Cant in Cant. In the meantime, it's just more
7 | example code to help hammer out the Cant language design.
8 | 


--------------------------------------------------------------------------------
/examples/miasma-x86-toolkit/c/asm_stuff.h:
--------------------------------------------------------------------------------
 1 | typedef   signed int   i32;     /* 32-bit, signed */
 2 | typedef unsigned int   u32;     /* 32-bit, unsigned */
 3 | typedef   signed short i16;     /* 16-bit, signed */
 4 | typedef unsigned short u16;     /* 16-bit, unsigned */
 5 | typedef   signed char   i8;     /*  8-bit, signed */
 6 | typedef unsigned char   u8;     /*  8-bit, unsigned */
 7 | 
 8 | typedef u8 *x86_bufptr;
 9 | 
10 | #define x86_pushing(ptr, x)  (x86_tmp = (x), *(ptr) = x86_tmp)
11 | 
12 | #define x86_push_u8(x)    ( x86_pushing(--x86_bptr,x) )
13 | #define x86_push_u16(x)   ( x86_pushing((u16 *)(x86_bptr -= 2),x) )
14 | #define x86_push_u32(x)   ( x86_pushing((u32 *)(x86_bptr -= 4),x) )
15 | 
16 | #define x86_push_i8(x)    ( x86_pushing(--x86_bptr,x) )
17 | #define x86_push_i16(x)   ( x86_pushing((i16 *)(x86_bptr -= 2),x) )
18 | #define x86_push_i32(x)   ( x86_pushing((i32 *)(x86_bptr -= 4),x) )
19 | 
20 | #define mod_rm(reg, mrm)  ( x86_push_u8 (((reg)<<3) | (mrm)) )
21 | #define modrm(mod, rm)    ( ((mod)<<6) | (rm) )
22 | 
23 | #define at_reg(r)         ( modrm (0, (r)) )
24 | #define at_mem(addr)      ( x86_push_i32 (addr), modrm (0, 5) )
25 | 
26 | #define atb(r, offset)    ( x86_push_i8 (offset), modrm (1, (r)) )
27 | 
28 | #define atv(r, offset)    ( x86_push_i32 (offset), modrm (2, (r)) )
29 | 
30 | #define reg(r)            ( modrm (3, (r)) )
31 | 


--------------------------------------------------------------------------------
/examples/miasma-x86-toolkit/python/x86_stub.py:
--------------------------------------------------------------------------------
 1 | import array
 2 | 
 3 | buf = array.array('B')
 4 | 
 5 | def freeze_code_buffer():
 6 |     global buf
 7 |     buf.reverse()
 8 |     code = buf.tostring()
 9 |     buf = array.array('B')
10 |     return code
11 | 
12 | def push_u8(x):
13 |     global buf
14 |     buf.append(x)
15 | 
16 | def push_u16(x):
17 |     push_u8((x & 0xFFFF) >> 8)
18 |     push_u8(x & 0xFF)
19 |     return x
20 | 
21 | def push_u32(x):
22 |     push_u16((x & 0xFFFFFFFFL) >> 16)
23 |     push_u16(x & 0xFFFF)
24 |     return x
25 | 
26 | def push_i8(x):
27 |     push_u8(x & 0xFF)
28 |     return x
29 | 
30 | def push_i16(x):
31 |     push_u16(x & 0xFFFF)
32 |     return x
33 | 
34 | def push_i32(x):
35 |     push_u32(x & 0xFFFFFFFFL)
36 |     return x
37 | 
38 | def mod_rm(reg, mrm):
39 |     push_u8((reg << 3) | mrm)
40 | 
41 | def modrm(mod, rm):
42 |     return (mod << 6) | rm
43 | 
44 | def at_reg(r):
45 |     return modrm(0, r)
46 | 
47 | def at_mem(addr):
48 |     push_i32(addr)
49 |     return modrm(0, 5)
50 | 
51 | def atb(r, offset):
52 |     push_i8(offset)
53 |     return modrm(1, r)
54 | 
55 | def atv(r, offset):
56 |     push_i32(offset)
57 |     return modrm(2, r)
58 | 
59 | def reg(r):
60 |     return modrm(3, r)
61 | 


--------------------------------------------------------------------------------
/examples/miasma-x86-toolkit/registers.cant:
--------------------------------------------------------------------------------
 1 | ;; Collections of x86 registers.
 2 | 
 3 | (to (legal-register? x size)
 4 |   ((possible-registers size) .find? x))
 5 | 
 6 | ;; The general registers by size, and then by their 3-bit code.
 7 | (let possible-registers
 8 |   (map<-lists '((1 [%al %cl %dl %bl %ah %ch %dh %bh])
 9 |                 (2 [%ax %cx %dx %bx %sp %bp %si %di])
10 |                 (4 [%eax %ecx %edx %ebx %esp %ebp %esi %edi]))))
11 | 
12 | ;; TODO instead of a symbol and lookup, consider creating register
13 | ;; objects which know their number.
14 | (let register-number
15 |   (do [(reg-num (!map<-lists '((%es 0) (%cs 1) (%ss 2) (%ds 3) (%fs 4) (%gs 5)
16 |                                (%cr0 0) (%cr2 2) (%cr3 3) (%cr4 4)
17 |                                (%dr0 0) (%dr1 1) (%dr2 2) (%dr3 3) (%dr6 6) (%dr7 7))))]
18 |     (for each! [(registers possible-registers.values)]
19 |       (reg-num .merge! registers.inverse))
20 |     reg-num.map))
21 | 
22 | ;; The set of all registers that can appear as instruction arguments.
23 | (let registers register-number.domain)
24 | 
25 | (to (register? x)
26 |   (registers .maps? x))
27 | 
28 | (export possible-registers register-number registers register?)
29 | 


--------------------------------------------------------------------------------
/examples/miasma-x86-toolkit/tables/i387.scm:
--------------------------------------------------------------------------------
 1 | ; Miasma: x86 Scheme Assembler.
 2 | ; Copyright (C) 2000, Darius Bacon, Brian Spilsbury, Alycat
 3 | ; Refer to legal/License.txt
 4 | 
 5 | ;; floating-point instructions
 6 | 
 7 | (#xD9 #xF0 F2XM1           "Replace ST(0) with 2^ST(0) - 1")
 8 | (#xD9 #xE1 FABS            "Replace ST with its absolute value")
 9 | 
10 | ;(#xD8 /0   FADD m32 real    "fp add")
11 | ;(#xDC /0   FADD m64 real    "fp add")
12 | ;(#xD8 /0   FADD m64 real    "fp add")
13 | 
14 | 
15 | 
16 | ;; m32real m64real m80real
17 | ;; manual page 34
18 | 
19 | ;; ST or ST(0)
20 | 
21 | ;; ST(i)
22 | 
23 | ;; m16int m32int m64int
24 | 
25 | ;; mm
26 | ;; (mmx)
27 | 
28 | ;; mm/m32
29 | ;; mm/m64
30 | 
31 | 


--------------------------------------------------------------------------------
/examples/miasma-x86-toolkit/tables/i486.scm:
--------------------------------------------------------------------------------
 1 | ; Miasma: x86 Scheme Assembler.
 2 | ; Copyright (C) 2000, Darius Bacon, Brian Spilsbury, Alycat
 3 | ; Refer to legal/License.txt
 4 | 
 5 | ; FIXME: this is 486 and above only.  Separate it out.
 6 | ;(#xC8 +    BSWAP r32     "Reverse the byte order of a register")
 7 | 
 8 | 
 9 | 
10 | 
11 | (#x0F #x08    INVD    "Invalide internal caches")
12 | 
13 | (#x0F #x01 /7 INVLPG m    "Invalide TLB entry")
14 | 
15 | (#x0F #x09    WBINVD    "Write back and invalidate cache")
16 | 
17 | (#x0F #xC0 /r XADD r/m8  r8  "Exchange and add")
18 | (#x0F #xC1 /r XADD r/m32 r32 "Exchange and add")
19 | 
20 | 
21 | 


--------------------------------------------------------------------------------
/examples/miasma-x86-toolkit/tables/i586.scm:
--------------------------------------------------------------------------------
 1 | ; Miasma: x86 Scheme Assembler.
 2 | ; Copyright (C) 2000, Darius Bacon, Brian Spilsbury, Alycat
 3 | ; Refer to legal/License.txt
 4 | 
 5 | ; rdmsr
 6 | 
 7 | ; rdpmc (p5-mmx, p6)
 8 | 
 9 | (#x0F #x31 RDTSC           "Read time stamp counter")
10 | 
11 | (#x0F #x30 WRMSR           "Write to model specific register")
12 | 
13 | 
14 | 


--------------------------------------------------------------------------------
/examples/miasma-x86-toolkit/tables/i586mmx.scm:
--------------------------------------------------------------------------------
 1 | ; Miasma: x86 Scheme Assembler.
 2 | ; Copyright (C) 2000, Darius Bacon, Brian Spilsbury, Alycat
 3 | ; Refer to legal/License.txt
 4 | 
 5 | (#x0F #x77 EMMS            "Empty MMX state")
 6 | 
 7 | (#x0F #x6E /r MOVD mm r/m32 "")
 8 | (#x0F #x7E /r MOVD r/m32 mm "")
 9 | 
10 | (#x0F #x6F /r MOVQ mm mm/m64 "")
11 | (#x0F #x7F /r MOVQ mm/m64 mm "")
12 | 


--------------------------------------------------------------------------------
/examples/miasma-x86-toolkit/tables/i686.scm:
--------------------------------------------------------------------------------
1 | ; Miasma: x86 Scheme Assembler.
2 | ; Copyright (C) 2000, Darius Bacon, Brian Spilsbury, Alycat
3 | ; Refer to legal/License.txt
4 | 
5 | (#x0F #x40 ? /r CMOV r32 r/m32 "Move if condition is true")
6 | 
7 | 


--------------------------------------------------------------------------------
/examples/primes.cant:
--------------------------------------------------------------------------------
1 | ;; Example from Land of Lisp p. 459: list prime numbers <= 1000
2 | 
3 | (out .print (for skip [(n (2 .thru 1000))]
4 |               (some (~ .divides? n) (2 .till n))))
5 | 
6 | ;; though there's actually a library instead:
7 | (import (use 'factoring) the-primes)
8 | (out .print (keep-while ||(<= it 1000) the-primes))
9 | 


--------------------------------------------------------------------------------
/examples/project-oiler/01.cant:
--------------------------------------------------------------------------------
1 | (to (oiler1 n)
2 |   (sum (~.nub (chain (3 .till n 3) (5 .till n 5)))))
3 | 
4 | (out .print (oiler1 200))
5 | ;;(out .print (oiler1 1000))
6 | 


--------------------------------------------------------------------------------
/examples/project-oiler/02.cant:
--------------------------------------------------------------------------------
1 | (to (oiler2 n)
2 |   (sum (keep ~.even? (keep-while ||(<= it n) fibs))))
3 | 
4 | (let fibs (do loop [(a 1) (b 1)]
5 |             (link$ a ($ (loop b (+ a b))))))
6 | 
7 | ;(out .print (oiler2 10))
8 | (out .print (oiler2 4000000))
9 | 


--------------------------------------------------------------------------------
/examples/project-oiler/03.cant:
--------------------------------------------------------------------------------
1 | (import (use 'factoring) factor)
2 | 
3 | (to (oiler3 n)
4 |   (max @(factor n)))
5 | 
6 | (out .print (oiler3 131957))
7 | ;;(out .print (oiler3 600851475143))
8 | 


--------------------------------------------------------------------------------
/examples/project-oiler/04.cant:
--------------------------------------------------------------------------------
 1 | (to (oiler4 lo bound)
 2 |   (max @(for yeahs [(`(,i ,j) ((lo .till bound) .k-bags 2))]
 3 |           (let p (* i j))
 4 |           (and (palindrome? p.text) p))))
 5 | 
 6 | (to (palindrome? text)
 7 |   (<=> text (reverse text)))
 8 | 
 9 | (out .print (oiler4 10 30)) ;; 696
10 | ;;(out .print (oiler4 100 1000))
11 | 


--------------------------------------------------------------------------------
/examples/project-oiler/05.cant:
--------------------------------------------------------------------------------
1 | (out .print (lcm @(as-list (2 .thru 10))))
2 | ;;(out .print (lcm @(as-list (2 .thru 20))))
3 | 


--------------------------------------------------------------------------------
/examples/project-oiler/06.cant:
--------------------------------------------------------------------------------
1 | (to (oiler6 ns)
2 |   (- ((sum ns) .** 2)
3 |      (sum-by (~ .** 2) ns)))
4 | 
5 | (out .print (oiler6 (1 .thru 10)))
6 | ;(out .print (oiler6 (1 .thru 100)))
7 | 


--------------------------------------------------------------------------------
/examples/project-oiler/07.cant:
--------------------------------------------------------------------------------
1 | ;; 10001st prime
2 | 
3 | (import (use 'factoring) the-primes)
4 | 
5 | ;(out .print (the-primes 5))
6 | (out .print (the-primes 100))
7 | ;(out .print (the-primes 10000))
8 | 


--------------------------------------------------------------------------------
/examples/project-oiler/08.cant:
--------------------------------------------------------------------------------
 1 | (let input
 2 | ("73167176531330624919225119674426574742355349194934
 3 | 96983520312774506326239578318016984801869478851843
 4 | 85861560789112949495459501737958331952853208805511
 5 | 12540698747158523863050715693290963295227443043557
 6 | 66896648950445244523161731856403098711121722383113
 7 | 62229893423380308135336276614282806444486645238749
 8 | 30358907296290491560440772390713810515859307960866
 9 | 70172427121883998797908792274921901699720888093776
10 | 65727333001053367881220235421809751254540594752243
11 | 52584907711670556013604839586446706324415722155397
12 | 53697817977846174064955149290862569321978468622482
13 | 83972241375657056057490261407972968652414535100474
14 | 82166370484403199890008895243450658541227588666881
15 | 16427171479924442928230863465674813919123162824586
16 | 17866458359124566529476545682848912883142607690042
17 | 24219022671055626321111109370544217506941658960408
18 | 07198403850962455444362981230987879927244284909188
19 | 84580156166097919133875499200524063689912560717606
20 | 05886116467109405077541002256983155200055935729725
21 | 71636269561882670428252483600823257530420752963450" .replace "\n" ""))
22 | 
23 | (let digits (~.array (each ~.number input)))
24 | 
25 | (to (oiler8 n)
26 |   (max @(each ||(* @it.list) (digits .k-slices n))))
27 | 
28 | (out .print (oiler8 4)) ;; 5832
29 | ;(out .print (oiler8 13))
30 | 


--------------------------------------------------------------------------------
/examples/project-oiler/09.cant:
--------------------------------------------------------------------------------
 1 | (to (answer total)
 2 |   (let [a b c] (~.first (triplets<- total)))
 3 |   (* a b c))
 4 | 
 5 | (to (triplets<- total)
 6 |   (for gather [(c ((- total 2) .down-till (total .quotient 3)))]
 7 |     (let c^2 (* c c))
 8 |     (for yeahs [(b (c.-1 .down-till (c .quotient 2)))]
 9 |       (and (< 0 (let a (- total c b)))
10 |            (< a b c)
11 |            (= c^2 (+ (* a a) (* b b)))
12 |            [a b c]))))
13 | 
14 | (to (main _)
15 |   (out .say "~w\n" (answer 12)))
16 | ;;  (out .say "~w\n" (answer 1000)))
17 | 


--------------------------------------------------------------------------------
/examples/project-oiler/10.cant:
--------------------------------------------------------------------------------
1 | (import (use 'factoring) list-primes-till)
2 | 
3 | (to (main args)
4 |   (let arg (args 1))
5 |   (out .say "~w\n" (sum (list-primes-till arg.number))))
6 | 


--------------------------------------------------------------------------------
/examples/project-oiler/12.cant:
--------------------------------------------------------------------------------
 1 | ;; Highly-divisible triangular number
 2 | 
 3 | (import (use 'factoring) factor list-divisors)
 4 | 
 5 | (to (count-divisors n)
 6 |   (let powers (run-lengths (factor n)))
 7 |   (* @(each ~.+1 powers)))
 8 |   ;; eg 12 = 2^2 * 3^1; 1 2 3 4 6 12 
 9 |   ;; So it's 6 divisors, the product of the incremented powers, (2+1)*(1+1)
10 | 
11 | ;; E.g. (a a b b b c) => (2 3 1)
12 | (to (run-lengths xs)
13 |   (hm (if xs.none? '())
14 |       (else (do scanning [(n 1) (x xs.first) (xs xs.rest)]
15 |               (may xs
16 |                 (be '() `(,n))
17 |                 (be `(,(= x) ,@rest) (scanning n.+1 x rest))
18 |                 (else (link n (scanning 1 xs.first xs.rest))))))))
19 | 
20 | (for each! [(n (1 .thru 42))]  ;; Quickie test of count-divisors
21 |   (surely (= (count-divisors n)
22 |              (~.count (list-divisors n)))))
23 | 
24 | (let triangle-numbers (amassing$ + 1 2.and-up))
25 | 
26 | (let highly-divisibles (for keep$ [(n triangle-numbers)]
27 |                          (< 500 (count-divisors n))))
28 | (out .print highly-divisibles.first)
29 | 


--------------------------------------------------------------------------------
/examples/project-oiler/14.cant:
--------------------------------------------------------------------------------
 1 | ;; Longest Collatz sequence
 2 | 
 3 | (to (collatz-step n)
 4 |   (hm (if n.even? (n .quotient 2))
 5 |       (else (+ (* 3 n) 1))))
 6 | 
 7 | ;; Trivial logic, but it'll be slow if we take this up to a million:
 8 | 
 9 | (to (collatz-chain n)
10 |   (keep-until (be? 1) (iterating collatz-step n)))
11 | 
12 | ;; So let's memoize.
13 | 
14 | (import (use 'memoize) memoize)
15 | 
16 | (let collatz-length
17 |   (memoize (make _
18 |              (to (~ 1) 0)
19 |              (to (~ n) (+ 1 (collatz-length (collatz-step n)))))))
20 | 
21 | (for each! [(n (1 .till 10))]  ;; Test it.
22 |   (surely (= (collatz-length n) ((collatz-chain n) .count))))
23 | 
24 | (out .print (max-by collatz-length (1 .till 1000000)))
25 | 


--------------------------------------------------------------------------------
/examples/project-oiler/15.cant:
--------------------------------------------------------------------------------
1 | ;; Lattice paths
2 | 
3 | (to (count-paths n)
4 |   ;; For an n-by-n grid, take 2n steps, exactly n of them horizontal.
5 |   ((* 2 n) .choose n))
6 | 
7 | (out .print (count-paths 20))
8 | 


--------------------------------------------------------------------------------
/examples/project-oiler/16.cant:
--------------------------------------------------------------------------------
1 | ;; Power digit sum
2 | 
3 | (out .print (sum ((2 .** 1000) .digits)))
4 | 


--------------------------------------------------------------------------------
/examples/project-oiler/17.cant:
--------------------------------------------------------------------------------
 1 | ;; Number letter counts
 2 | 
 3 | (import (use 'english-numbers) numeralize)
 4 | 
 5 | (to (count-number-letters n)
 6 |   (let nletters (tally-by ~.letter? (numeralize n)))
 7 |   ;; Adjust our answer because e.g. (numeralize 301) => "three hundred one"
 8 |   ;; but the specified answer was to be "three hundred and one".
 9 |   (if (and (< 100 n 1000) (n .odd? 100))
10 |       (+ 3 nletters) ;; for "and"
11 |       nletters))
12 | 
13 | ;;(out .print (each count-number-letters (1 .thru 5)))
14 | (out .print (sum-by count-number-letters (1 .thru 1000)))
15 | 


--------------------------------------------------------------------------------
/examples/project-oiler/18.cant:
--------------------------------------------------------------------------------
 1 | ;; Maximum path sum I
 2 | 
 3 | (let small-example '((3)
 4 |                      (7 4)
 5 |                      (2 4 6)
 6 |                      (8 5 9 3)))
 7 | 
 8 | (let data 
 9 |   '((75)
10 |     (95 64)
11 |     (17 47 82)
12 |     (18 35 87 10)
13 |     (20 04 82 47 65)
14 |     (19 01 23 75 03 34)
15 |     (88 02 77 73 07 63 67)
16 |     (99 65 04 28 06 16 70 92)
17 |     (41 41 26 56 83 40 80 70 33)
18 |     (41 48 72 33 47 32 37 16 94 29)
19 |     (53 71 44 65 25 43 91 52 97 51 14)
20 |     (70 11 33 28 77 73 17 78 39 68 17 57)
21 |     (91 71 52 38 17 14 91 43 58 50 27 29 48)
22 |     (63 66 04 68 89 53 67 30 73 16 69 87 40 31)
23 |     (04 62 98 27 23 09 70 98 73 93 38 53 60 04 23)))
24 | 
25 | (to (max-path-sum triangle)
26 |   (~.first (for fold [(steps triangle.but-last) (so-far triangle.last)]
27 |              (each + steps (each max so-far.rest so-far.but-last)))))
28 | 
29 | (out .print (max-path-sum small-example))
30 | (out .print (max-path-sum data))
31 | 


--------------------------------------------------------------------------------
/examples/project-oiler/19.cant:
--------------------------------------------------------------------------------
 1 | ;; Counting Sundays
 2 | 
 3 | (import (use 'calendar) weekday<-day day<-date)
 4 | 
 5 | ;; How many Sundays fell on the first of the month during the
 6 | ;; twentieth century (1 Jan 1901 to 31 Dec 2000)?
 7 | 
 8 | ;; XXX 0-based for month and day are surprising
 9 | (let n-sundays (for sum-by [(y (1901 .thru 2000))]
10 |                  (for tally-by [(m (0 .thru 11))]
11 |                    (= 0 (weekday<-day (day<-date {date y m 0}))))))
12 | (out .print n-sundays)
13 | 


--------------------------------------------------------------------------------
/examples/project-oiler/20.cant:
--------------------------------------------------------------------------------
1 | ;; Factorial digit sum
2 | 
3 | (out .print (-> 100 ~.! ~.digits sum))
4 | 


--------------------------------------------------------------------------------
/examples/project-oiler/21.cant:
--------------------------------------------------------------------------------
 1 | ;; Amicable numbers
 2 | 
 3 | (import (use 'factoring) list-divisors)
 4 | (import (use 'memoize) memoize)
 5 | 
 6 | (to (answer-for n)
 7 |   (sum (keep amicable? (1 .till n))))
 8 | 
 9 | (to (amicable? n)
10 |   (and (< 1 n)     ;; 1 is annoying and obviously not amicable
11 |        (not= n (let k (sum-proper-divisors n)))
12 |        (= n (sum-proper-divisors k))))
13 | 
14 | (let sum-proper-divisors (memoize (on (n)
15 |                                     (- (sum (list-divisors n)) n))))
16 | 
17 | (out .print (answer-for 10000)) ;; 31626
18 | 


--------------------------------------------------------------------------------
/examples/project-oiler/22.cant:
--------------------------------------------------------------------------------
 1 | ;; Names scores
 2 | 
 3 | ;; TODO code a proper csv-file reader (I edited the quotes out of the data file)
 4 | (let line (with-input-file ~.read-line "examples/project-oiler/p022_names.comma.txt"))
 5 | (let names (sort (line .split ",")))
 6 | 
 7 | (for each! [(name names)]
 8 |   (surely (every ~.uppercase? name)))
 9 | 
10 | (out .print (for sum-by [((~ rank name) names.items)]
11 |               (* rank.+1 (sum-by (~ .- #\A.-1) name))))
12 | 


--------------------------------------------------------------------------------
/examples/project-oiler/23.cant:
--------------------------------------------------------------------------------
 1 | ;; Non-abundant sums
 2 | 
 3 | (import (use 'factoring) list-divisors)
 4 | 
 5 | ;; "It can be shown that all integers greater than 28123 can be
 6 | ;; written as the sum of two abundant numbers."
 7 | (let limit 28123)
 8 | 
 9 | (to (abundant? n)
10 |   (< n (sum-proper-divisors n)))
11 | 
12 | (to (sum-proper-divisors n)
13 |   (- (sum (list-divisors n)) n))
14 | 
15 | (to (answer)
16 |   ;; Ported from Norvig's answer. Not too much slower than my longer one.
17 |   (let abundants (keep abundant? (1 .till limit)))
18 |   (let abundants-set abundants.range)
19 |   (to (abundants-sum? k) ;; Can k (<= limit) be written as the sum of two abundant numbers?
20 |     (for some [(a abundants)]
21 |       (abundants-set .maps? (- k a))))
22 |   (sum (skip abundants-sum? (1 .thru limit))))
23 | 
24 | (out .print (answer)) ;; 4179871
25 | 


--------------------------------------------------------------------------------
/examples/project-oiler/24.cant:
--------------------------------------------------------------------------------
1 | ;; Lexicographic permutations
2 | 
3 | (import (use "utils") lex-permutation)
4 | 
5 | (let answer (lex-permutation 10 999999))
6 | (out .displayln ("" .join (each ~.text answer)))
7 | 


--------------------------------------------------------------------------------
/examples/project-oiler/25.cant:
--------------------------------------------------------------------------------
 1 | ;; 1000-digit Fibonacci number
 2 | 
 3 | ;; copied from ./02.cant
 4 | (let fibs (do loop [(a 1) (b 1)]
 5 |             (link$ a ($ (loop b (+ a b))))))
 6 | 
 7 | (let (~ i fib-i) (~.first (for skip-until [((~ index value) fibs.items)]
 8 |                             (<= 999 (value .log 10))))) ;; 999 digits after the leftmost
 9 | (out .print i.+1) ;; Increment because their index convention is 1-based
10 | 


--------------------------------------------------------------------------------
/examples/project-oiler/26.cant:
--------------------------------------------------------------------------------
 1 | ;; Reciprocal cycles
 2 | ;; Find the value of d < 1000 for which 1/d contains the longest
 3 | ;; recurring cycle in its decimal fraction part.
 4 | 
 5 | (to (answer)
 6 |   (max-by cycle-length (2 .till 1000)))
 7 | 
 8 | (to (cycle-length d)
 9 |   (find-repeat-length (long-reciprocal-states d)))
10 | 
11 | ;; Compute the infinite decimal reciprocal of denom by long division.
12 | ;; List the states we go through in doing this.
13 | (to (long-reciprocal-states denom)
14 |   (do dividing [(numer 1)]
15 |     (let (~ digit remainder) (numer ./mod denom))
16 |     (link$ remainder
17 |            ($ (dividing (* remainder 10))))))
18 | 
19 | ;; Find the first repeated state and return the length of the state cycle.
20 | (to (find-repeat-length states)
21 |   (let index (!map<-)) ;; Map from state to the last index where it previously occurred
22 |   (do scanning [(pairs states.items)]
23 |     (let (~ i state) pairs.first)
24 |     (may (index .get state)
25 |       (be #no
26 |         (index .set! state i)
27 |         (scanning pairs.rest))
28 |       (be prev-i
29 |         (- i prev-i)))))
30 | 
31 | (out .print (answer)) ;; 983
32 | 


--------------------------------------------------------------------------------
/examples/project-oiler/27.cant:
--------------------------------------------------------------------------------
 1 | ;; Quadratic primes
 2 | 
 3 | ;; Considering n^2 + an + b where integer |a| < 1000, |b| <= 1000,
 4 | ;; find a and b that produce the maximum number of primes for consecutive values of n from 0 up.
 5 | 
 6 | (import (use 'factoring) prime? list-primes-till)
 7 | 
 8 | (to (answer limit)
 9 |   (let ab-pair (best-pair-within limit))
10 |   (let primes (quadratic-primes ab-pair))
11 |   (out .say "~w yields ~w primes: ~w\n" ab-pair primes.count primes)
12 |   (out .print (* @ab-pair)))
13 | 
14 | (to (best-pair-within limit)
15 |   (let b-candidates (list-primes-till limit.+1)) ; b must be prime because for n=0 the quadratic's value =b
16 |   (for max-by [(ab-pair (grid* ((- limit.-1) .till limit) b-candidates))]
17 |     (~.count (quadratic-primes ab-pair))))
18 | 
19 | (to (quadratic-primes ab-pair)
20 |   (initial-primes (poly-values (quadratic @ab-pair))))
21 | 
22 | (to (initial-primes ns)
23 |   (for keep-while [(n ns)]
24 |     (and (< 0 n) (prime? n))))
25 | 
26 | (to (poly-values f)
27 |   (each$ f 0.and-up))
28 | 
29 | (to ((quadratic a b) n)
30 |   (+ b (* n (+ a n))))
31 | 
32 | (answer 1000) ;; -59231
33 | 


--------------------------------------------------------------------------------
/examples/project-oiler/28.cant:
--------------------------------------------------------------------------------
 1 | ;; Number spiral diagonals
 2 | 
 3 | ;; 6x6:
 4 | ;; 43 44 45 46 47 48 49
 5 | ;; 42 21 22 23 24 25 26
 6 | ;; 41 20  7  8  9 10 27
 7 | ;; 40 19  6  1  2 11 28
 8 | ;; 39 18  5  4  3 12 29
 9 | ;; 38 17 16 15 14 13 30
10 | ;; 37 36 35 34 33 32 31
11 | 
12 | (to (diagonals-sum n)
13 |   (+ 1 (for sum-by [(k (3 .thru n 2))]
14 |          ;; For the square with k^2 at upper right, the other three
15 |          ;; diagonal values are almost the same, minus a deficit
16 |          ;; that's a multiple of k-1: an increasing multiple as you
17 |          ;; wind back counterclockwise. So these four corners add up
18 |          ;; to 4k^2 minus that deficit.
19 |          (- (* 4 (k .** 2))
20 |             (* (+ 1 2 3) k.-1)))))
21 |   
22 | (out .print (diagonals-sum 5))
23 | (out .print (diagonals-sum 1001))
24 | 


--------------------------------------------------------------------------------
/examples/project-oiler/29.cant:
--------------------------------------------------------------------------------
 1 | ;; Distinct powers
 2 | 
 3 | ;; Maybe the problem's intent was to find a way to do it without
 4 | ;; materializing huge numbers, but I'll just materialize them.
 5 | 
 6 | (to (answer n)
 7 |   (let terms (for each [(`(,a ,b) ((2 .thru n) .k-lists 2))]
 8 |                (a .** b)))
 9 |   terms.range.count)
10 | 
11 | (out .print (answer 5))
12 | (out .print (answer 100))
13 | 


--------------------------------------------------------------------------------
/examples/project-oiler/30.cant:
--------------------------------------------------------------------------------
 1 | ;; Digit fifth powers
 2 | 
 3 | ;; Naive approach.
 4 | (to (answer5)
 5 |   (to (sum-of-digit5s n)
 6 |     (sum-by (~ .** 5) n.digits))
 7 |   (for keep [(n (2 .till 400000))] ;; We need to go somewhat higher than 10^5
 8 |     (= n (sum-of-digit5s n))))
 9 | 
10 | ;; Smarter approach from toddmowen's discussion post.
11 | (to (smarter)
12 |   (for yeahs [(digits ((0 .thru 9) .k-bags 6))]
13 |     (let n (sum-by (~ .** 5) digits))
14 |     (and (= n (sum-by (~ .** 5) n.digits))
15 |          (< 1 n) ;; 1 is excluded by the problem statement
16 |          n)))
17 | 
18 | ;;(let answer (answer5))
19 | (let answer (smarter))
20 | (out .print answer)
21 | (out .print (sum answer)) ;; 443839
22 | 


--------------------------------------------------------------------------------
/examples/project-oiler/31.cant:
--------------------------------------------------------------------------------
 1 | ;; Coin sums
 2 | 
 3 | (import (use 'memoize) memoize)
 4 | 
 5 | ;; 1p, 2p, 5p, 10p, 20p, 50p, £1 (100p), and £2 (200p).
 6 | (let all-denominations '(1 2 5 10 20 50 100 200))
 7 | ;; How many different ways can £2 be made using any number of coins?
 8 | 
 9 | ;; Rough idea: ways(k) =? sum(ways(k-coin) for coin in denominations)
10 | ;; But that's wrong: you could add coins in different orders and it'd
11 | ;; count every different order separately. So exclude larger
12 | ;; denominations in the recurrence:
13 | (let count-ways
14 |   (memoize (on (goal denoms)
15 |              (hm (if (< goal 0) 0)
16 |                  (if (= goal 0) 1)
17 |                  (else (for sum-by [(coin denoms)]
18 |                          (count-ways (- goal coin)
19 |                                      (keep ||(<= it coin) denoms))))))))
20 | 
21 | (out .print (count-ways 200 all-denominations))
22 | 


--------------------------------------------------------------------------------
/examples/project-oiler/33.cant:
--------------------------------------------------------------------------------
 1 | ;; Digit cancelling fractions
 2 | 
 3 | (import (use 'ratio) ratio<- ratio-show r*)
 4 | 
 5 | ;; There are exactly four non-trivial examples of this type of
 6 | ;; fraction, less than one in value, and containing two digits in the
 7 | ;; numerator and denominator.
 8 | 
 9 | ;; If the product of these four fractions is given in its lowest
10 | ;; common terms, find the value of the denominator.
11 | 
12 | (to (canceling-fraction num den)
13 |   (let nr num.digits.range)
14 |   (let dr den.digits.range)
15 |   (may ((dr .difference nr) .keys)
16 |     (be `(,(? ~.positive? ddig))
17 |       (may ((nr .intersect dr) .keys)
18 |         (be `(,(? ~.positive?))
19 |           (may ((nr .difference dr) .keys)
20 |             (be `(,ndig)
21 |               (and (= (ratio<- ndig ddig) (let r (ratio<- num den)))
22 |                    (out .say "Found ~d\n" (ratio-show r))
23 |                    r))         
24 |             (else #no)))
25 |         (else #no)))
26 |     (else #no)))
27 | ;; TODO so much nesting and else-no's. We could use a bigger 'may' on all three
28 | ;; venn-diagram expressions at once, but that's slower with no short-circuiting.
29 | ;; Design better pattern-matching/control-flow constructs?
30 |   
31 | (let fractions (for yeahs [(pair ((11 .thru 99) .k-sets 2))]
32 |                  (canceling-fraction @pair)))
33 | (out .say "Product: ~d\n" (ratio-show (fold r* fractions (ratio<- 1))))
34 | 


--------------------------------------------------------------------------------
/examples/project-oiler/35.cant:
--------------------------------------------------------------------------------
 1 | ;; Circular primes
 2 | 
 3 | (import (use 'factoring) list-primes-till prime?)
 4 | 
 5 | (to (v1-answer max-ndigits)
 6 |   (for keep [(p (list-primes-till (10 .** max-ndigits)))]
 7 |     (-> p.text rotations ~.rest ||(every (compose prime? ~.number) it))))
 8 | 
 9 | ;; "abc" -> ("abc" "bca" "cab")
10 | (to (rotations xs)
11 |   ((chain xs xs.but-last) .k-slices xs.count))
12 | 
13 | ;; Faster version: only enumerate numbers using the digits 1,3,7,9.
14 | (to (v2-answer max-ndigits)
15 |   (link 2 5 (for gather [(ndigits (1 .thru max-ndigits))]
16 |               (for yeahs [(digits ("1379" .k-lists ndigits))]
17 |                 (and (-> digits.text rotations ||(every (compose prime? ~.number) it))
18 |                      digits.text.number)))))
19 | 
20 | ;;(let circulars (v1-answer 6))
21 | (let circulars (v2-answer 6))
22 | (out .say "circulars: ~w\n" (sort circulars))
23 | (out .print circulars.count) ;; 55
24 | 


--------------------------------------------------------------------------------
/examples/project-oiler/36.cant:
--------------------------------------------------------------------------------
 1 | ;; Double-base palindromes
 2 | 
 3 | ;; Find the sum of all numbers, less than one million, which are
 4 | ;; palindromic in base 10 and base 2.
 5 | 
 6 | (to (v1-answer max-ndigits)
 7 |   (let limit (10 .** max-ndigits))
 8 |   ;; Only check odd numbers: in binary an even palindrome would have to start with 0
 9 |   (keep double-palindrome? (1 .till limit 2)))
10 | 
11 | (to (double-palindrome? n)
12 |   (and (palindrome? n.digits)
13 |        (palindrome? (n .digits 2))))
14 | 
15 | ;; different from 04.cant...
16 | (to (palindrome? xs)
17 |   (= xs (reverse xs)))
18 | 
19 | ;; Faster way: enumerate palindromes in one base directly, and filter
20 | ;; for palindromes in the other base.
21 | (to (v2-answer max-ndigits)
22 |   (keep double-palindrome? (gather list-decimal-palindromes (1 .thru max-ndigits))))
23 | 
24 | (to (list-decimal-palindromes ndigits)
25 |   ;; N.B. some results are 'palindromes' only if you count leading
26 |   ;; 0's, so the above caller still checks for genuine palindromes.
27 |   (for gather [(mid (decimals .k-lists (ndigits .remainder 2)))]
28 |     (for each [(low (decimals .k-lists (ndigits .quotient 2)))]
29 |       (count<-digits (reverse low (chain mid low))))))
30 | 
31 | (let decimals (0 .thru 9))
32 | 
33 | ;;(out .print (v1-answer 6))
34 | (let answers (v2-answer 6))
35 | (out .print (sort answers.nub))
36 | (out .print (sum answers)) ;; 872187
37 | 


--------------------------------------------------------------------------------
/examples/project-oiler/38.cant:
--------------------------------------------------------------------------------
 1 | ;; Pandigital multiples
 2 | 
 3 | (import (use "utils") permuter<- detect)
 4 | 
 5 | ;; List permutations of 1..9 in descending order; return the first good one.
 6 | (to (v1-answer)
 7 |   ;; TODO we could just use the list.permutations method if it were lazy
 8 |   (let descending-perm (permuter<- (9 .down-thru 1)))
 9 |   (detect pandigital-multiple? (each$ descending-perm 9.!.till)))
10 | 
11 | (to (pandigital-multiple? digits)
12 |   (for some [(i '(1 2 3 4))]
13 |     (let n (count<-digits (digits .from 0 i)))
14 |     (do checking [(target (* 2 n)) (rest (digits .from i))]
15 |       (or rest.none?
16 |           (and (rest .prefix? (let td target.digits))
17 |                (checking (+ target n) (rest .from td.count)))))))
18 | 
19 | ;; Not so brute-force. For each possible base-prefix length, find the
20 | ;; first base prefix that works, trying prefixes in descending order.
21 | (to (v2-answer)
22 |   (max @(for yeahs [(length (1 .thru 4))]
23 |           (some ?build-pandigital ((9 .down-thru 1) .k-permutations length)))))
24 | 
25 | (to (?build-pandigital base-digits)
26 |   (let base (count<-digits base-digits))
27 |   (do building [(i 2) (prefix base-digits)]
28 |     (and (not (prefix .find? 0))
29 |          prefix.distinct?
30 |          (may (compare prefix.count 9)
31 |            (be '> #no)
32 |            (be '= prefix)
33 |            (be '< (building i.+1 (chain prefix ((* i base) .digits))))))))
34 | 
35 | ;;(let result (v1-answer))
36 | (let result (v2-answer))
37 | (out .print (count<-digits result)) ;; 932718654
38 | 


--------------------------------------------------------------------------------
/examples/project-oiler/40.cant:
--------------------------------------------------------------------------------
 1 | ;; Champernowne's constant
 2 | 
 3 | (to (answer)
 4 |   (to (champ index)
 5 | ;;    (hey (v1-champ index)
 6 |     (hey (v2-champ index)
 7 |          ||(out .say "~w: ~w\n" index it)))
 8 |   (* @(each champ
 9 |             (each (~ .power-of 10) (0 .thru 6)))))
10 | 
11 | ;; Super dumb but works.
12 | (let champ-digits (gather$ ~.digits 1.and-up))
13 | (to (v1-champ i) (champ-digits i.-1))
14 | 
15 | ;; Should be faster: champs are in a series of chunks:
16 | ;;    1 2 3 4 5 6 7 8 9    (length 1*9)
17 | ;;    10 11 ... 98 99      (length 2*90)
18 | ;;                         ...
19 | ;;    ...                  (length d*9*10^(d-1))
20 | (to (v2-champ index)
21 |   (surely (< 0 index))
22 |   (do skipping [(d 1) (i index)]
23 |     (let power (10 .** d.-1))         ;; The number starting this chunk
24 |     (let chunk-length (* d 9 power))  ;; How many digits in this chunk
25 |     (hm (when (<= i chunk-length)
26 |           (let (~ q r) (i.-1 ./mod d))
27 |           (let qth-number (+ power q))
28 |           (qth-number.digits r))
29 |         (else
30 |           (skipping d.+1 (- i chunk-length))))))
31 | 
32 | (out .print (answer)) ;; 210
33 | 


--------------------------------------------------------------------------------
/examples/project-oiler/41.cant:
--------------------------------------------------------------------------------
 1 | ;; Pandigital prime
 2 | 
 3 | (import (use 'factoring) prime?)
 4 | (import (use "utils") permuter<-)
 5 | 
 6 | (to (answer)
 7 |   (some find-largest-prime
 8 |         (for skip [(nd (9 .down-thru 1))] ;; n digits
 9 |           ((sum (1 .thru nd)) .even? 3)))) ;; Skip 'obvious' multiples of 3
10 |   
11 | (to (find-largest-prime nd)
12 |   ;; List permutations of 1..nd in decreasing order; return the first good one.
13 |   ;; TODO we could just use the list.permutations method if it were lazy
14 |   (let perm (permuter<- (nd .down-thru 1)))
15 |   ((~ .get 0) (keep$ prime? (each$ (compose count<-digits perm) nd.!.till))))
16 | 
17 | (out .print (answer)) ;; 7652413
18 | 


--------------------------------------------------------------------------------
/examples/project-oiler/42.cant:
--------------------------------------------------------------------------------
 1 | ;; Coded triangle numbers
 2 | 
 3 | (let line (with-input-file ~.read-line "examples/project-oiler/p042_words.comma.txt"))
 4 | (let words (line .split ","))
 5 | 
 6 | (to (answer)
 7 |   (tally-by triangle-word? words))
 8 | 
 9 | (to (triangle-word? text)
10 |   (triangle-number? (for sum-by [(rune text)]
11 |                       (surely rune.uppercase?)
12 |                       (- rune #\A.-1))))
13 | 
14 | 
15 | (to (triangle-number? n)
16 |   ((keep-while ||(<= it n) triangle-numbers)
17 |    .find? n))
18 | 
19 | (let triangle-numbers (amassing$ + 1 2.and-up))
20 | 
21 | (out .print (answer)) ;; 162
22 | 


--------------------------------------------------------------------------------
/examples/project-oiler/43.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'factoring) the-primes)
 2 | 
 3 | ;; We'll take a constraint-solver approach: find 3-digit tiles for
 4 | ;; each position which satisfy the divisor condition, then search for
 5 | ;; global solutions that fit the tiles together.
 6 | 
 7 | ;; Originally the tile-building phase also propagated the constraints
 8 | ;; from the leftward neighbors, but that was actually a bit slower.
 9 | 
10 | (let triples ((0 .thru 9) .k-permutations 3))
11 | (let tiles (~.array (for each [(p (link 1 (the-primes .prefix 7)))]
12 |                       (keep (compose (~ .even? p) count<-digits) triples))))
13 | 
14 | (let solutions
15 |   (for gather [(last-tile tiles.last)]
16 |     (do extending [(place (- tiles.count 2))
17 |                    (suffix last-tile)] ;; a partial solution from place+1 rightward
18 |       (hm (when (< place 0)
19 |             (out .say "found ~w\n" suffix)
20 |             `(,suffix))
21 |           (else
22 |             (let candidates (for yeahs [(t (tiles place))]
23 |                               (and (suffix .prefix? t.rest)
24 |                                    (not (suffix .find? t.first))
25 |                                    t.first)))
26 |             (for gather [(next-digit candidates.nub)]
27 |               (extending place.-1 (link next-digit suffix))))))))
28 | 
29 | (out .say "sum: ~w\n" (sum-by count<-digits solutions)) ;; 16695334890
30 | 


--------------------------------------------------------------------------------
/examples/project-oiler/README.md:
--------------------------------------------------------------------------------
 1 | Problems from a certain site that asks you not to post solutions. I'm
 2 | not complying, but to at least make this not gratuitously googleable,
 3 | I won't name the site. Let's say it sounds like "pro checked oiler".
 4 | 
 5 | If you find that site, then e.g. 01.cant corresponds to their problem
 6 | #1. I would normally copy the problem statements as comments for each
 7 | file, but see above.
 8 | 
 9 | Obviously, if you want to try the problems yourself, skip these files
10 | for spoilers.
11 | 


--------------------------------------------------------------------------------
/examples/project-oiler/utils.cant:
--------------------------------------------------------------------------------
 1 | (to (permuter<- xs)
 2 |   (let n xs.count)
 3 |   (let x<-digit xs.array)
 4 |   (on (k)
 5 |     (each x<-digit (lex-permutation n k))))
 6 | 
 7 | (to (lex-permutation n i)
 8 |   (let result (flexarray<-))
 9 |   (let digit-supply (flexarray<-list n.till))
10 |   (for each! [(pos (i .digits (n .down-thru 1) n))]
11 |     (result .push! (digit-supply .pop! pos)))
12 |   result.values)
13 | 
14 | (do [] ;; Quickie test
15 |   (let N 4)
16 |   (let lex-perm-naive (sort N.till.permutations))
17 |   (for each! [(i N.!.till)]
18 |     (surely (= (lex-perm-naive i) (lex-permutation N i)))))
19 | 
20 | "Here's how it should go for N=3:
21 | 
22 | i   out       mixradix
23 |               *2 *1
24 | 0   0 1 2      0  0
25 | 1   0 2 1      0  1
26 | 2   1 0 2      1  0
27 | 3   1 2 0      1  1
28 | 4   2 0 1      2  0
29 | 5   2 1 0      2  1
30 | "
31 | 
32 | ;; (detect ~.even? '(3 1 4 1 5 9 2 6)) = 4
33 | ;; TODO is this worth it? sometimes what you want is the yeahs equivalent
34 | ;; TODO #no if not found?
35 | (to (detect keep? xs)
36 |   ((keep$ keep? xs) .first))
37 | 
38 | (export permuter<- lex-permutation detect)
39 | 


--------------------------------------------------------------------------------
/examples/refactoring/search-for-list-pats.cant:
--------------------------------------------------------------------------------
 1 | ;; OK, let's get an idea what search-cant-code should look like,
 2 | ;; from an actual application: finding instances of the pattern syntax
 3 | ;; I'm about to outlaw. I.e., patterns like (a b) instead of `(,a ,b).
 4 | 
 5 | (import (use 'cant-source-walker)
 6 |   expr-subparts patt-subparts macroexpand-outer-patt)
 7 | 
 8 | (import (use 'pretty-print) pp<-)
 9 | (let pp (pp<- (export out)))
10 | 
11 | (to (main `(,_ ,@filenames))
12 |   (each! report-badness filenames))
13 | 
14 | (to (report-badness filename)
15 | ;;  (out .say "Checking ~d...\n" filename)
16 |   (may (keep bad-expr? (with-input-file read-all filename))
17 |     (be '() 'ok)
18 |     (be top-level-bad-exprs
19 |       (out .say "In ~d these top-level expressions harbor badness:\n" filename)
20 |       (each! pp top-level-bad-exprs)
21 |       out.newline)))
22 | 
23 | (to (bad-expr? expr)
24 |   (bad-part? (expr-subparts expr)))
25 | 
26 | (to (bad-part? `(,subexprs ,subpatts))
27 |   (or (some bad-expr? subexprs)
28 |       (some bad-patt? subpatts)))
29 | 
30 | (to (bad-patt? patt)
31 |   (may (macroexpand-outer-patt patt)
32 |     (be (-- `(,s ,@_) (unless (patt-keywords .find? s)))
33 |       (out .say "This subpattern is bad: ~w\n" patt)
34 |       #yes)
35 |     (be p (bad-part? (patt-subparts p)))))
36 | 
37 | (let patt-keywords (link "@".symbol  ; XXX ugh c'mon there must be a better way
38 |                          '(~ list<- link quote -- -> when unless quasiquote)))
39 | 
40 | (export main bad-expr? bad-patt?)
41 | 


--------------------------------------------------------------------------------
/examples/rosetta-code/floyd-triangle.cant:
--------------------------------------------------------------------------------
 1 | ;; https://rosettacode.org/wiki/Floyd%27s_triangle
 2 | ;; "List the natural numbers in a right triangle aligned to the left where
 3 | ;;  * the first row is 1 (unity)
 4 | ;;  * successive rows start towards the left with the next number
 5 | ;;    followed by successive naturals listing one more number than the
 6 | ;;    line above."
 7 | 
 8 | (to (floyd-triangle n-rows)
 9 |   (let rows (flexarray<-))
10 |   (do loop [(r 1) (i 1)]
11 |     (when (<= r n-rows)
12 |       (rows .push! (each ~.text (i .span r)))
13 |       (loop r.+1 (+ i r))))
14 |   (let widths (each ~.count rows.last))
15 |   (for each! [(row rows.values)]
16 |     (out .displayln (" " .join (for each [((~ text width) (zip .ragged row widths))]
17 |                                  (text .pad-left width))))))
18 |     
19 | (floyd-triangle 5)
20 | (floyd-triangle 14)
21 | 


--------------------------------------------------------------------------------
/examples/rosetta-code/hundred-doors.cant:
--------------------------------------------------------------------------------
 1 | ;; https://rosettacode.org/wiki/100_doors
 2 | 
 3 | ;; Return the numbers of the doors that are open at the end.
 4 | (to (doors-puzzle)
 5 |   (let doors (1 .thru 100))
 6 |   (let open? (!map-by ||#no doors))
 7 |   (for each! [(stride doors)]
 8 |     (for each! [(door (stride .thru 100 stride))]
 9 |       (open? .update door not)))
10 |   (keep open? doors))
11 | 
12 | (out .print (doors-puzzle))
13 | 


--------------------------------------------------------------------------------
/examples/rosetta-code/jewels-and-stones.cant:
--------------------------------------------------------------------------------
1 | ;; https://rosettacode.org/wiki/Jewels_and_Stones
2 | 
3 | (to (count-jewels stones jewels)
4 |   (tally-by ||(jewels .find? it) stones))
5 | 
6 | (out .print (count-jewels "aAAbbbb" "aA"))
7 | (out .print (count-jewels "ZZ" "z"))
8 | 


--------------------------------------------------------------------------------
/examples/squickcheck-examples.cant:
--------------------------------------------------------------------------------
 1 | (import ((use 'squickcheck) (export out))
 2 |   a-count an-int a-list-of
 3 |   all should  ;; I dunno what to call it yet
 4 |   )
 5 | 
 6 | (for all [(a an-int) (b an-int)]
 7 |   ;; Ints are commutative.
 8 |   (should = (+ a b) (+ b a)))
 9 | 
10 | ;; A deliberately failing property:
11 | 
12 | (for all [(L (a-list-of a-count))]
13 |   ;; Lists are palindromic (not!)
14 |   (should = L (reverse L)))
15 | 


--------------------------------------------------------------------------------
/examples/squirm/README.md:
--------------------------------------------------------------------------------
1 | An Erlang-inspired Lisp.
2 | 
3 | To run this from the main Cant directory:
4 | 
5 | `$ incant examples/squirm/squirm.cant examples/squirm/examples/hello.squirm`
6 | 
7 | (The code in `squirm-interpreter.cant` currently has a couple of
8 | hard-coded paths relative to that main directory.)
9 | 


--------------------------------------------------------------------------------
/examples/squirm/examples/hello.squirm:
--------------------------------------------------------------------------------
1 | ;; -*- cant -*-
2 | 
3 | (to (main)
4 |   (let parent (me))
5 |   (spawn (on ()
6 |            (! parent "Hello, Mother!")))
7 |   (? (greeting (print greeting))))
8 | 


--------------------------------------------------------------------------------
/examples/squirm/examples/mutex.squirm:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | ;; exports: start stop wait signal
 4 | 
 5 | ;; This example is interesting in that the state I'd at first think of
 6 | ;; as naturally living in the server processs (i.e. the list of
 7 | ;; processes waiting on the mutex) is not represented in the server
 8 | ;; loop's state arguments -- it's implicit in the process mailbox
 9 | ;; instead.
10 | 
11 | (to (main)
12 |   (start)
13 |   (spawn (on ()
14 |            (wait)
15 |            (signal)))
16 |   (wait)
17 |   (signal)
18 |   ;; TODO more
19 |   (print "done"))
20 | 
21 | (to (start)
22 |   (register 'mutex (spawn free)))
23 | 
24 | (to (stop)
25 |   (! 'mutex 'stop))
26 | 
27 | (to (wait)
28 |   (! 'mutex ['wait (me)])
29 |   (? ('ok 'ok)))
30 | 
31 | (to (signal)
32 |   (! 'mutex ['signal (me)])
33 |   'ok)
34 | 
35 | (to (free)
36 |   (? (['wait pid]
37 |       (! pid 'ok)
38 |       (? (['signal (: pid)]
39 |           (free))))
40 |      ('stop
41 |       (begin killing []
42 |         (? (['wait pid]
43 |             (exit pid 'kill)
44 |             (killing))
45 |            ((after 0)
46 |             'ok))))))
47 | 


--------------------------------------------------------------------------------
/examples/squirm/examples/universal_server.squirm:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | ;; https://joearms.github.io/published/2013-11-21-My-favorite-erlang-program.html
 4 | 
 5 | (to (main)
 6 |   (print (test)))
 7 | 
 8 | (to (universal-server)
 9 |   (? (['become f]
10 |       (f))))
11 | 
12 | (to (factorial-server)
13 |   (? ([from n]
14 |       (! from (factorial n))
15 |       (factorial-server))))
16 | 
17 | (to (factorial n)
18 |   (if (= n 0) 1 (* n (factorial (- n 1)))))
19 | 
20 | (to (test)
21 |   (let pid (spawn universal-server))
22 |   (! pid ['become factorial-server])
23 |   (! pid [(me) 10])
24 |   (? (x x)))
25 | 


--------------------------------------------------------------------------------
/examples/squirm/library/foo.cant:
--------------------------------------------------------------------------------
1 | (to (bar x) (* 2 x))
2 | 


--------------------------------------------------------------------------------
/examples/squirm/prelude.squirm:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | ;; Squirm code, not Cant. These definitions go into the global
 4 | ;; environment.
 5 | 
 6 | (to ((compose f g) x)  ;; TODO varargs
 7 |   (f (g x)))
 8 | 
 9 | (to (some ok? xs)
10 |   (and (not (nil? xs))
11 |        (or (ok? (first xs))
12 |            (some ok? (rest xs)))))
13 | 
14 | (to (every ok? xs)
15 |   (or (nil? xs)
16 |       (and (ok? (first xs))
17 |            (every ok? (rest xs)))))
18 | 
19 | (to (each! f xs)
20 |   (unless (nil? xs)
21 |     (f (first xs))
22 |     (each! f (rest xs))))
23 | 
24 | (to (gather f xs)
25 |   (for foldr [(x xs) (ys '())]
26 |     (chain (f x) ys)))
27 | 
28 | (to (keep ok? xs)
29 |   (for foldr [(x xs) (ys '())]
30 |     (if (ok? x) (link x ys) ys)))
31 | 
32 | (to (yeahs f xs)             ;TODO better name?
33 |   (keep itself (each f xs)))
34 | 
35 | (to (foldl f z xs)
36 |   (if (nil? xs)
37 |       z
38 |       (foldl f (f z (first xs)) (rest xs))))
39 | 
40 | (to (foldr f xs z)     ;TODO rename since args are in nonstandard order
41 |   (if (nil? xs)
42 |       z
43 |       (f (first xs) (foldr f (rest xs) z))))
44 | 
45 | (to (foldr1 f xs)
46 |   (let tail (rest xs))
47 |   (if (nil? tail)
48 |       (first xs)
49 |       (f (first xs) (foldr1 f tail))))
50 | 
51 | (to (each f xs)
52 |   (for foldr [(x xs) (ys '())]
53 |     (link (f x) ys)))
54 | 
55 | (to (surely ok? msg)
56 |   (unless ok?
57 |     (exit msg)))
58 | 


--------------------------------------------------------------------------------
/examples/squirm/squirm.cant:
--------------------------------------------------------------------------------
 1 | (import ((use "squirm-interpreter")
 2 |          (export nano-now
 3 |                  nanosleep
 4 |                  out
 5 |                  with-input-file
 6 |                  catch-oops))
 7 |   run-file)
 8 | 
 9 | (to (main argv)
10 |   (let `(,_ ,filename) argv)
11 |   (run-file filename))
12 | 


--------------------------------------------------------------------------------
/examples/squirm/test/error-test.squirm:
--------------------------------------------------------------------------------
1 | ;; -*- cant -*-
2 | 
3 | (to (main)
4 |   (print 0)
5 |   (print (catch
6 |           (print "yo")
7 |           (+ 'baloney 42)
8 |           (print "ho"))))
9 | 


--------------------------------------------------------------------------------
/examples/squirm/test/mod-test.squirm:
--------------------------------------------------------------------------------
1 | ;; -*- cant -*-
2 | 
3 | (to (main)
4 |   (module-load 'silly "examples/squirm/test/silly.squirm")
5 |   (silly:billy 137))
6 | 


--------------------------------------------------------------------------------
/examples/squirm/test/monitor-test.squirm:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | (to (main)
 4 |   (print 0)
 5 |   (let pid (spawn screw-around))
 6 |   (monitor pid)                         ;does erlang have a spawn_monitor BIF?
 7 |   (? (msg (print "got it")
 8 |           (print msg))))
 9 | 
10 | (to (screw-around)
11 |   (print "yo")
12 |   (throw "and a bottle of rum")
13 |   (print "ho"))
14 | 


--------------------------------------------------------------------------------
/examples/squirm/test/partner-test.squirm:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | ;; TODO more tests
 4 | (to (main)
 5 |   (print 0)
 6 |   (let pid (spawn-partner screw-around))
 7 |   (? (msg (print "got it")
 8 |           (print msg))))
 9 | 
10 | (to (screw-around)
11 |   (print "yo")
12 |   (throw "and a bottle of rum")
13 |   (print "ho"))
14 | 


--------------------------------------------------------------------------------
/examples/squirm/test/quasiquote-test.squirm:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | (to (main)
 4 |   (let d 7)
 5 |   (let f 11)
 6 |   (print `(a b [c ,d] e ,@f))
 7 |   (let `(x [,u] ,@v) '(x [hey] jude))
 8 |   (print u)
 9 |   (print v)
10 |   )
11 | 


--------------------------------------------------------------------------------
/examples/squirm/test/recur-test.squirm:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | (to (main)
 4 | ;  (to ((compose f g) x)  ;; TODO varargs
 5 | ;    (f (g x)))
 6 |   (print ((compose not nil?) '()))
 7 |   (print (do (define
 8 |                (to (even? n) (or (= n 0) (odd? (- n 1))))
 9 |                (to (odd? n)  (and (< 0 n) (even? (- n 1)))))
10 |              (odd? 7))))
11 | 


--------------------------------------------------------------------------------
/examples/squirm/test/silly.squirm:
--------------------------------------------------------------------------------
1 | ;; -*- cant -*-
2 | 
3 | (to (main)
4 |   (billy 3))
5 | 
6 | (to (billy n)
7 |   (print (foo:bar 21))
8 |   (print (/ 1 n)))
9 | 


--------------------------------------------------------------------------------
/examples/squirm/test/smoke-test.squirm:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | (to (main)
 4 |   (let negative #no)
 5 |   (print negative)
 6 |   (let pid (spawn (on ()
 7 |                     (report (or #no "hey"))
 8 |                     (report "dud")
 9 |                     (! (me) 'not-this)
10 |                     (? ('not-this (report "not this")))
11 |                     (? (msg (report ['got msg])))
12 |                     (report "dude")
13 |                     (report (factorial 15)))))
14 |   (report ['pid pid])
15 |   ((eval '!) pid 'yoohoo)
16 |   (report (apply factorial '(10)))
17 |   (report (be pid
18 |             ('42 'nope)
19 |             ((: factorial) 'nope-nope)
20 |             ((: pid) 'yep))))
21 | 
22 | (to (report x)
23 |   (print [(me) x]))
24 | 
25 | (to (factorial n)
26 |   (be n
27 |     (0 1)
28 |     (~ (let x (factorial (- n 1)))
29 |        (* n x))))
30 | 


--------------------------------------------------------------------------------
/examples/squirm/test/throw-test.squirm:
--------------------------------------------------------------------------------
 1 | ;; -*- cant -*-
 2 | 
 3 | (to (main)
 4 |   (print 0)
 5 |   (spawn (on ()
 6 |            (print (catch
 7 |                    (print 1)
 8 |                    (throw 2)
 9 |                    (print 3)))
10 |            (print 4)
11 |            (throw 5)
12 |            (print 6)))
13 |   (print 7))
14 | 


--------------------------------------------------------------------------------
/examples/squirm/test/timeout-test.squirm:
--------------------------------------------------------------------------------
1 | ;; -*- cant -*-
2 | 
3 | (to (main)
4 |   (print 0)
5 |   (? (msg (print "got 1"))
6 |      ((after 50) (print "after delay")))
7 |   (print "done"))
8 | 


--------------------------------------------------------------------------------
/examples/terminal/echo.cant:
--------------------------------------------------------------------------------
 1 | ;; To check how sturm interprets your keystrokes.
 2 | ;; We quit on Q instead of the escape key because there are still
 3 | ;; unmapped keys with escape sequences.
 4 | 
 5 | (import ((use 'sturm) (export console))
 6 |   cbreak-mode get-key render cursor screen-width)
 7 | (import (use 'text-wrap)
 8 |   fill)
 9 | 
10 | (to (main _)
11 |   (cbreak-mode run))
12 | 
13 | (to (run)
14 |   (let strokes (flexarray<-))
15 |   (do loop []
16 |     (let echoes (fill (" " .join strokes.values) screen-width))
17 |     (render ["Hit some keys; capital Q to quit.\n\n"
18 |              echoes cursor])
19 |     (unless (= #\Q (let key (get-key)))
20 |       (strokes .push! ("~w" .format key))
21 |       (loop))))
22 | 
23 | (export main run)
24 | 


--------------------------------------------------------------------------------
/examples/text/anagram-words.cant:
--------------------------------------------------------------------------------
 1 | ;; Find all anagram equivalence classes among the dictionary words.
 2 | 
 3 | (import (use 'binary-relations) collect)
 4 | 
 5 | (to (collect-anagrams words)
 6 |   (keep ~.plural? (group-by sort words)))
 7 | 
 8 | ;; (It's ugly that collect wraps and then group-by unwraps. But collect
 9 | ;; does seem more generally useful. What to do?
10 | ;; Maybe rename to group-by and group-items? As list methods instead of functions?
11 | ;; Make this stuff part of a broader support for relational algebra?)
12 | (to (group-by key<- xs)
13 |   (each (~ .part 1) (collect (for each [(x xs)]
14 |                                (~ (key<- x) x)))))
15 | 
16 | (let anagrams
17 |   (collect-anagrams (with-input-file ~.read-lines "/usr/share/dict/words")))
18 | 
19 | ;; Sort order: how many anagrams, length of each word, then alphabetical.
20 | (for each! [(group (sort-by ||`(,it.count ,it.first.count ,it)
21 |                             anagrams))]
22 |   (out .say "~d\n" (" " .join group)))
23 | 


--------------------------------------------------------------------------------
/examples/text/kwic.cant:
--------------------------------------------------------------------------------
 1 | ;; Generate a "Key-Word In Context" index.
 2 | ;; TODO:
 3 | ;;   show line numbers?
 4 | ;;   skip stopwords
 5 | ;;   reread Parnas
 6 | ;;     y'know, the rotated outputs he describes are probably more useful
 7 | 
 8 | (import (use 'binary-relations) collect)
 9 | (import (use 'parson) like)
10 | 
11 | ;; From stdin to stdout.
12 | (to (main _)
13 |   (kwic in.read-lines))
14 | 
15 | ;; Write a sorted keyword-in-context index.
16 | (to (kwic lines)
17 |   (each! show-group (sort (collect (gather contextify lines)))))
18 | 
19 | ;; (contextify "leaves of grass")
20 | ;; -> '({~ "leaves" {~ "leaves of grass" (0 6)}}  ;; where (0 6) is the span of the first word
21 | ;;      {~ "of"     {~ "leaves of grass" (7 9)}}
22 | ;;      {~ "grass"  {~ "leaves of grass" (10 15)}})
23 | (to (contextify line)
24 |   (for each [(span (word-spans line))]
25 |     (let word (line .from @span))
26 |     (~ word.lowercase (~ line span))))
27 | 
28 | ;; A crude notion of a word: a string of letters with an optional
29 | ;; apostrophized suffix. Yield the positions (start end) for each word.
30 | (let word-spans
31 |   (like "([:position :letter+ ('\\'' :letter+)? :position :list] | :skip)*"))
32 | ;; TODO ugly: '\\''
33 | 
34 | ;; Under a heading for `word`, show each of its occurrences.
35 | (to (show-group (~ word occurrences))
36 |   (out .say "~d:\n" word)
37 |   (for each! [((~ line `(,start ,end)) (sort occurrences))]
38 |     (out .say "  ~d**~d**~d\n"
39 |          (line .from 0 start)
40 |          (line .from start end)
41 |          (line .from end))))
42 | 


--------------------------------------------------------------------------------
/examples/text/most-common.cant:
--------------------------------------------------------------------------------
 1 | ;; Print the N most frequent words from standard input, in descending
 2 | ;; order, with their frequencies. N may be set from the command line.
 3 | 
 4 | (import (use 'format-tables) format-table)
 5 | 
 6 | (to (main args)
 7 |   (let N (may args.rest
 8 |            (be '()
 9 |              10)    ; default
10 |            (be `(,(-> ~.?number (? yeah? number)))
11 |              number)
12 |            (else (err .say "usage: ~d [number]\n" (args 0))
13 |                  (os-exit 1))))
14 | 
15 |   (-> in.read-all.lowercase scan-words bag<- (~ .most-common N)
16 |       ||(format-table (each ~.parts it))
17 |       ||(out .display-lines it)))
18 | 
19 | (import (use 'parson) like)
20 | (let scan-words (like "({:letter+} | :skip)*"))
21 | 


--------------------------------------------------------------------------------
/examples/text/spelling.train.text:
--------------------------------------------------------------------------------
1 | i am a lousy speller
2 | i am truly a lousy speller
3 | i am not a lousy speller so there
4 | 


--------------------------------------------------------------------------------
/incant:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 | 
3 | # https://stackoverflow.com/a/11114547
4 | export CANT_DIR=$(dirname "$(realpath "${BASH_SOURCE[0]}")")
5 | 
6 | scheme --libdirs "${CANT_DIR}:" --program ${CANT_DIR}/cant.scm "$@"
7 | 


--------------------------------------------------------------------------------
/library/ansi-terminal.cant:
--------------------------------------------------------------------------------
 1 | ;; ANSI terminal control
 2 | ;; TODO factor wrt sturm
 3 | 
 4 | (let prefix (text<- (rune<- 27) #\[)) ;TODO more text escape sequences
 5 | 
 6 | (to (seq text) (chain prefix text))
 7 | 
 8 | (let home               (seq "H"))
 9 | (let clear-to-bottom    (seq "J"))
10 | (let clear-screen       (chain prefix "2J" home))  ;XXX don't actually need `home`, right?
11 | (let clear-to-right     (seq "K"))
12 | 
13 | (let cursor-pos-save    (seq "s"))
14 | (let cursor-pos-restore (seq "u"))
15 | 
16 | (let cursor-show        (seq "?25h"))
17 | (let cursor-hide        (seq "?25l"))
18 | 
19 | (to (goto x y)
20 |   (chain prefix y.+1.text ";" x.+1.text "H"))
21 | 
22 | (let [black red green yellow blue magenta cyan white]
23 |   ((0 .thru 7) .array))        ;TODO wish we didn't have to convert
24 | 
25 | (to (bright color)
26 |   (+ 60 color))
27 | 
28 | (to (sgr num)
29 |   (seq num.text "m"))
30 | 
31 | (to (set-foreground color) (sgr (+ 30 color)))
32 | (to (set-background color) (sgr (+ 40 color)))
33 | 
34 | (export
35 |   home
36 |   clear-to-bottom
37 |   clear-screen
38 |   clear-to-right
39 |   cursor-pos-save
40 |   cursor-pos-restore
41 |   cursor-show
42 |   cursor-hide
43 |   goto 
44 |   black red green yellow blue magenta cyan white
45 |   bright
46 |   set-foreground
47 |   set-background)
48 | 


--------------------------------------------------------------------------------
/library/binary-relations.cant:
--------------------------------------------------------------------------------
 1 | ;; Making this into a silly one-function library for now.
 2 | 
 3 | ;; Given a list of (~ key value), return a list of (~ key all-values).
 4 | (to (collect items)
 5 |   (let map (!map<-))
 6 |   (for each! [((~ key value) items)]
 7 |     ((map .get-set! key flexarray<-) .push! value))
 8 |   (for each [((~ key array) map.items)]
 9 |     (~ key array.values)))
10 | 
11 | (export collect)
12 | 


--------------------------------------------------------------------------------
/library/complex.cant:
--------------------------------------------------------------------------------
 1 | ;; Complex numbers
 2 | ;; TODO selfless objects so that complex numbers can have methods
 3 | ;; TODO design automatic coercions with built-in real numbers
 4 | 
 5 | (to (conjugate {complex x y})
 6 |   {complex x (- y)})
 7 | 
 8 | (to (c-abs^2 {complex x y})
 9 |   (+ (* x x) (* y y)))
10 | 
11 | (to (c-abs c)
12 |   (~.sqrt (c-abs^2 c)))
13 | 
14 | (to (r*c scale {complex x y})
15 |   {complex (* scale x)
16 |            (* scale y)})
17 | 
18 | (to (c+ {complex x1 y1} {complex x2 y2})
19 |   {complex (+ x1 x2)
20 |            (+ y1 y2)})
21 | 
22 | (to (c- {complex x1 y1} {complex x2 y2})
23 |   {complex (- x1 x2)
24 |            (- y1 y2)})
25 | 
26 | (to (c* {complex x1 y1} {complex x2 y2})
27 |   {complex (- (* x1 x2) (* y1 y2))
28 |            (+ (* x1 y2) (* y1 x2))})
29 | 
30 | (to (c/ c1 c2)
31 |   (c* c1 (reciprocal c2)))
32 | 
33 | (to (reciprocal c)   ;;TODO call this (c/ c) ?
34 |   (r*c (/ (c-abs^2 c))
35 |        (conjugate c)))
36 | 
37 | ;; TODO fancier syntax for 'export' with renaming. Or just plain map literals.
38 | (export conjugate
39 |         c-abs^2
40 |         c-abs
41 |         r*c
42 |         c+
43 |         c-
44 |         c*
45 |         c/
46 |         )
47 | 


--------------------------------------------------------------------------------
/library/format-tables.cant:
--------------------------------------------------------------------------------
 1 | ;; Lay out a plain-text table; also tabulate texts into columns.
 2 | ;; Based on github.com/darius/columnize
 3 | 
 4 | ;; Given a list of rows, each a list of things, return a list of lines.
 5 | ;; Each line is the corresponding row displayed as texts joined by
 6 | ;; `spacer`, with each column padded to its max width.
 7 | ;; TODO right-justify numeric columns, or parameterize justification by column
 8 | (to (format-table rows-of-things @(optional ?spacer ?justify))
 9 |   (let rows (each ||(each text-display it.values) rows-of-things.values))
10 |   (let spacer  (or ?spacer  " "))
11 |   (let justify (or ?justify ('.pad-right .method)))
12 |   (surely (rows .unique? ~.count) "Rows must be the same length" rows)
13 |   (let widths (for each [(column (transpose rows))]
14 |                 (max @(each ~.count column))))
15 |   (for each [(row rows)]
16 |     (spacer .join (each justify row widths))))
17 | 
18 | (to (text-display thing)
19 |   (text<-writer (~ .display thing)))
20 | 
21 | ;; Given a sequence of texts, return a matrix of the same texts in
22 | ;; column order, trying to fit them in the given width.
23 | (to (tabulate texts @(optional ?width))
24 |   (let width (or ?width 79))
25 |   (let max-width (+ 2 (max 0 @(each ~.count texts))))
26 |   (let n-cols (max 1 (min texts.count (width .quotient max-width))))
27 |   (let n-rows (max 1 ((+ texts.count n-cols -1) .quotient n-cols)))
28 |   (let padded (texts .pad-right (* n-rows n-cols) ""))
29 |   (transpose (padded .segments n-rows)))
30 | 
31 | (export format-table tabulate)
32 | 


--------------------------------------------------------------------------------
/library/memoize.cant:
--------------------------------------------------------------------------------
1 | ;; Return a memoized version of a function
2 | 
3 | (to (memoize f)
4 |   (let memos (!map<-))
5 |   (to (memoized @arguments)
6 |     (memos .get-set! arguments ($ (f @arguments)))))
7 | 
8 | (export memoize)
9 | 


--------------------------------------------------------------------------------
/library/minikanren.cant:
--------------------------------------------------------------------------------
 1 | ;; The embedded logic language. XXX unfinished untested
 2 | 
 3 | (import (use 'unify) unify)
 4 | 
 5 | (to (fail s)
 6 |   '())
 7 | 
 8 | (to (succeed s)
 9 |   `(,s))
10 | 
11 | (to ((== val1 val2) s)
12 |   (may (unify s val1 val2)
13 |     (be #no '())
14 |     (be s1 `(,s1))))
15 | 
16 | ;; XXX either and both are not quite Kanrenish
17 | 
18 | (to ((either goal1 goal2) s)
19 |   (interleave (goal1 s) (goal2 s)))
20 | 
21 | ;; TODO: probably ought to be lazy in the head as well as the tail
22 | (to (interleave xs ys)
23 |   (if xs.none?
24 |       ys
25 |       (link$ xs.first
26 |              ($ (interleave ys xs.rest)))))
27 | 
28 | (to ((both goal1 goal2) s)
29 |   (gather$ goal2 (goal1 s)))        ;XXX add interleaving here too?
30 | 
31 | (export fail succeed == either both)
32 | 


--------------------------------------------------------------------------------
/library/queue.cant:
--------------------------------------------------------------------------------
 1 | ;; Functional queues.
 2 | ;; Sequences with first-in-first-out addition and removal.
 3 | 
 4 | ;; The pair {queue left right} represents the sequence (chain left
 5 | ;; (reverse right)). Elements are removed on the left and added on the
 6 | ;; right. The representation is split this way for amortized efficiency.
 7 | 
 8 | ;; (Called h and t for head and tail, below, because lowercase 'l'
 9 | ;; would be hard to read. TODO would tail and head make better
10 | ;; terminology? -- so the names are backwards now? Sigh.)
11 | 
12 | (let empty {queue '() '()})
13 | 
14 | (to (empty? {queue h t})
15 |   (and h.none? t.none?))
16 | 
17 | (to (push {queue h t} element)
18 |   {queue h (link element t)})
19 | 
20 | (to (extend {queue h t} elements)
21 |   {queue h (reverse elements t)})
22 | 
23 | (to (peek {queue h t})
24 |   (hm (if h.some?
25 |         {nonempty h.first {queue h.rest t}})
26 |       (if t.none?
27 |         {empty})
28 |       (else
29 |         (let seq (reverse t))
30 |         {nonempty seq.first {queue seq.rest '()}})))
31 | 
32 | (to (list<-queue {queue h t})
33 |   (chain h (reverse t)))
34 | 
35 | (export
36 |   empty empty?
37 |   push extend
38 |   peek list<-queue)
39 | 


--------------------------------------------------------------------------------
/library/regex-parse.cant:
--------------------------------------------------------------------------------
 1 | ;; Parse regular expressions
 2 | 
 3 | (import (use 'parson) feed push grammar<-)
 4 | 
 5 | ;; TODO: something like Python's raw string literals. \\\\ is awful.
 6 | (let grammar (grammar<- "
 7 | regex    :  exp :end.
 8 | exp      :  term ('|' exp     :either)*
 9 |          |                    :empty.
10 | term     :  factor (term      :then)*.
11 | factor   :  primary (  '*'    :star
12 |                      | '+'    :plus
13 |                      | '?'    :maybe
14 |                     )?.
15 | primary  :  '(' exp ')'
16 |          |  '[' rune* ']'     :join :oneof
17 |          |  '.'               :dot
18 |          |  '\\\\' {1}        :literal
19 |          |  !( '.' | '(' | ')'
20 |              | '*' | '+' | '?'
21 |              | '|' | '[' | ']')
22 |             {1}               :literal.
23 | rune     :  '\\\\' {1}
24 |          |  !']' {1}.
25 | "))
26 | 
27 | (to (regex-parser<- builder)
28 |   (let semantics
29 |     (map<- (~ 'empty   (push (builder 'empty)))
30 |            (~ 'literal (feed (builder 'literal)))
31 |            (~ 'star    (feed (builder 'star)))
32 |            (~ 'then    (feed (builder 'then)))
33 |            (~ 'either  (feed (builder 'either)))
34 |            (~ 'plus    (feed (builder 'plus)))
35 |            (~ 'maybe   (feed (builder 'maybe)))
36 |            (~ 'oneof   (feed (builder 'one-of)))
37 |            (~ 'dot     (push (builder 'anyone)))))
38 |   (let parser ((grammar semantics) 'regex))
39 |   (to (parse-regex text)
40 |     ((parser .parse-outcome text) .result)))
41 | 
42 | (export regex-parser<-)
43 | 


--------------------------------------------------------------------------------
/library/roman.cant:
--------------------------------------------------------------------------------
 1 | ;; Roman numerals
 2 | ;; TODO: expose as a parson grammar, too?
 3 | 
 4 | (to (number<-roman text)
 5 |   (let values (each value<-rune text.uppercase))
 6 |   (for sum-by [(value `(0 ,@values)) (next-value `(,@values 0))]
 7 |     ;; Each letter goes into the sum either negatively or positively,
 8 |     ;; depending on the next letter. E.g. X in "XC" means -10, not 10.
 9 |     ((if (< value next-value) - +) value)))
10 | 
11 | (let value<-rune
12 |   (map<-lists '((#\M 1000) (#\D 500) (#\C 100) (#\L 50) (#\X 10) (#\V 5) (#\I 1))))
13 | 
14 | (to (roman<-number n)
15 |   (surely (and (count? n) n.positive?))
16 |   (for amass [(roman "") (digit n.digits)]
17 |     (chain (text-by rune*10 roman) (roman<-digit digit))))  ;; TODO not quadratic
18 | 
19 | (let roman<-digit (~.array (" I II III IV V VI VII VIII IX" .split " ")))
20 | (let rune*10 (map<-items (zip "IVXLC"
21 |                               "XLCDM")))
22 | 
23 | (export number<-roman roman<-number)
24 | 


--------------------------------------------------------------------------------
/library/sort.cant:
--------------------------------------------------------------------------------
 1 | ;; Generic sorting
 2 | 
 3 | (make sort
 4 |   (to (~ xs)
 5 |     (sort-by itself xs))
 6 |   (to (~ xs {reverse})          ;TODO design a better keyword-args scheme
 7 |     ;; TODO sort by 'negation' of key instead, but allowing for
 8 |     ;; non-numbers. Make up a negation-wrapper type?
 9 |     (reverse (sort-by itself xs))) 
10 |   ;; ...
11 |   )
12 | 
13 | (to (sorted? xs)
14 |   (or xs.none?
15 |       (do checking [(x xs.first) (xs xs.rest)]
16 |         (or xs.none?
17 |             (and (<= x xs.first)
18 |                  (checking xs.first xs.rest))))))
19 | 
20 | (to (sort-by key<- sequence)
21 |   ;; Merge sort  (TODO make stable)
22 |   (do sorting [(seq sequence)]
23 |     (do splitting [seq (xs '()) (ys '())]
24 |       (hm (if seq.some? (splitting seq.rest ys (link seq.first xs)))
25 |           (if xs.none?  ys) ; (already sorted since ys.count <= 1 in this case)
26 |           (else         (merge-by key<- (sorting xs) (sorting ys)))))))
27 | 
28 | (to (merge-by key<- xs ys)
29 |   (hm (if xs.none? ys)
30 |       (if ys.none? xs)
31 |       (if (<= (key<- xs.first) (key<- ys.first))
32 |         (link xs.first (merge-by key<- xs.rest ys)))
33 |       (else
34 |         (link ys.first (merge-by key<- xs ys.rest)))))
35 | 
36 | (to (merge xs ys)
37 |   (merge-by itself xs ys))
38 | 
39 | (export
40 |   sort sort-by sorted? merge merge-by)
41 | 


--------------------------------------------------------------------------------
/player/abcs.scm:
--------------------------------------------------------------------------------
 1 | #!chezscheme
 2 | 
 3 | ;; Bring up the system with the rest of the runtime written in Cant,
 4 | ;; loading it into primordial-setting.
 5 | ;; (We assume abcs/00-primordia is already loaded.)
 6 | 
 7 | (library (player abcs)
 8 | (export load-abcs cant-interpret)
 9 | (import (chezscheme)
10 |   (player util)
11 |   (player read)
12 |   (player parse)
13 |   (player setting)
14 |   (player primordia)
15 |   (player player))
16 | 
17 | (define base-path (getenv "CANT_DIR"))
18 | 
19 | (define (run-load filename)
20 |   (unless base-path
21 |     (error 'run-load "CANT_DIR not set"))
22 |   (let ((forms (snarf (string-append base-path "/" filename) cant-read)))
23 |     (cant-interpret `(so ,@forms))))
24 | 
25 | ;; TODO add setting & optional context
26 | (define (cant-interpret e)
27 |   (evaluate (parse-exp e) primordial-setting))
28 | 
29 | (define (load-abcs)
30 |   (run-load "abcs/20-cant.cant")
31 |   (run-load "abcs/21-sequels.cant")
32 |   (run-load "abcs/30-functions.cant")
33 |   (run-load "abcs/40-library.cant")
34 |   (run-load "abcs/50-top.cant")
35 |   (cant-interpret
36 |    '(so
37 |       ;;   (use "test/smoke-test")
38 |       (the-last-oops .^))))
39 | 
40 | (setting-ensure-bound primordial-setting '(primordial-setting))
41 | (setting-resolve! primordial-setting 'primordial-setting primordial-setting)
42 | 
43 | )
44 | 


--------------------------------------------------------------------------------
/player/source.scm:
--------------------------------------------------------------------------------
 1 | ;; Chez Scheme no longer always distinguishes input ports from output
 2 | ;; ports, so we need a wrapper for one of those types just to tell
 3 | ;; them apart. I choose to wrap the input ports.
 4 | 
 5 | (library (player source)
 6 |   (export source? make-source source-port make-source-maker
 7 |           source-read-char source-get-u8 source-read-all
 8 |           source-char-ready? close-source
 9 |           process/source)
10 | (import (chezscheme)
11 |   (player util)
12 |   )
13 | 
14 | ;; TODO always check that make-source is given a genuine port
15 | (define-record-type source (fields port))
16 | 
17 | (define (make-source-maker maker)
18 |   (lambda args
19 |     (make-source (apply maker args))))
20 | 
21 | (define (source-read-char source)
22 |   (read-char (source-port source)))
23 | 
24 | (define (source-get-u8 source)
25 |   (get-u8 (source-port source)))
26 | 
27 | (define (source-read-all source)
28 |   (let ((port (source-port source)))
29 |     (let reading ((cs '()))
30 |       (let ((c (read-char port)))
31 |         (if (eof-object? c)
32 |             (list->string (reverse cs))
33 |             (reading (cons c cs)))))))
34 | 
35 | (define (source-char-ready? source)
36 |   (char-ready? (source-port source)))
37 | 
38 | (define (close-source source)
39 |   (close-port (source-port source)))
40 | 
41 | (define (process/source command)
42 |   (let ((results (process command)))
43 |     (insist (input-port? (car results)) "Unexpected type from `process`" results)
44 |     (cons (make-source (car results))
45 |           (cdr results))))
46 | 
47 | )
48 | 


--------------------------------------------------------------------------------
/player/thing.scm:
--------------------------------------------------------------------------------
 1 | ;; Basic data model
 2 | ;; TODO explain more
 3 | 
 4 | (library (player thing)
 5 | (export object? object<- object-script object-datum
 6 |         script? script<- script-name script-trait script-clauses
 7 |         cps-script? cps-prim<- cps-script-name cps-script-procedure
 8 |         uninitialized
 9 |         )
10 | (import (chezscheme) (player util))
11 | 
12 | (define-record-type object (fields script datum))   ; Nonprimitive objects, that is.
13 | (define object<- make-object)
14 | 
15 | (define-record-type script (fields name trait clauses))
16 | (define script<- make-script)
17 | 
18 | (define-record-type cps-script (fields name procedure))
19 | 
20 | (define (cps-prim<- datum name procedure)
21 |   (object<- (make-cps-script name procedure) datum))
22 | 
23 | (define uninitialized
24 |   (object<- (script<- '<uninitialized> #f '()) '*uninitialized*))
25 | 
26 | 
27 | )
28 | 


--------------------------------------------------------------------------------
/plug-ins/cant.st:
--------------------------------------------------------------------------------
 1 | /* Highlighting for Enscript.
 2 |    Copy this file to your Enscript hl directory (such as /usr/share/enscript/hl/)
 3 |    and also add this line to namerules in enscript.st:
 4 | 
 5 |   /\.cant$/					cant;
 6 | 
 7 |  */
 8 | 
 9 | /**
10 |  * Name: Cant
11 |  * Description: Cant programming language. Derived from scheme.st which is by Markku Rossi <mtr@iki.fi>
12 |  */
13 | 
14 | state cant extends HighlightEntry
15 | {
16 |   BEGIN {
17 |     /*
18 |      * Modify regexp character syntax so that we can distinguish all
19 |      * symbols.
20 |      */
21 |     extras = list ('!', '$', '%', '&', '*', '/', ':', '<',
22 | 		   '=', '>', '?', '~', '^', '.', '+', '-');
23 |     for (i = 0; i < length (extras); i = i + 1)
24 |       regexp_syntax (extras[i], 'w');
25 |   }
26 | 
27 |   /* Comments. */
28 |   /;/ {
29 |     comment_face (true);
30 |     language_print ($0);
31 |     call (eat_one_line);
32 |     comment_face (false);
33 |   }
34 | 
35 |   /* String constants. */
36 |   /\"/ {
37 |     string_face (true);
38 |     language_print ($0);
39 |     call (c_string);
40 |     string_face (false);
41 |   }
42 | 
43 |   /* Keywords.
44 |    */
45 |   /@|:|::|~|_|\b(and|begin|do|else|if|let|or|quasiquote|quote|unquote|unquote-splicing|optional|view|be|call|export|for|given|hide|hm|import|make|may|make-trait|on|to|unless|when)\b/ {
46 |     keyword_face (true);
47 |     language_print ($0);
48 |     keyword_face (false);
49 |   }
50 | }
51 | 
52 | 
53 | /*
54 | Local variables:
55 | mode: c
56 | End:
57 | */
58 | 


--------------------------------------------------------------------------------
/run-tests:
--------------------------------------------------------------------------------
1 | ./t omnibus || echo omnibus failed
2 | ./t quick   || echo quick failed
3 | ./t oiler-further || echo oiler-further failed
4 | 


--------------------------------------------------------------------------------
/t:
--------------------------------------------------------------------------------
 1 | #!/bin/bash
 2 | set -euo pipefail; shopt -s failglob  # 'Bash strict mode'
 3 | 
 4 | # Test runner. Usage: for test/test-foo.scm, say `t foo`
 5 | 
 6 | # XXX what is this crap? 
 7 | # make -s &&
 8 | # time ./cant-binary test/test-$1.cant >$1.out
 9 | # Exception: compiled program requires different compilation instance of (terp terp) from one found in terp/terp.scm
10 | 
11 | time ./incant test/test-$1.cant >$1.out
12 | diff -u $1.expected $1.out
13 | 


--------------------------------------------------------------------------------
/test/smoke-test.cant:
--------------------------------------------------------------------------------
 1 | (to (expect expected value)
 2 |   (unless (= expected value)
 3 |     (oops "Smoke test failed" expected value)))
 4 | 
 5 | (expect 42           42)
 6 | (expect 'hello       'hello)
 7 | ; (out .print (make _))
 8 | (expect '()          ((make (xs xs))))
 9 | (expect '(1 2 3)     ((make (xs xs)) 1 2 3))
10 | (expect 2            (if #no 1 2))
11 | (expect 1            (if #yes 1 2))
12 | (expect 'no          ((make ('(#no) 'no) (~ 'yes)) #no))
13 | (expect 'yes         ((make ('(#no) 'no) (~ 'yes)) #yes))
14 | (expect '(hello yes) `(hello ,(if #yes 'yes 'no)))
15 | (expect 5            (2 .+ 3))
16 | (expect 55           (do [] (let x 55)))
17 | (expect 136          (do [] (to (f) 136) (f)))
18 | (expect 120          (do []
19 |                        (to (factorial n)
20 |                          (may n
21 |                            (0 1)
22 |                            (~ (n .* (factorial (n .- 1))))))
23 |                        (factorial 5)))
24 | 


--------------------------------------------------------------------------------
/test/test-2048.cant:
--------------------------------------------------------------------------------
 1 | (import (use "../examples/games/2048") left down)
 2 | 
 3 | (to (exercise board)
 4 |   (show-move left board)
 5 |   (show-move down board))
 6 | 
 7 | (to (show-move dir board)
 8 |   (show board)
 9 |   (out .say " ------- ~w:\n" dir)
10 |   (for each! [(moved (dir board))]
11 |     (show moved)
12 |     out.newline)
13 |   out.newline)
14 | 
15 | (to (show rows)
16 |   (for each! [(row rows)]
17 |     (for each! [(v row)]
18 |       (out .say " ~d" (if (= v 0) "." v)))
19 |     out.newline))
20 | 
21 | (exercise '((2 4 2 2)
22 |             (2 2 2 2)
23 |             (0 2 0 2)
24 |             (2 0 2 0)))
25 | 
26 | (exercise '((2 0 0 2)
27 |             (0 0 0 2)
28 |             (0 2 4 4)
29 |             (0 2 2 4)))
30 | 
31 | (exercise '((2 2 2 4)
32 |             (0 0 0 0)
33 |             (2 2 4 4)
34 |             (0 0 0 0)))
35 | 


--------------------------------------------------------------------------------
/test/test-bag.cant:
--------------------------------------------------------------------------------
 1 | ;; TODO this is a dupe of test-hashmap, c'mon
 2 | 
 3 | (let a (bag<-))
 4 | (out .print a)
 5 | (out .print (a .get 42))
 6 | (a .add! 'x)
 7 | (out .print a)
 8 | (out .print (a .get 'x))
 9 | (a .add! 'x)
10 | (out .print a)
11 | (out .print (a .get 'x))
12 | (out .print (a .get 'y 'nope))
13 | 
14 | (a .add! 'z)
15 | (out .print a)
16 | (out .print (a .get 'x))
17 | (out .print (a .get 'y))
18 | (out .print (a .get 'z))
19 | (out .print (list<- a.keys a.values a.items a.none? a.count))
20 | (out .print (a 'z))
21 | 
22 | ;; TODO more tests
23 | 
24 | (import (use 'chaos) chaos<-)
25 | 
26 | (let chaos (chaos<- 1234567))
27 | 
28 | (to (random-tests n-trials)            ;TODO use squickcheck
29 |   (for each! [(_ n-trials.till)]
30 |     (exercise-em (for each [(value 50.till)] ;TODO did I mean to use the value?
31 |                    (chaos .sample-count 5)))))
32 | 
33 | (to (exercise-em keys)
34 |   (let m (bag<-))     ;; The bag under test.
35 |   (let a (box<- '())) ;; A list of keys seen so far.
36 |   (for each! [(key keys)]
37 |     (let m-val (m .get key 0))
38 |     (let a-val (tally-by ||(= key it) a.^))
39 |     (surely (= m-val a-val) "mismatch" key m-val a-val)
40 | 
41 |     (m .add! key)
42 |     (a .^= (link key a.^))))
43 | 
44 | (random-tests 13)
45 | 


--------------------------------------------------------------------------------
/test/test-catch.cant:
--------------------------------------------------------------------------------
 1 | ;; In these test cases we have catch-oops nested within some extra junk,
 2 | ;; plus more extra junk around the actual error. This is to verify that
 3 | ;;  * the junk on the stack in between catch-oops and the error is skipped
 4 | ;;  * the junk on the stack *above* catch-oops is not skipped.
 5 | 
 6 | ;; No-oops case
 7 | (out .print (list<- (catch-oops ($ (+ 1 (* 3 3))))))
 8 | 
 9 | ;; Oops case
10 | (out .print (list<- (catch-oops ($ (+ 1 (* 3 'three))))))
11 | 
12 | 
13 | ;; TODO test that unwind-protect thunks get called, ejectors get disabled, and such
14 | 


--------------------------------------------------------------------------------
/test/test-complex.cant:
--------------------------------------------------------------------------------
 1 | ;; Complex numbers
 2 | 
 3 | (import (use 'complex) c+ c- c* c/ c-abs)
 4 | 
 5 | (let z {complex 0 0})
 6 | (let l {complex 1 0})
 7 | (let i {complex 0 1})
 8 | 
 9 | (let hypot (c+ (c- z (c- z (c+ l (c+ l l))))
10 |                (c* i (c+ l (c+ l (c+ l l ))))))
11 | 
12 | (out .say "0+0 = ~w\n" (c+ z z))
13 | (out .say "i*i = ~w\n" (c* i i))
14 | (out .say "|3+4i| = ~w\n" (c-abs hypot))
15 | (out .say "z/z = ~w\n" (c/ hypot hypot))
16 | 


--------------------------------------------------------------------------------
/test/test-continuations.cant:
--------------------------------------------------------------------------------
 1 | ;; Get a continuation from an oops, and invoke it.
 2 | 
 3 | (import ((use 'traceback) (export out))
 4 |   on-oops-traceback)
 5 | 
 6 | (with-signal-handler
 7 |  (on (k evil)
 8 |    (on-oops-traceback k evil)
 9 |    (out .display "Now continuing with 42\n")
10 |    (k .answer 42))
11 |  ($
12 |    (out .print (+ 1 (oops "I wish to complain" 'life 'is 'terrible)))))
13 | 


--------------------------------------------------------------------------------
/test/test-cycle-write.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'cycle-write) cycle-write)
 2 | 
 3 | (to (cp x)
 4 |   (cycle-write x out)
 5 |   out.newline)
 6 | 
 7 | (cp '(a b c))
 8 | 
 9 | (do []
10 |   (let box (box<- 42))
11 |   (let root `(a ,box c))
12 |   (box .^= root)
13 |   (cp root))
14 | 


--------------------------------------------------------------------------------
/test/test-english-numbers.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'english-numbers) numeralize ordinalize ordinalize-suffix)
 2 | 
 3 | (to (test-numeral i)
 4 |   (out .say "~4w ~d\n" i (numeralize i)))
 5 | 
 6 | (to (test-ordinal i)
 7 |   (when (count? i)
 8 |     (out .say "~w~d ~d\n" i (ordinalize-suffix i) (ordinalize i))))
 9 | 
10 | (let numbers (chain (-2 .till 42) '(100 101 1000003 321450 9321461 1000110009321499)))
11 | 
12 | (each! test-numeral numbers)
13 | (each! test-ordinal numbers)
14 | 


--------------------------------------------------------------------------------
/test/test-export-import.cant:
--------------------------------------------------------------------------------
 1 | ;; Try out sugar for import and export.
 2 | 
 3 | (do []
 4 | 
 5 |   (let a-module
 6 |     (do []
 7 |       (let f 'howdy)
 8 |       (let g 'doody)
 9 |       (let a (export f g))
10 |       (out .print a)
11 |       (out .print (a 'g))
12 |       (out .print (a 'f))
13 |       a))
14 | 
15 |   (import a-module f g)
16 |   (out .display "f and g\n")
17 |   (out .print f)
18 |   (out .print g)
19 | )
20 | 


--------------------------------------------------------------------------------
/test/test-factor.cant:
--------------------------------------------------------------------------------
1 | (import (use 'factoring) factor)
2 | 
3 | (out .print (factor 1))
4 | (out .print (factor 2))
5 | (out .print (factor 43))
6 | (out .print (factor 117))
7 | 


--------------------------------------------------------------------------------
/test/test-flexarray.cant:
--------------------------------------------------------------------------------
 1 | out.newline
 2 | (let v (flexarray<-))
 3 | (out .print v)
 4 | (out .print (list<- v.snapshot v.none? v.count))
 5 | (out .print (v .push! 42))
 6 | (out .print (v 0))
 7 | (out .print (list<- v.snapshot v.none? v.count))
 8 | (out .print v.pop!)
 9 | (out .print (list<- v.snapshot v.none? v.count))
10 | 
11 | ;; TODO more tests
12 | 


--------------------------------------------------------------------------------
/test/test-flextext.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'flextext) flextext<- backward)
 2 | 
 3 | (do []
 4 |   (let t (flextext<-))
 5 |   (out .print (t .get 0 10))
 6 |   (t .replace 0 0 "hello")
 7 |   (out .print (t .get 0 10))
 8 |   (t .replace 1 2 "GOOBER")
 9 |   (out .print (t .get 0 20))
10 |   (out .print (t .get 3 3))
11 |   )
12 | 
13 | out.newline
14 | (do []
15 |   (let t (flextext<-))
16 |   (t .replace 0 0 "aXbXc")
17 |   (let X (set<- #\X))
18 |   (out .displayln (t .get 0 t.count))
19 |   (each! ||(out .display it) t.keys)
20 |   out.newline
21 |   (for each! [(i (0 .thru t.count))]
22 |     (out .say "back from ~w: ~w\n"
23 |               i (t .find-rune-set i backward X)))
24 |   )
25 | 


--------------------------------------------------------------------------------
/test/test-format-tables.cant:
--------------------------------------------------------------------------------
1 | (import (use 'format-tables) format-table tabulate)
2 | 
3 | (let eg "I love bees don't they enthrall you too? Bees! BEEEZE.".split)
4 | 
5 | (each! ||(out .print it)
6 |        (format-table (tabulate eg 30)))
7 | 


--------------------------------------------------------------------------------
/test/test-format.cant:
--------------------------------------------------------------------------------
1 | (out .say "Dear ~w,\n\nI wish to ~d to ~~100% of your ~w.\n"
2 |           "Archimedes" "subscribe" 'codices)
3 | 
4 | (let p (text-sink<-))
5 | (p .say "hey ~d how r ya" 42)
6 | (out .print `(text-sink: ,p.output-text))
7 | 
8 | (out .print ("hey ~w yay" .format '(+ 2 3)))
9 | 


--------------------------------------------------------------------------------
/test/test-hashset.cant:
--------------------------------------------------------------------------------
1 | (let a (set<-))
2 | (out .print (((set<- 1) .union (set<- 3)) .keys))
3 | 


--------------------------------------------------------------------------------
/test/test-huffman-coding.cant:
--------------------------------------------------------------------------------
 1 | (import (use "../examples/coding-theory/huffman-coding") huffman-code<-)
 2 | 
 3 | (let eg1
 4 |   '((#\z 9)
 5 |     (#\j 10)
 6 |     (#\q 20)
 7 |     (#\x 20)
 8 |     (#\k 52)
 9 |     (#\v 93)
10 |     (#\g 161)
11 |     (#\b 162)
12 |     (#\y 188)
13 |     (#\w 203)
14 |     (#\m 225)
15 |     (#\f 228)
16 |     (#\p 229)
17 |     (#\u 310)
18 |     (#\c 320)
19 |     (#\d 365) 
20 |     (#\l 403)
21 |     (#\h 514)
22 |     (#\r 603)
23 |     (#\s 659)
24 |     (#\i 718)
25 |     (#\n 719)
26 |     (#\o 794)
27 |     (#\a 805)
28 |     (#\t 959)
29 |     (#\e 1231)))
30 | 
31 | (let huff (huffman-code<- (each tuple<-list eg1)))
32 | (huff .show out)
33 | 
34 | (let hello (huff.encoder "hello"))
35 | (out .print hello)
36 | (out .print ((huff.decoder hello) .text))
37 | 


--------------------------------------------------------------------------------
/test/test-lambda.cant:
--------------------------------------------------------------------------------
 1 | (to (test-lambda filename test-names)
 2 |   (import (use (chain "../examples/lambda-calculus/" filename))
 3 |     run-file)
 4 |   (for each! [(test test-names)]
 5 |     (out .say "\nTesting ~d (w/ ~d)\n" test filename)
 6 |     (out .print (run-file (chain "examples/lambda-calculus/examples/" test)))))
 7 | 
 8 | (let full-test-names '("trivial1.lambda"
 9 |                        "trivial2.lambda"
10 |                        ;; "break.lambda"
11 |                        "church.lambda"
12 |                        "factorial.lambda"
13 |                        "reverse.lambda"
14 |                        "elementary-ca.lambda"
15 |                        "turing-scott.lambda"
16 |                        ))
17 | 
18 | (test-lambda "interpreter" full-test-names)
19 | (test-lambda "compiler1" '("factorial.lambda"))
20 | 
21 | ;; TODO send full-test-names to compiler1 too.
22 | ;; Right now it's really slow!
23 | 


--------------------------------------------------------------------------------
/test/test-memoize.cant:
--------------------------------------------------------------------------------
1 | (import (use 'memoize) memoize)
2 | 
3 | (let fib (memoize
4 |           (on (n)
5 |             (if (< n 2) 1 (+ (fib (- n 1)) (fib (- n 2)))))))
6 | 
7 | (out .print (each fib 30.till))
8 | 


--------------------------------------------------------------------------------
/test/test-metacircular.cant:
--------------------------------------------------------------------------------
 1 | (import (use "../examples/cant") play)  ; global-setting)
 2 | 
 3 | 
 4 | (to (run e)
 5 |   (out .say "Playing ~w\n" e)
 6 |   (out .print (play (cant .parse-expression e) computational-setting)))
 7 | 
 8 | ;; TODO code duplicated from smoke-test.cant
 9 | 
10 | (run '42)
11 | (run ''hello)
12 | ; (run '(make _))
13 | (run '((make (to xs xs))))
14 | (run '((make (to xs xs)) 1 2 3))
15 | (run '(if #no 1 2))
16 | (run '(if #yes 1 2))
17 | (run '((make (to (~ #no) 'no) (to _ 'yes)) #no))
18 | (run '((make (to (~ #no) 'no) (to _ 'yes)) #yes))
19 | (run '`(hello ,(if #yes 'yes 'no)))
20 | (run '(2 .+ 3))
21 | (run '(do [] (let x 55)))
22 | (run '(do [] (to (f) 136) (f)))
23 | (run '(do []
24 |         (to (factorial n)
25 |           (may n
26 |             (be 0 1)
27 |             (else (n .* (factorial (- n 1))))))
28 |         (factorial 10)))
29 | 


--------------------------------------------------------------------------------
/test/test-module-for-use.cant:
--------------------------------------------------------------------------------
 1 | (out .display "I am loading left-pad!")
 2 | out.newline
 3 | 
 4 | (to (left-pad text)
 5 |   (if (mayhap ~.whitespace? (text .get 0))
 6 |       (left-pad (text .from 1))
 7 |       text))
 8 | 
 9 | (export left-pad)
10 | 


--------------------------------------------------------------------------------
/test/test-n-queens.cant:
--------------------------------------------------------------------------------
1 | (import (use "../examples/exercises-and-puzzles/n-queens") queens)
2 | 
3 | (queens 4)
4 | 


--------------------------------------------------------------------------------
/test/test-oiler-further.cant:
--------------------------------------------------------------------------------
 1 | (to (loud-use filename)
 2 |   out.newline
 3 |   (out .display "-------- ")
 4 |   (out .display filename)
 5 |   (out .display " --------")
 6 |   out.newline
 7 |   (use filename))
 8 |   
 9 | (loud-use "../examples/project-oiler/11")
10 | (loud-use "../examples/project-oiler/13")
11 | (loud-use "../examples/project-oiler/15")
12 | (loud-use "../examples/project-oiler/16")
13 | (loud-use "../examples/project-oiler/17")
14 | (loud-use "../examples/project-oiler/18")
15 | (loud-use "../examples/project-oiler/19")
16 | (loud-use "../examples/project-oiler/24")
17 | (loud-use "../examples/project-oiler/25")
18 | (loud-use "../examples/project-oiler/28")
19 | (loud-use "../examples/project-oiler/29")
20 | (loud-use "../examples/project-oiler/31")
21 | (loud-use "../examples/project-oiler/41")
22 | (loud-use "../examples/project-oiler/42")
23 | 


--------------------------------------------------------------------------------
/test/test-oiler.cant:
--------------------------------------------------------------------------------
 1 | (to (loud-use filename)
 2 |   out.newline
 3 |   (out .display "-------- ")
 4 |   (out .display filename)
 5 |   (out .display " --------")
 6 |   out.newline
 7 |   (use filename))
 8 |   
 9 | (loud-use "../examples/project-oiler/01")
10 | (loud-use "../examples/project-oiler/02")
11 | (loud-use "../examples/project-oiler/03")
12 | (loud-use "../examples/project-oiler/04")
13 | (loud-use "../examples/project-oiler/05")
14 | (loud-use "../examples/project-oiler/06")
15 | (loud-use "../examples/project-oiler/07")
16 | (loud-use "../examples/project-oiler/08")
17 | ((loud-use "../examples/project-oiler/09") '*)
18 | ((loud-use "../examples/project-oiler/10") '(_ "10"))
19 | 


--------------------------------------------------------------------------------
/test/test-omnibus.cant:
--------------------------------------------------------------------------------
 1 | ;; Another bunch of examples
 2 | 
 3 | (to (loud-use filename)
 4 |   out.newline
 5 |   (out .display "-------- ")
 6 |   (out .display filename)
 7 |   (out .display " --------")
 8 |   out.newline
 9 |   (use filename))
10 | 
11 | (loud-use "test-english-numbers")
12 | (loud-use "test-lambda")
13 | (loud-use "test-oiler")
14 | (loud-use "test-n-queens")
15 | (loud-use "test-squirm")
16 | 


--------------------------------------------------------------------------------
/test/test-pattern-matching.cant:
--------------------------------------------------------------------------------
1 | ;; Try some newer pattern-matching features.
2 | 
3 | (may {whee 1 2 3}
4 |   (be {whee a b c} (out .print c)))
5 | 
6 | (may {whee 1 2 3}
7 |   (be {whee a @x} (out .print x)))
8 | 


--------------------------------------------------------------------------------
/test/test-pretty-print.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'pretty-print) pp<-)
 2 | (let pp (pp<- (export out)))
 3 | 
 4 | (let eg1
 5 |   '(to (fact n)
 6 |      (if (= n 0) 1 (* n (fact (- n 1))))))
 7 | 
 8 | (pp eg1 30)
 9 | 
10 | (let eg2
11 |   '(to (walk tree visit)
12 |      (do walking [tree (path '())]
13 |        (match tree
14 |          ({leaf symbol}
15 |           (visit symbol (reverse path)))
16 |          ({branch on-0 on-1}
17 |           (walking on-0 `(0 ,@path))
18 |           (walking on-1 `(1 ,@path)))))))
19 | 
20 | (pp eg2 50)
21 | 
22 | (pp '[{.foo}] 10)
23 | 
24 | (pp '`{,foo bar} 10)
25 | 
26 | (pp (box<- 'b) 10)
27 | 


--------------------------------------------------------------------------------
/test/test-quasiquote.cant:
--------------------------------------------------------------------------------
 1 | ;; Test use of quasiquote on term data.
 2 | ;; (Already exercised sufficiently on plain old Lisp lists.)
 3 | 
 4 | (do []
 5 | 
 6 |   (let a '(yo there))
 7 |   (let b 'gee)
 8 | 
 9 |   (out .print `(ok {,b its cool ,@a b c} yay))
10 |   (out .print `(ok {t its cool ,@a b c} yay))
11 |   (out .print `(ok {t ,@a b c} yay))
12 |   (out .print `(ok {t ,a b c} yay))
13 |   (out .print `(ok {t a b c} yay))
14 |   (out .print `(ok {t} yay))
15 | 
16 | )
17 | ;; TODO add hygiene test
18 | 


--------------------------------------------------------------------------------
/test/test-random.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'chaos) chaos<-)
 2 | 
 3 | (let chaos (chaos<- 1234567))
 4 | 
 5 | ; (out .say "seed: ~w\n" (random-seed<-))
 6 | (for each! [(_ 10.till)]
 7 |   (out .say "~w " (chaos .sample-count 4)))
 8 | out.newline
 9 | 
10 |         
11 | 


--------------------------------------------------------------------------------
/test/test-ratio.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'ratio) ratio<- float<-ratio ratio-parse r+ r- r* r/ ratio-compare)
 2 | 
 3 | ;; Generate good rational approximations of float in order of
 4 | ;; increasing denominator.
 5 | ;; TODO move to ratio.cant
 6 | (to (rationalize float)
 7 |   (if (< float 0)
 8 |       (each$ - (rationalize (- float)))
 9 |       (oops "XXX unimplemented")))
10 | 
11 | (let pi (r/ (ratio<- 355) (ratio<- 113)))
12 | (surely (= pi (ratio-parse "355/113")))
13 | 
14 | (let tau (r+ pi pi))
15 | 
16 | (out .print pi)
17 | (out .print (float<-ratio pi))
18 | (out .print tau)
19 | (out .print (r/ tau pi))
20 | (out .print (r- (ratio<- 1 2) (ratio<- 1 3)))
21 | 


--------------------------------------------------------------------------------
/test/test-regex-gen.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'regex-gen) regex-generate regex-parse)
 2 | 
 3 | (to (test regex n)
 4 |   (let r (regex-parse regex))
 5 |   (out .say "~d (~w)\n~d\n" regex n (text-by ||"-" regex))
 6 |   (let Ns ((0 .thru n) .range))
 7 |   (for each! [(text (regex-generate r Ns))]
 8 |     (out .say "~w\n" text))
 9 |   out.newline)
10 | 
11 | (out .print (regex-parse "."))
12 | 
13 | (test "." 2)
14 | (test "X" 2)
15 | (test "XY" 3)
16 | (test "X|Y" 2)
17 | (test "X+" 3)
18 | (test "a(b|c)*d" 4)
19 | (test "a.*d" 5)
20 | (test "a[bc]*d" 4)
21 | (test "a[x]+z()*|c.hi" 5)
22 | 
23 | ;; Suppressed for faster testing for now
24 | ;;(test "(Chloe|Yvette), a( precocious)? (toddler|writer)" 28)
25 | 


--------------------------------------------------------------------------------
/test/test-regex-match.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'regex-match) regex-match regex-parse)
 2 | 
 3 | (to (test regex should-match should-not)
 4 |   (let r (regex-parse regex))
 5 |   (out .say "~d\n~d\n" regex (text-by ||"-" regex))
 6 |   (for each! [(text should-match)]
 7 |     (test-1 r text #yes))
 8 |   (for each! [(text should-not)]
 9 |     (test-1 r text #no))
10 |   out.newline)
11 | 
12 | (to (test-1 parsed text should?)
13 |   (let match? (regex-match parsed text))
14 |   (out .say "~4d ~d ~w\n"
15 |             (if (= match? should?) "" "FAIL")
16 |             (if match? "y" "n")
17 |             text))
18 | 
19 | (out .print (regex-parse "."))
20 | 
21 | (test "."        '("a")         '("" "ab"))
22 | (test "X"        '("X")         '("hey"))
23 | (test "XY"       '("XY")        '("hey" "X" "XYZ"))
24 | (test "X|Y"      '("X" "Y")     '("hey" "Z"))
25 | (test "X*"       '("" "X" "XX") '("hey"))
26 | (test "a(b|c)*d" '("ad" "abcd") '("ab" "B"))
27 | (test "a.*d"     '("ad" "abcd") '("ab" "B"))
28 | (test "a[bc]*d"  '("ad" "abcd") '("ab" "B"))
29 | 
30 | ; TODO more tests
31 | 
32 | (export test)
33 | 


--------------------------------------------------------------------------------
/test/test-roman.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'roman) number<-roman roman<-number)
 2 | 
 3 | (to (main args)
 4 |   (for each! [(x args.rest)]
 5 |     (let converted (may x.?number
 6 |                      (be #no (number<-roman x))
 7 |                      (be n   (roman<-number n))))
 8 |     (out .say "~d: ~d\n" x converted)))
 9 | 
10 | (main '(_ "mcmlxix" "1969" "i" "420"))
11 | 


--------------------------------------------------------------------------------
/test/test-sokoban.cant:
--------------------------------------------------------------------------------
 1 | (import (use "../examples/games/sokoban") read-collection)
 2 | 
 3 | (let (~ grids name) (read-collection (text-source<- "\
 4 | Microban, by David Skinner (just #2)
 5 |  #######
 6 |  #     #
 7 |  # .o. #
 8 | ## oio #
 9 | #  .o. #
10 | #      #
11 | ########
12 | ")))
13 | 
14 | (let g (grids 0))
15 | (out .say "~d\n\n" name)
16 | (out .say "~d\n" g.unparse)
17 | 
18 | (let afterward
19 |   (for amass [(g g) (dir '(down down right))]
20 |     (hey (g .move dir)
21 |          ||(out .displayln it.unparse))))
22 | 
23 | (out .print afterward.won?)
24 | 


--------------------------------------------------------------------------------
/test/test-sort.cant:
--------------------------------------------------------------------------------
1 | (out .print (sort '(3 1 4 1 5 9)))
2 | (out .print (sort '(i am a badass) {reverse}))
3 | (out .print (sort '((on wings) (of) () (song))))
4 | 


--------------------------------------------------------------------------------
/test/test-squirm.cant:
--------------------------------------------------------------------------------
 1 | (import ((use "../examples/squirm/squirm-interpreter")
 2 |          (export nano-now
 3 |                  nanosleep
 4 |                  out
 5 |                  with-input-file
 6 |                  catch-oops))
 7 |   run-file)
 8 | 
 9 | (let test-names '("test/smoke-test.squirm"
10 | 
11 |                   "examples/hello.squirm"
12 |                   "examples/universal_server.squirm"
13 | 
14 |                   "test/error-test.squirm"
15 |                   "test/mod-test.squirm"
16 |                   "test/monitor-test.squirm"
17 |                   "test/partner-test.squirm"
18 |                   "test/quasiquote-test.squirm"
19 |                   "test/recur-test.squirm"
20 |                   "test/silly.squirm"
21 |                   "test/throw-test.squirm"
22 |                   "test/timeout-test.squirm"
23 |                   ))
24 | 
25 | (for each! [(test test-names)]
26 |   (out .say "\nTesting ~d\n" test)
27 |   (run-file (chain "examples/squirm/" test)))
28 | 


--------------------------------------------------------------------------------
/test/test-sset.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'sset)
 2 |   sset<- sset<-list sset-elements sset-insert sset-remove
 3 |   sset-union sset-difference sset-intersect)
 4 | 
 5 | (import ((use 'squickcheck) (export out))
 6 |   a-count a-list-of
 7 |   all should)
 8 | 
 9 | (let s1 (sset<- 1 7 5 3))
10 | (let s2 (sset<- 0 2 3 4 5 9))
11 | 
12 | (out .print (sset<- 1 1 1 1))
13 | (out .print (sset-difference s1 s2))
14 | (out .print (sset-difference s2 s1))
15 | 
16 | (for all [(x (a-list-of a-count))]
17 |   (let sx (sset<-list x))
18 |   (let mx (set<-list x))
19 |   (should = (sset-elements sx) (sort mx.keys)))
20 | 
21 | ;; TODO failures won't be as easy to decipher as I'd like
22 | (to (test-binary-ops-correspond sset-op set-op)
23 |   (for all [(x (a-list-of a-count))
24 |             (y (a-list-of a-count))]
25 |     (let sx (sset<-list x)) (let sy (sset<-list y)) (let sr (sset-op sx sy))
26 |     (let mx (set<-list x))  (let my (set<-list y))  (let mr (set-op mx my))
27 |     (should = (sset-elements sr) (sort mr.keys))))
28 | 
29 | (test-binary-ops-correspond sset-union (on (x y) (x .union y)))
30 | (test-binary-ops-correspond sset-intersect (on (x y) (x .intersect y)))
31 | (test-binary-ops-correspond sset-difference (on (x y) (x .difference y)))
32 | 


--------------------------------------------------------------------------------
/test/test-text-wrap.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'text-wrap) wrap)
 2 | 
 3 | ;; TODO move this (main) somewhere meaningful, or rm it.
 4 | (to (main `(,_ ,width-text ,@words))
 5 |   (let lines (wrap (" " .join words) width-text.number))
 6 |   (each! ||(out .print it) lines))
 7 | 
 8 | (let text "
 9 |   How to explain?  How to describe?  Even the omniscient viewpoint quails.
10 | ")
11 | 
12 | (each! ||(out .print it) (wrap text 30))
13 | 


--------------------------------------------------------------------------------
/test/test-texts.cant:
--------------------------------------------------------------------------------
 1 | (out .print ("hey there" .split))
 2 | (out .print ("  hey  there   " .split))
 3 | (out .print ("     " .split))
 4 | (out .print ("a" .split))
 5 | 
 6 | (out .print ("" .prefix? "hey"))
 7 | (out .print ("" .prefix? ""))
 8 | (out .print ("hey" .prefix? ""))
 9 | (out .print ("hey" .prefix? "h"))
10 | (out .print ("hey" .prefix? "x"))
11 | (out .print ("hey" .prefix? "hey"))
12 | (out .print ("hey" .prefix? "heyo"))
13 | 
14 | (out .print ("hey there" .split "||"))
15 | (out .print ("hey|there" .split "||"))
16 | (out .print ("hey||there" .split "||"))
17 | (out .print ("hey||there||" .split "||"))
18 | (out .print ("hey||th|ere|||whee" .split "||"))
19 | (out .print ("hey||th|ere||||whee" .split "||"))
20 | 
21 | (out .print ("hey there" .replace "x" "123"))
22 | (out .print ("hey" .replace "" "X"))
23 | (out .print ("hey-yo-dude" .replace "-" "=="))
24 | (out .print ("-hey-yo--dude-" .replace "-" "=="))
25 | (out .print ("-hey-yo--dude-" .replace "-" ""))
26 | (out .print ("-hey->yo->dude-" .replace "->" "(())"))
27 | 


--------------------------------------------------------------------------------
/test/test-unify.cant:
--------------------------------------------------------------------------------
 1 | (import (use 'unify) variable<- unify empty-subst reify)
 2 | 
 3 | (let a (variable<- "a" 0))
 4 | (let b (variable<- "b" 0))
 5 | 
 6 | (let s (unify empty-subst `(,a ,b) `(,b 2)))
 7 | (out .print s)
 8 | (out .print (s .subst a))
 9 | (out .print (reify s a))
10 | (out .print (reify s '()))
11 | (out .print (reify s `(0 ,a 1 ,b)))
12 | 


--------------------------------------------------------------------------------
/test/test-use.cant:
--------------------------------------------------------------------------------
1 | (let left-pad-module (use "test-module-for-use"))
2 | (import left-pad-module 
3 |         left-pad)
4 | 
5 | (out .print (left-pad "  I am pretty padded.   "))
6 | 
7 | (let again (use "test-module-for-use")) ; Shouldn't print that it's loading again.
8 | (surely (= again left-pad-module))
9 | 


--------------------------------------------------------------------------------