Add vocabs (#17)

Add support for
- circular
- infix
- qw
- pair-rocket
- sequences.extras
- sequences.repeating

We use a small patch to avoid bringing in help / help.markup
and their dependencies.

Author: keiravillekode

Dockerfile

@@ -19,6 +19,10 @@ RUN git clone https://github.com/factor/factor.git && \
     git checkout ${FACTOR_COMMIT}
 WORKDIR /opt/factor
 
+# Patch extra/shuffle to drop the dependency on help / help.markup (for $shuffle docs)
+COPY patches/shuffle-drop-help.patch /tmp/shuffle-drop-help.patch
+RUN git apply /tmp/shuffle-drop-help.patch
+
 # Bootstrap a headless image: drop the GUI (ui, ui.tools), the in-image help
 # system (help, handbook), and the dev-tools component (tools) from the bootstrap
 # component set.
@@ -29,14 +33,22 @@ RUN sed -i 's#-i="\$BOOT_IMAGE"#-i="$BOOT_IMAGE" -exclude="'"${FACTOR_EXCLUDE}"'
 RUN ./build.sh net-bootstrap
 
 # Precompile tools.test AND the common exercise vocabs into factor.image, then re-save it.
-RUN ./factor -e='USING: accessors arrays ascii assocs bit-arrays calendar calendar.english combinators combinators.short-circuit command-line concurrency.combinators concurrency.locks continuations debugger deques destructors disjoint-sets dlists formatting fry generic grouping hash-sets hashtables heaps io io.encodings.utf8 io.files io.streams.string kernel lexer locals macros make math math.bitwise math.combinatorics math.constants math.functions math.order math.parser math.primes math.statistics namespaces prettyprint.config quotations random random.mersenne-twister ranges regexp sequences sets sorting source-files.errors.debugger splitting splitting.monotonic strings system tools.test tr typed unicode vectors vocabs vocabs.loader memory ; save'
+RUN ./factor -e='USING: accessors arrays ascii assocs bit-arrays calendar calendar.english circular combinators combinators.short-circuit command-line concurrency.combinators concurrency.locks continuations debugger deques destructors disjoint-sets dlists formatting fry generic grouping hash-sets hashtables heaps infix io io.encodings.utf8 io.files io.streams.string kernel lexer locals macros make math math.bitwise math.combinatorics math.constants math.functions math.order math.parser math.primes math.statistics namespaces pair-rocket prettyprint.config quotations qw random random.mersenne-twister ranges regexp sequences sequences.repeating sets sorting source-files.errors.debugger splitting splitting.monotonic strings system tools.test tr typed unicode vectors vocabs vocabs.loader memory ; save'
 
 # Remove files not needed at runtime
 RUN rm -rf .git build vm src misc Factor.app \
     factor.image.fresh boot.*.image libfactor.a libfactor-ffi-test.so \
-    extra GNUmakefile Nmakefile LICENSE.txt README.md \
+    GNUmakefile Nmakefile LICENSE.txt README.md \
     build.sh build.cmd unmaintained
 
+# Keep only the extra/ source that sequences.extras needs to compile on demand:
+# itself plus extra/assocs.extras and extra/shuffle.
+RUN find extra -mindepth 1 -maxdepth 1 \
+    ! -name sequences ! -name assocs ! -name shuffle \
+    -exec rm -rf {} + && \
+    find extra/sequences -mindepth 1 -maxdepth 1 ! -name extras -exec rm -rf {} + && \
+    find extra/assocs    -mindepth 1 -maxdepth 1 ! -name extras -exec rm -rf {} +
+
 # Prune basis subdirs that exercism tests cannot reach, one category per rm so
 # each vocab is named exactly once. Source files only — any bytecode already in
 # factor.image is unaffected. A few pruned vocabs (bit-arrays, disjoint-sets,
@@ -79,8 +91,8 @@ RUN cd basis && rm -rf \
     base16 base24 base32 base36 base45 base58 base62 base64 base85 base91 \
     base92 checksums compression crypto hex-strings
 
-# Specialised data structures (bit-arrays, disjoint-sets, heaps, dlists are
-# precompiled above, so pruning their source here is safe)
+# Specialised data structures (bit-arrays, disjoint-sets, heaps, dlists, circular
+# are precompiled above, so pruning their source here is safe)
 RUN cd basis && rm -rf \
     biassocs bit-arrays bit-sets bit-vectors bitstreams bloom-filters boxes \
     circular columns cuckoo-filters disjoint-sets dlists heaps interval-maps \

patches/shuffle-drop-help.patch

@@ -0,0 +1,22 @@
+diff --git a/extra/shuffle/shuffle.factor b/extra/shuffle/shuffle.factor
+index da69307ce7..d4c0eab80e 100644
+--- a/extra/shuffle/shuffle.factor
++++ b/extra/shuffle/shuffle.factor
+@@ -2,8 +2,7 @@
+ ! See https://factorcode.org/license.txt for BSD license.
+ 
+ USING: accessors assocs combinators combinators.short-circuit
+-definitions effects effects.parser generalizations help
+-help.markup kernel math parser ranges sequences
++definitions effects effects.parser generalizations kernel math parser ranges sequences
+ sequences.generalizations stack-checker.backend
+ stack-checker.known-words stack-checker.values words ;
+ 
+@@ -26,7 +25,6 @@ SYNTAX: SHUFFLE:
+     scan-new-word scan-effect {
+         [ [ '[ _ shuffle-effect ] ] keep define-declared ]
+         [ "shuffle" set-word-prop ]
+-        [ drop { $shuffle } swap set-word-help ]
+     } 2cleave ;
+ 
+ PREDICATE: shuffle-word < word

tests/wishlist-vocabs/exercism-tools/exercism-tools.factor

@@ -0,0 +1,37 @@
+USING: accessors command-line continuations debugger io kernel
+       lexer namespaces sequences source-files.errors.debugger
+       system tools.test vocabs vocabs.loader ;
+IN: exercism-tools
+
+SYNTAX: STOP-HERE
+    lexer get [ text>> length ] keep line<< ;
+
+SYNTAX: TASK:
+    lexer get next-line ;
+
+! Label the test that follows with its description. The marker lets the
+! wrapper strip this line from captured output and attach it to the next
+! test as a name, rather than leaving it in the previous test's output.
+: description ( str -- )
+    "###DESC### " write print ;
+
+! Print one failure block in a stable, parser-friendly form. Bracketed by
+! markers so a wrapper can split the stream reliably and avoid Factor's
+! noisy callstack output (which is interleaved with subsequent failures).
+:: print-failure ( failure -- )
+    "###FAIL_BEGIN###" print
+    failure error-location print
+    failure error>> [ error. ] [ 2drop ] recover
+    "###FAIL_END###" print
+    flush ;
+
+: print-failures ( -- )
+    test-failures get [ print-failure ] each ;
+
+: run-exercism-tests ( -- )
+    command-line get first
+    [ require ] [ test ] bi
+    test-failures get empty?
+    [ 0 exit ] [ print-failures 1 exit ] if ;
+
+MAIN: run-exercism-tests

tests/wishlist-vocabs/expected_results.json

@@ -0,0 +1,41 @@
+{
+  "version": 3,
+  "status": "pass",
+  "tests": [
+    {
+      "name": "qw builds a sequence of strings",
+      "status": "pass",
+      "test_code": "{ { \"apple\" \"orange\" \"lime\" } } [ fruits ] unit-test"
+    },
+    {
+      "name": "infix add sums two numbers",
+      "status": "pass",
+      "test_code": "{ 7 } [ 3 4 add ] unit-test"
+    },
+    {
+      "name": "take-while keeps the leading run",
+      "status": "pass",
+      "test_code": "{ { 1 2 } } [ { 1 2 3 4 1 } small-prefix ] unit-test"
+    },
+    {
+      "name": "interpolate fills in the name",
+      "status": "pass",
+      "test_code": "{ \"Hello, World!\" } [ \"World\" greeting ] unit-test"
+    },
+    {
+      "name": "cycle repeats a sequence to length",
+      "status": "pass",
+      "test_code": "{ { 1 2 3 1 2 } } [ { 1 2 3 } 5 padded-cycle ] unit-test"
+    },
+    {
+      "name": "circular indexing wraps around",
+      "status": "pass",
+      "test_code": "{ 20 } [ 4 { 10 20 30 } wrap-nth ] unit-test"
+    },
+    {
+      "name": "pair-rocket builds an assoc",
+      "status": "pass",
+      "test_code": "{ H{ { \"ada\" 1 } { \"bob\" 2 } } } [ scores ] unit-test"
+    }
+  ]
+}

tests/wishlist-vocabs/wishlist-vocabs/wishlist-vocabs-tests.factor

@@ -0,0 +1,23 @@
+USING: exercism-tools tools.test wishlist-vocabs ;
+IN: wishlist-vocabs.tests
+
+"qw builds a sequence of strings" description
+{ { "apple" "orange" "lime" } } [ fruits ] unit-test
+
+"infix add sums two numbers" description
+{ 7 } [ 3 4 add ] unit-test
+
+"take-while keeps the leading run" description
+{ { 1 2 } } [ { 1 2 3 4 1 } small-prefix ] unit-test
+
+"interpolate fills in the name" description
+{ "Hello, World!" } [ "World" greeting ] unit-test
+
+"cycle repeats a sequence to length" description
+{ { 1 2 3 1 2 } } [ { 1 2 3 } 5 padded-cycle ] unit-test
+
+"circular indexing wraps around" description
+{ 20 } [ 4 { 10 20 30 } wrap-nth ] unit-test
+
+"pair-rocket builds an assoc" description
+{ H{ { "ada" 1 } { "bob" 2 } } } [ scores ] unit-test

tests/wishlist-vocabs/wishlist-vocabs/wishlist-vocabs.factor

@@ -0,0 +1,27 @@
+USING: arrays circular hashtables infix interpolate kernel math
+       namespaces pair-rocket qw sequences sequences.extras
+       sequences.repeating ;
+IN: wishlist-vocabs
+
+! qw{ ... } reads a whitespace-separated literal sequence of strings (qw).
+: fruits ( -- seq ) qw{ apple orange lime } ;
+
+! Standard infix arithmetic over locals (infix).
+INFIX:: add ( x y -- z ) x + y ;
+
+! take-while keeps the leading run satisfying the predicate (sequences.extras);
+! it returns a slice, so >array normalizes it for an exact unit-test compare.
+: small-prefix ( seq -- arr ) [ 3 < ] take-while >array ;
+
+! ${var} string interpolation, reading from a dynamic variable (interpolate).
+: greeting ( name -- str )
+    [ "name" set "Hello, ${name}!" interpolate>string ] with-scope ;
+
+! cycle repeats a sequence up to a given length (sequences.repeating).
+: padded-cycle ( seq n -- arr ) cycle >array ;
+
+! <circular> wraps a sequence so indices read modulo its length (circular).
+: wrap-nth ( n seq -- elt ) <circular> nth ;
+
+! => pairs each key with the next value, building assoc literals (pair-rocket).
+: scores ( -- assoc ) { "ada" => 1 "bob" => 2 } >hashtable ;