From 5f2ace09d2888cb98f59dedeb90160357b8364af Mon Sep 17 00:00:00 2001
From: "Kye W. Shi" <kwshi@hmc.edu>
Date: Tue, 15 Oct 2019 10:38:38 -0700
Subject: [PATCH 01/11] project-euler: add solutions to 064, 087

---
 extra/project-euler/064/064.factor | 132 +++++++++++++++++++++++++++++
 extra/project-euler/087/087.factor |  40 +++++++++
 2 files changed, 172 insertions(+)
 create mode 100644 extra/project-euler/064/064.factor
 create mode 100644 extra/project-euler/087/087.factor

diff --git a/extra/project-euler/064/064.factor b/extra/project-euler/064/064.factor
new file mode 100644
index 0000000000..3ead2c409a
--- /dev/null
+++ b/extra/project-euler/064/064.factor
@@ -0,0 +1,132 @@
+USING: accessors arrays classes.tuple io kernel locals math math.functions
+    math.ranges prettyprint project-euler.common sequences ;
+IN: project-euler.064
+
+<PRIVATE
+
+TUPLE: cont-frac
+    { whole integer }
+    { num-const integer }
+    { denom integer } ;
+
+C: <cont-frac> cont-frac
+
+: deep-copy ( cont-frac -- cont-frac cont-frac )
+    dup tuple>array rest cont-frac slots>tuple ;
+
+: create-cont-frac ( n -- n cont-frac )
+    dup sqrt >fixnum
+    [let :> root
+        root
+        root
+        1
+    ] <cont-frac> ;
+
+: step ( n cont-frac -- n cont-frac )
+    swap dup
+    ! Store n
+    [let :> n
+        ! Extract the constant
+        swap dup num-const>>
+        :> num-const
+
+        ! Find the new denominator
+        num-const 2 ^ n swap -
+        :> exp-denom
+
+        ! Find the fraction in lowest terms
+        dup denom>>
+        exp-denom simple-gcd
+        exp-denom swap /
+        :> new-denom
+
+        ! Find the new whole number
+        num-const n sqrt + new-denom / >fixnum
+        :> new-whole
+
+        ! Find the new num-const
+        num-const new-denom /
+        new-whole swap -
+        new-denom *
+        :> new-num-const
+
+        ! Finally, update the continuing fraction
+        drop new-whole new-num-const new-denom <cont-frac>
+    ] ;
+
+: loop ( c l n cont-frac -- c l n cont-frac )
+    [let :> cf :> n :> l :> c
+        n cf step
+        :> new-cf drop
+        c 1 + l n new-cf
+        l new-cf = [ ] [ loop ] if
+    ] ;
+
+: find-period ( n -- period )
+    0 swap
+    create-cont-frac
+    step
+    deep-copy -rot
+    loop
+    drop drop drop ;
+
+: try-all ( -- n ) 2 10000 [a,b]
+    [ perfect-square? not ] filter
+    [ find-period ] map
+    [ odd? ] filter
+    length ;
+
+PRIVATE>
+
+: euler064a ( -- n ) try-all ;
+
+<PRIVATE
+! (√n + a)/b
+TUPLE: cfrac n a b ;
+
+C: <cfrac> cfrac
+
+! (√n + a) / b = 1 / (k + (√n + a') / b')
+!
+! b / (√n + a) = b (√n - a) / (n - a^2) = (√n - a) / ((n - a^2) / b)
+:: reciprocal ( fr -- fr' )
+    fr n>>
+    fr a>> neg
+    fr n>> fr a>> sq - fr b>> /
+    <cfrac>
+    ;
+
+:: split ( fr -- k fr' )
+    fr n>> sqrt fr a>> + fr b>> / >integer
+    dup fr n>> swap
+    fr b>> * fr a>> swap -
+    fr b>>
+    <cfrac>
+    ;
+
+: pure ( n -- fr )
+    0 1 <cfrac>
+    ;
+
+: next ( fr -- fr' )
+    reciprocal split nip
+    ;
+
+:: period ( n -- per )
+    n pure split nip :> start
+    n sqrt >integer sq n =
+    [ 0 ]
+    [ 1 start next
+      [ dup start = not ]
+      [ next [ 1 + ] dip ]
+      while
+      drop
+    ] if
+    ;
+
+PRIVATE>
+
+: euler064b ( -- ct )
+    1 10000 [a,b]
+    [ period odd? ] count
+    ;
diff --git a/extra/project-euler/087/087.factor b/extra/project-euler/087/087.factor
new file mode 100644
index 0000000000..c20498415c
--- /dev/null
+++ b/extra/project-euler/087/087.factor
@@ -0,0 +1,40 @@
+USING: locals math math.primes sequences math.functions sets kernel ;
+IN: project-euler.087
+
+<PRIVATE
+
+: remove-duplicates ( seq -- seq' )
+    dup intersect ;
+
+:: prime-powers-less-than ( primes pow n -- prime-powers )
+    primes [ pow ^ ] map [ n <= ] filter ;
+
+! You may think to make a set of all possible sums of a prime square and cube 
+! and then subtract prime fourths from numbers ranging from 1 to 'n' to find 
+! this. As n grows large, this is actually more inefficient!
+! Prime numbers grow ~ n / log n
+! Thus there are (n / log n)^(1/2) prime squares <= n,
+!                (n / log n)^(1/3) prime cubes   <= n,
+!            and (n / log n)^(1/4) prime fourths <= n.
+! If we compute the cartesian product of these, this takes 
+! O((n / log n)^(13/12)).
+! If we instead precompute sums of squares and cubes, and iterate up to n,
+! checking each fourth power against it, this takes
+! O(n * (n / log n)^(1/4)) = O(n^(5/4)/(log n)^(1/4)) >> O((n / log n)^(13/12))
+!
+! When n = 50000000, the first equation is approximately 10 million and 
+! the second is approximately 2 billion.
+
+:: prime-triples ( n -- answer )
+    n sqrt primes-upto                :> primes
+    primes 2 n prime-powers-less-than :> primes^2
+    primes 3 n prime-powers-less-than :> primes^3
+    primes 4 n prime-powers-less-than :> primes^4
+    primes^2 primes^3 [ + ] cartesian-map concat
+             primes^4 [ + ] cartesian-map concat
+    [ n <= ] filter remove-duplicates length ;
+
+PRIVATE>
+
+:: euler087 ( -- answer )
+    50000000 prime-triples ;

From b02ae64e91d932ba7769dfb8e389a021c6290b2c Mon Sep 17 00:00:00 2001
From: "Kye W. Shi" <kwshi@hmc.edu>
Date: Tue, 15 Oct 2019 10:45:45 -0700
Subject: [PATCH 02/11] add shell.nix for building/running on NixOS

---
 shell.nix | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)
 create mode 100644 shell.nix

diff --git a/shell.nix b/shell.nix
new file mode 100644
index 0000000000..458964dc7f
--- /dev/null
+++ b/shell.nix
@@ -0,0 +1,20 @@
+{ pkgs ? import <nixpkgs> {} }:
+(pkgs.buildFHSUserEnv {
+  name = "factor";
+  targetPkgs = pkgs: (with pkgs; [
+    # for running factor
+    gtk2-x11
+    glib
+    gdk_pixbuf
+    gnome2.pango
+    cairo
+    gnome2.gtkglext
+
+    # for building factor
+    clang
+    git
+    curl
+    binutils
+  ]);
+  runScript = "bash";
+}).env

From 3c789cb0a7eff44a78fc4dd5de9ebe77276c65b1 Mon Sep 17 00:00:00 2001
From: timor <timor.dd@googlemail.com>
Date: Wed, 16 Oct 2019 14:10:26 +0200
Subject: [PATCH 03/11] Simplify nix shell environment

`buildFHSUserEnv` uses `chroot` to create a kind of sandbox environment.  This
change uses a simpler mechanism, and also provides the necessary libraries for
running all the demos.
---
 shell.nix | 33 ++++++++++++++++++++-------------
 1 file changed, 20 insertions(+), 13 deletions(-)

diff --git a/shell.nix b/shell.nix
index 458964dc7f..e1576d3cb1 100644
--- a/shell.nix
+++ b/shell.nix
@@ -1,20 +1,27 @@
 { pkgs ? import <nixpkgs> {} }:
-(pkgs.buildFHSUserEnv {
-  name = "factor";
-  targetPkgs = pkgs: (with pkgs; [
-    # for running factor
-    gtk2-x11
+with pkgs;
+let
+  mkClangShell = mkShell.override { stdenv = clangStdenv; };
+  runtimeLibs = with xorg; [
     glib
+    pango cairo
+    gtk2-x11
     gdk_pixbuf
-    gnome2.pango
-    cairo
     gnome2.gtkglext
-
+    pcre
+    mesa_glu
+    freealut
+    openssl
+    udis86 # available since NixOS 19.09
+    openal
+  ];
+in
+(mkClangShell {
+  name = "factor-shell-env";
+  LD_LIBRARY_PATH = "/run/opengl-driver/lib:${lib.makeLibraryPath runtimeLibs}" ;
+  buildInputs = runtimeLibs ++ [
     # for building factor
-    clang
     git
     curl
-    binutils
-  ]);
-  runScript = "bash";
-}).env
+  ];
+})

From 114f58d894840b3c2057865b5869d63981113bcc Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 13 Jul 2018 20:36:07 -0500
Subject: [PATCH 04/11] lists: Add list literals.

Fixes #2019.
---
 basis/lists/lists.factor                 | 6 +++++-
 basis/prettyprint/backend/backend.factor | 7 +++++--
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/basis/lists/lists.factor b/basis/lists/lists.factor
index 8bb8b73ea6..206752f7ca 100644
--- a/basis/lists/lists.factor
+++ b/basis/lists/lists.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 James Cash, Daniel Ehrenberg, Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators.short-circuit kernel locals math
-sequences ;
+parser sequences ;
 IN: lists
 
 ! List Protocol
@@ -102,3 +102,7 @@ INSTANCE: +nil+ list
 GENERIC: >list ( object -- list )
 
 M: list >list ;
+
+M: sequence >list sequence>list ;
+
+SYNTAX: L{ \ } [ sequence>list ] parse-literal ;
\ No newline at end of file
diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor
index e2f58de6e2..fd9ce81f0f 100644
--- a/basis/prettyprint/backend/backend.factor
+++ b/basis/prettyprint/backend/backend.factor
@@ -3,8 +3,8 @@
 USING: accessors arrays assocs byte-arrays byte-vectors classes
 classes.algebra.private classes.maybe classes.private
 classes.tuple combinators continuations effects generic
-hash-sets hashtables io.pathnames io.styles kernel make math
-math.order math.parser namespaces prettyprint.config
+hash-sets hashtables io.pathnames io.styles kernel lists make
+math math.order math.parser namespaces prettyprint.config
 prettyprint.custom prettyprint.sections prettyprint.stylesheet
 quotations sbufs sequences strings vectors words ;
 QUALIFIED: sets
@@ -213,6 +213,7 @@ M: array pprint-delims drop \ { \ } ;
 M: byte-array pprint-delims drop \ B{ \ } ;
 M: byte-vector pprint-delims drop \ BV{ \ } ;
 M: vector pprint-delims drop \ V{ \ } ;
+M: list pprint-delims drop \ L{ \ } ;
 M: hashtable pprint-delims drop \ H{ \ } ;
 M: tuple pprint-delims drop \ T{ \ } ;
 M: wrapper pprint-delims drop \ W{ \ } ;
@@ -227,6 +228,7 @@ M: object >pprint-sequence ;
 M: vector >pprint-sequence ;
 M: byte-vector >pprint-sequence ;
 M: callable >pprint-sequence ;
+M: list >pprint-sequence list>array ;
 M: hashtable >pprint-sequence >alist ;
 M: wrapper >pprint-sequence wrapped>> 1array ;
 M: callstack >pprint-sequence callstack>array ;
@@ -268,6 +270,7 @@ M: byte-vector pprint* pprint-object ;
     nesting-limit [ dup [ 1 + ] [ f ] if* ] change
     [ nesting-limit set ] curry finally ; inline
 
+M: list pprint* pprint-object ;
 M: hashtable pprint*
     [ pprint-object ] with-extra-nesting-level ;
 M: curried pprint* pprint-object ;

From 4b45df48f8543509e6776aabe3d80e59443d7042 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 16 Oct 2019 10:01:56 -0700
Subject: [PATCH 05/11] prettyprint.backend: lists only print car and "~more~"
 for cdr.

---
 basis/prettyprint/backend/backend.factor | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor
index fd9ce81f0f..463a234c8a 100644
--- a/basis/prettyprint/backend/backend.factor
+++ b/basis/prettyprint/backend/backend.factor
@@ -266,11 +266,23 @@ M: object pprint* pprint-object ;
 M: vector pprint* pprint-object ;
 M: byte-vector pprint* pprint-object ;
 
+M: list pprint*
+    [
+        <flow
+        dup pprint-delims [
+            pprint-word
+            dup pprint-narrow? <inset
+            dup nil? [ drop ] [
+                [ car pprint* ]
+                [ cdr nil? [ "~more~" text ] unless ] bi
+            ] if block>
+        ] dip pprint-word block>
+    ] check-recursion ;
+
 : with-extra-nesting-level ( quot -- )
     nesting-limit [ dup [ 1 + ] [ f ] if* ] change
     [ nesting-limit set ] curry finally ; inline
 
-M: list pprint* pprint-object ;
 M: hashtable pprint*
     [ pprint-object ] with-extra-nesting-level ;
 M: curried pprint* pprint-object ;

From 6cc7ca2a970faa7b800c862447cf36702eed315c Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 16 Oct 2019 10:11:46 -0700
Subject: [PATCH 06/11] prettyprint.backend: print only cons-states.

---
 basis/prettyprint/backend/backend.factor | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor
index 463a234c8a..1e433709c5 100644
--- a/basis/prettyprint/backend/backend.factor
+++ b/basis/prettyprint/backend/backend.factor
@@ -213,7 +213,7 @@ M: array pprint-delims drop \ { \ } ;
 M: byte-array pprint-delims drop \ B{ \ } ;
 M: byte-vector pprint-delims drop \ BV{ \ } ;
 M: vector pprint-delims drop \ V{ \ } ;
-M: list pprint-delims drop \ L{ \ } ;
+M: cons-state pprint-delims drop \ L{ \ } ;
 M: hashtable pprint-delims drop \ H{ \ } ;
 M: tuple pprint-delims drop \ T{ \ } ;
 M: wrapper pprint-delims drop \ W{ \ } ;
@@ -228,7 +228,6 @@ M: object >pprint-sequence ;
 M: vector >pprint-sequence ;
 M: byte-vector >pprint-sequence ;
 M: callable >pprint-sequence ;
-M: list >pprint-sequence list>array ;
 M: hashtable >pprint-sequence >alist ;
 M: wrapper >pprint-sequence wrapped>> 1array ;
 M: callstack >pprint-sequence callstack>array ;
@@ -266,16 +265,15 @@ M: object pprint* pprint-object ;
 M: vector pprint* pprint-object ;
 M: byte-vector pprint* pprint-object ;
 
-M: list pprint*
+M: cons-state pprint*
     [
         <flow
         dup pprint-delims [
             pprint-word
             dup pprint-narrow? <inset
-            dup nil? [ drop ] [
-                [ car pprint* ]
-                [ cdr nil? [ "~more~" text ] unless ] bi
-            ] if block>
+            [ car pprint* ]
+            [ cdr nil? [ "~more~" text ] unless ] bi
+            block>
         ] dip pprint-word block>
     ] check-recursion ;
 

From f513a14e1c45c44f41b7e82bdbf2f646bf56fc86 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 24 Oct 2019 09:09:17 -0700
Subject: [PATCH 07/11] prettyprint.backend: print up to length-limit lists.

---
 basis/prettyprint/backend/backend.factor | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor
index 1e433709c5..cd3d388205 100644
--- a/basis/prettyprint/backend/backend.factor
+++ b/basis/prettyprint/backend/backend.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs byte-arrays byte-vectors classes
 classes.algebra.private classes.maybe classes.private
-classes.tuple combinators continuations effects generic
+classes.tuple combinators continuations effects fry generic
 hash-sets hashtables io.pathnames io.styles kernel lists make
 math math.order math.parser namespaces prettyprint.config
 prettyprint.custom prettyprint.sections prettyprint.stylesheet
@@ -271,8 +271,13 @@ M: cons-state pprint*
         dup pprint-delims [
             pprint-word
             dup pprint-narrow? <inset
-            [ car pprint* ]
-            [ cdr nil? [ "~more~" text ] unless ] bi
+            [
+                building get
+                length-limit get
+                '[ dup cons-state? _ length _ < and ]
+                [ uncons swap , ] while
+            ] { } make
+            [ pprint* ] each nil? [ "~more~" text ] unless
             block>
         ] dip pprint-word block>
     ] check-recursion ;

From cb091281bbd7e16dfc93d6c1033bcd911282cc7a Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 24 Oct 2019 13:54:58 -0700
Subject: [PATCH 08/11] math.floats.env: use $sequence in docs.

---
 basis/math/floats/env/env-docs.factor | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/basis/math/floats/env/env-docs.factor b/basis/math/floats/env/env-docs.factor
index ed511d70e2..f7ceedd544 100644
--- a/basis/math/floats/env/env-docs.factor
+++ b/basis/math/floats/env/env-docs.factor
@@ -55,11 +55,11 @@ HELP: +denormal-flush+
 { $class-description "This symbol represents the non-IEEE-754-compliant flush-denormals-to-zero " { $link fp-denormal-mode } "." } ;
 
 HELP: fp-exception-flags
-{ $values { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
+{ $values { "exceptions" { $sequence fp-exception } } }
 { $description "Returns the set of floating-point exception flags that have been raised." } ;
 
 HELP: set-fp-exception-flags
-{ $values { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
+{ $values { "exceptions" { $sequence fp-exception } } }
 { $description "Replaces the set of floating-point exception flags with the set specified in " { $snippet "exceptions" } "." }
 { $notes "On Intel platforms, the legacy x87 floating-point unit does not support setting exception flags, so this word only clears the x87 exception flags. However, the SSE unit's flags are set as expected." } ;
 
@@ -67,7 +67,7 @@ HELP: clear-fp-exception-flags
 { $description "Clears all of the floating-point exception flags." } ;
 
 HELP: collect-fp-exceptions
-{ $values { "quot" quotation } { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
+{ $values { "quot" quotation } { "exceptions" { $sequence fp-exception } } }
 { $description "Clears the floating-point exception flags and then calls " { $snippet "quot" } ", returning the set of floating-point exceptions raised during its execution and placing them on the datastack on " { $snippet "quot" } "'s completion." } ;
 
 { fp-exception-flags set-fp-exception-flags clear-fp-exception-flags collect-fp-exceptions } related-words
@@ -93,11 +93,11 @@ HELP: with-rounding-mode
 { rounding-mode with-rounding-mode } related-words
 
 HELP: fp-traps
-{ $values { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
+{ $values { "exceptions" { $sequence fp-exception } } }
 { $description "Returns the set of floating point exceptions with processor traps currently set." } ;
 
 HELP: with-fp-traps
-{ $values { "exceptions" "a sequence of " { $link fp-exception } " symbols" } { "quot" quotation } }
+{ $values { "exceptions" { $sequence fp-exception } } { "quot" quotation } }
 { $description "Clears the floating-point exception flags and replaces the exception mask, enabling processor traps for the set of exception conditions specified in " { $snippet "exceptions" } " for the dynamic extent of " { $snippet "quot" } ". The original exception mask is restored on " { $snippet "quot" } "'s completion." } ;
 
 HELP: without-fp-traps
@@ -107,7 +107,7 @@ HELP: without-fp-traps
 { fp-traps with-fp-traps without-fp-traps vm-error>exception-flags vm-error-exception-flag? } related-words
 
 HELP: vm-error>exception-flags
-{ $values { "error" "a floating-point error object from the Factor VM" } { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
+{ $values { "error" "a floating-point error object from the Factor VM" } { "exceptions" { $sequence fp-exception } } }
 { $description "When a floating-point trap is raised, the Factor VM reports the trap by throwing a Factor exception containing the exception flags at the time the trap was raised. This word extracts the exception flag information from " { $snippet "error" } " and converts it into a sequence of " { $link fp-exception } "s." } ;
 
 HELP: vm-error-exception-flag?

From 738113d52448b9854a75deb8ee2f17049495d61f Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 24 Oct 2019 14:10:41 -0700
Subject: [PATCH 09/11] classes: update docs with $sequence.

---
 core/classes/algebra/algebra-docs.factor           | 6 +++---
 core/classes/classes-docs.factor                   | 6 +++---
 core/classes/intersection/intersection-docs.factor | 2 +-
 core/classes/tuple/tuple-docs.factor               | 4 ++--
 core/classes/union/union-docs.factor               | 4 ++--
 5 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/core/classes/algebra/algebra-docs.factor b/core/classes/algebra/algebra-docs.factor
index 747bbf6d0d..76c7c70bbf 100644
--- a/core/classes/algebra/algebra-docs.factor
+++ b/core/classes/algebra/algebra-docs.factor
@@ -41,11 +41,11 @@ $nl
 { $subsections rank-class } ;
 
 HELP: flatten-class
-{ $values { "class" class } { "assoc" "an assoc whose keys are classes" } }
+{ $values { "class" class } { "seq" { $sequence class } } }
 { $description "Outputs a set of builtin and tuple classes whose union is the smallest cover of " { $snippet "class" } "." } ;
 
 HELP: class<=
-{ $values { "first" "a class" } { "second" "a class" } { "?" boolean } }
+{ $values { "first" class } { "second" class } { "?" boolean } }
 { $description "Tests if all instances of " { $snippet "class1" } " are also instances of " { $snippet "class2" } "." }
 { $notes "Classes are partially ordered. This means that if " { $snippet "class1 <= class2" } " and " { $snippet "class2 <= class1" } ", then " { $snippet "class1 <= class2" } ". Also, if " { $snippet "class1 <= class2" } " and " { $snippet "class2 <= class3" } ", then " { $snippet "class1 <= class3" } "." } ;
 
@@ -74,5 +74,5 @@ HELP: smallest-class
 { $description "Outputs a minimum class from the given sequence." } ;
 
 HELP: sort-classes
-{ $values { "seq" "a sequence of class" } { "newseq" "a new sequence of classes" } }
+{ $values { "seq" { $sequence class } } { "newseq" { $sequence class } } }
 { $description "Outputs a linear sort of a sequence of classes. Larger classes come before their subclasses." } ;
diff --git a/core/classes/classes-docs.factor b/core/classes/classes-docs.factor
index bc75d45f42..e88ab89c34 100644
--- a/core/classes/classes-docs.factor
+++ b/core/classes/classes-docs.factor
@@ -87,7 +87,7 @@ HELP: class-usage
 { $description "Lists all classes that uses or depends on this class." } ;
 
 HELP: classes
-{ $values { "seq" "a sequence of class words" } }
+{ $values { "seq" { $sequence class } } }
 { $description "Finds all class words in the dictionary." } ;
 
 HELP: contained-classes
@@ -166,12 +166,12 @@ HELP: class-participants
 { $description "If " { $snippet "class" } " is an intersection class, outputs a sequence of its participant classes, otherwise outputs " { $link f } "." } ;
 
 HELP: define-class
-{ $values { "word" word } { "superclass" class } { "members" "a sequence of class words" } { "participants" "a sequence of class words" } { "metaclass" class } }
+{ $values { "word" word } { "superclass" class } { "members" { $sequence class } } { "participants" { $sequence class } } { "metaclass" class } }
 { $description "Sets a property indicating this word is a class word, thus making it an instance of " { $link class } ", and registers it with " { $link update-map } "." }
 $low-level-note ;
 
 HELP: implementors
-{ $values { "class/classes" "a class or a sequence of classes" } { "seq" "a sequence of generic words" } }
+{ $values { "class/classes" { $or class { $sequence class } } } { "seq" "a sequence of generic words" } }
 { $description "Finds all generic words in the dictionary implementing methods for the given set of classes." } ;
 
 HELP: instance?
diff --git a/core/classes/intersection/intersection-docs.factor b/core/classes/intersection/intersection-docs.factor
index 7b20621e4c..3c8b3f7293 100644
--- a/core/classes/intersection/intersection-docs.factor
+++ b/core/classes/intersection/intersection-docs.factor
@@ -19,7 +19,7 @@ ARTICLE: "intersections" "Intersection classes"
 ABOUT: "intersections"
 
 HELP: define-intersection-class
-{ $values { "class" class } { "participants" "a sequence of classes" } }
+{ $values { "class" class } { "participants" { $sequence class } } }
 { $description "Defines a intersection class with specified participants. This is the run time equivalent of " { $link POSTPONE: INTERSECTION: } "." }
 { $notes "This word must be called from inside " { $link with-compilation-unit } "." }
 { $side-effects "class" } ;
diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor
index b1d20a04d6..b3ae92dbd5 100644
--- a/core/classes/tuple/tuple-docs.factor
+++ b/core/classes/tuple/tuple-docs.factor
@@ -373,7 +373,7 @@ HELP: define-tuple-predicate
 $low-level-note ;
 
 HELP: redefine-tuple-class
-{ $values { "class" class } { "superclass" class } { "slots" "a sequence of strings" } }
+{ $values { "class" class } { "superclass" class } { "slots" { $sequence string } } }
 { $description "If the new slot layout differs from the existing one, updates all existing instances of this tuple class, and forgets any slot accessor words which are no longer needed."
 $nl
 "If the class is not a tuple class word, this word does nothing." }
@@ -396,7 +396,7 @@ HELP: check-tuple
 { $error-description "Thrown if " { $link POSTPONE: C: } " is called with a word which does not name a tuple class." } ;
 
 HELP: define-tuple-class
-{ $values { "class" word } { "superclass" class } { "slots" "a sequence of strings" } }
+{ $values { "class" word } { "superclass" class } { "slots" { $sequence string } } }
 { $description "Defines a tuple class inheriting from " { $snippet "superclass" } " with slots named by " { $snippet "slots" } ". This is the run time equivalent of " { $link POSTPONE: TUPLE: } "." }
 { $notes "This word must be called from inside " { $link with-compilation-unit } "." }
 { $side-effects "class" } ;
diff --git a/core/classes/union/union-docs.factor b/core/classes/union/union-docs.factor
index 2335151e58..911fa2e2c4 100644
--- a/core/classes/union/union-docs.factor
+++ b/core/classes/union/union-docs.factor
@@ -21,12 +21,12 @@ ARTICLE: "unions" "Union classes"
 ABOUT: "unions"
 
 HELP: (define-union-class)
-{ $values { "class" class } { "members" "a sequence of classes" } }
+{ $values { "class" class } { "members" { $sequence class } } }
 { $description "Defines a union class." }
 { $errors "Throws " { $link cannot-reference-self } " if the definition references itself." } ;
 
 HELP: define-union-class
-{ $values { "class" class } { "members" "a sequence of classes" } }
+{ $values { "class" class } { "members" { $sequence class } } }
 { $description "Defines a union class with specified members. This is the run time equivalent of " { $link POSTPONE: UNION: } "." }
 { $notes "This word must be called from inside " { $link with-compilation-unit } "." }
 { $side-effects "class"

From 80bd0feaef507804fde16a310c1fd6b7c8a7084b Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 24 Oct 2019 14:12:26 -0700
Subject: [PATCH 10/11] classes.algebra: change (flatten-class) to use arrays.

---
 core/classes/algebra/algebra.factor           | 4 ++--
 core/classes/builtin/builtin.factor           | 2 +-
 core/classes/intersection/intersection.factor | 4 ++--
 core/classes/tuple/tuple.factor               | 2 +-
 core/classes/union/union.factor               | 3 +--
 core/generic/single/single.factor             | 3 +--
 6 files changed, 8 insertions(+), 10 deletions(-)

diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor
index 8b92932adc..a01bc3ff54 100644
--- a/core/classes/algebra/algebra.factor
+++ b/core/classes/algebra/algebra.factor
@@ -288,5 +288,5 @@ ERROR: topological-sort-failed ;
         [ ] [ [ class<= ] most ] map-reduce
     ] if-empty ;
 
-: flatten-class ( class -- assoc )
-    [ (flatten-class) ] H{ } make ;
+: flatten-class ( class -- seq )
+    [ (flatten-class) ] { } make members ;
diff --git a/core/classes/builtin/builtin.factor b/core/classes/builtin/builtin.factor
index 72178f62f2..74c868a17a 100644
--- a/core/classes/builtin/builtin.factor
+++ b/core/classes/builtin/builtin.factor
@@ -26,7 +26,7 @@ M: builtin-class rank-class drop 0 ;
 
 M: builtin-class instance? [ tag ] [ class>type ] bi* eq? ;
 
-M: builtin-class (flatten-class) dup ,, ;
+M: builtin-class (flatten-class) , ;
 
 M: builtin-class (classes-intersect?) eq? ;
 
diff --git a/core/classes/intersection/intersection.factor b/core/classes/intersection/intersection.factor
index 1e423a472f..bd18ca61b6 100644
--- a/core/classes/intersection/intersection.factor
+++ b/core/classes/intersection/intersection.factor
@@ -46,9 +46,9 @@ M: intersection-class (flatten-class)
 
 M: anonymous-intersection (flatten-class)
     participants>> [ full-cover ] [
-        [ flatten-class keys ]
+        [ flatten-class ]
         [ intersect-flattened-classes ] map-reduce
-        [ dup ,, ] each
+        %
     ] if-empty ;
 
 M: anonymous-intersection class-name
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index d7362c83c1..ec6fc5f76c 100644
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -358,7 +358,7 @@ M: tuple-class rank-class drop 1 ;
 M: tuple-class instance?
     dup echelon-of layout-class-offset tuple-instance? ;
 
-M: tuple-class (flatten-class) dup ,, ;
+M: tuple-class (flatten-class) , ;
 
 M: tuple-class (classes-intersect?)
     {
diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor
index 05bb9bee3d..b90d756bce 100644
--- a/core/classes/union/union.factor
+++ b/core/classes/union/union.factor
@@ -22,8 +22,7 @@ M: class union-of-builtins?
     drop f ;
 
 : fast-union-mask ( class -- n )
-    [ 0 ] dip flatten-class
-    [ drop class>type 2^ bitor ] assoc-each ;
+    flatten-class 0 [ class>type 2^ bitor ] each ;
 
 : empty-union-predicate-quot ( class -- quot )
     drop [ drop f ] ;
diff --git a/core/generic/single/single.factor b/core/generic/single/single.factor
index bef4a22765..bc255e72ee 100644
--- a/core/generic/single/single.factor
+++ b/core/generic/single/single.factor
@@ -81,8 +81,7 @@ C: <predicate-engine> predicate-engine
     ] change-at ;
 
 : flatten-method ( method class assoc -- )
-    over flatten-class keys
-    [ swap push-method ] 2with with each ;
+    over flatten-class [ swap push-method ] 2with with each ;
 
 : flatten-methods ( assoc -- assoc' )
     H{ } clone [ [ swapd flatten-method ] curry assoc-each ] keep ;

From 61964d0f4677df2e9c1266d61aca116dcc26e54f Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 24 Oct 2019 14:14:01 -0700
Subject: [PATCH 11/11] classes.union: woops, reduce in fast-union-mask.

---
 core/classes/union/union.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor
index b90d756bce..e7a0acf955 100644
--- a/core/classes/union/union.factor
+++ b/core/classes/union/union.factor
@@ -22,7 +22,7 @@ M: class union-of-builtins?
     drop f ;
 
 : fast-union-mask ( class -- n )
-    flatten-class 0 [ class>type 2^ bitor ] each ;
+    flatten-class 0 [ class>type 2^ bitor ] reduce ;
 
 : empty-union-predicate-quot ( class -- quot )
     drop [ drop f ] ;