Merge branch 'master' of git://factorcode.org/git/factor

core/assocs/assocs.factor

@@ -43,7 +43,7 @@ M: assoc assoc-find
     inline
 
 : assoc-push-if ( key value quot accum -- )
-    >r 2over 2slip r> roll
+    >r 2keep r> roll
     [ >r 2array r> push ] [ 3drop ] if ; inline
 
 : assoc-pusher ( quot -- quot' accum )
@@ -52,12 +52,12 @@ M: assoc assoc-find
 : assoc-subset ( assoc quot -- subassoc )
     over >r assoc-pusher >r assoc-each r> r> assoc-like ; inline
 
-: assoc-all? ( assoc quot -- ? )
-    [ not ] compose assoc-find 2nip not ; inline
-
 : assoc-contains? ( assoc quot -- ? )
     assoc-find 2nip ; inline
 
+: assoc-all? ( assoc quot -- ? )
+    [ not ] compose assoc-contains? not ; inline
+
 : at ( key assoc -- value/f )
     at* drop ; inline
 

core/continuations/continuations.factor

@@ -128,7 +128,7 @@ PRIVATE>
 
 : cleanup ( try cleanup-always cleanup-error -- )
     over >r compose [ dip rethrow ] curry
-    >r (catch) r> ifcc r> call ; inline
+    recover r> call ; inline
 
 : attempt-all ( seq quot -- obj )
     [

core/cpu/x86/32/32.factor

@@ -46,7 +46,7 @@ M: float-regs push-return-reg
 
 : FLD 4 = [ FLDS ] [ FLDL ] if ;
 
-: load/store-float-return reg-size >r stack-reg swap [+] r> ;
+: load/store-float-return reg-size >r stack@ r> ;
 M: float-regs load-return-reg load/store-float-return FLD ;
 M: float-regs store-return-reg load/store-float-return FSTP ;
 

core/io/files/files.factor

@@ -35,7 +35,11 @@ M: object root-directory? ( path -- ? ) path-separator? ;
 : stat ( path -- directory? permissions length modified )
     normalize-pathname (stat) ;
 
-: exists? ( path -- ? ) stat >r 3drop r> >boolean ;
+: file-length ( path -- n ) stat 4array third ;
+
+: file-modified ( path -- n ) stat >r 3drop r> ; inline
+
+: exists? ( path -- ? ) file-modified >boolean ;
 
 : directory? ( path -- ? ) stat 3drop ;
 
@@ -52,10 +56,6 @@ M: object root-directory? ( path -- ? ) path-separator? ;
 : directory ( path -- seq )
     normalize-directory dup (directory) fixup-directory ;
 
-: file-length ( path -- n ) stat 4array third ;
-
-: file-modified ( path -- n ) stat >r 3drop r> ;
-
 : last-path-separator ( path -- n ? )
     [ length 2 [-] ] keep [ path-separator? ] find-last* ;
 

core/math/intervals/intervals.factor

@@ -68,7 +68,7 @@ C: <interval> interval
 : (interval-op) ( p1 p2 quot -- p3 )
     2over >r >r
     >r [ first ] 2apply r> call
-    r> r> [ second ] 2apply and 2array ; inline
+    r> r> [ second ] both? 2array ; inline
 
 : interval-op ( i1 i2 quot -- i3 )
     pick interval-from pick interval-from pick (interval-op) >r

core/threads/threads.factor

@@ -32,7 +32,7 @@ PRIVATE>
 
 : stop ( -- )
     walker-hook [
-        f swap continue-with
+        continue
     ] [
         run-queue pop-back dup array?
         [ first2 continue-with ] [ continue ] if

core/tuples/tuples.factor

@@ -15,7 +15,7 @@ M: tuple class class-of-tuple ;
 <PRIVATE
 
 : tuple= ( tuple1 tuple2 -- ? )
-    over array-capacity over array-capacity dup -rot number= [
+    over array-capacity over array-capacity tuck number= [
         -rot
         [ >r over r> array-nth >r array-nth r> = ] 2curry
         all-integers?

core/vocabs/vocabs.factor

@@ -102,7 +102,7 @@ M: vocab-link vocab-name vocab-link-name ;
 UNION: vocab-spec vocab vocab-link ;
 
 : forget-vocab ( vocab -- )
-    dup vocab-words values forget-all
+    dup words forget-all
     vocab-name dictionary get delete-at ;
 
 M: vocab-spec forget* forget-vocab ;

extra/calendar/calendar.factor

@@ -4,7 +4,7 @@
 USING: arrays hashtables io io.streams.string kernel math
 math.vectors math.functions math.parser namespaces sequences
 strings tuples system debugger combinators vocabs.loader
-calendar.backend structs alien.c-types ;
+calendar.backend structs alien.c-types math.vectors ;
 IN: calendar
 
 TUPLE: timestamp year month day hour minute second gmt-offset ;
@@ -96,12 +96,12 @@ SYMBOL: m
 : zero-dt ( -- <dt> ) 0 0 0 0 0 0 <dt> ;
 : years ( n -- dt ) zero-dt [ set-dt-year ] keep ;
 : months ( n -- dt ) zero-dt [ set-dt-month ] keep ;
-: weeks ( n -- dt ) 7 * zero-dt [ set-dt-day ] keep ;
 : days ( n -- dt ) zero-dt [ set-dt-day ] keep ;
+: weeks ( n -- dt ) 7 * days ;
 : hours ( n -- dt ) zero-dt [ set-dt-hour ] keep ;
 : minutes ( n -- dt ) zero-dt [ set-dt-minute ] keep ;
 : seconds ( n -- dt ) zero-dt [ set-dt-second ] keep ;
-: milliseconds ( n -- dt ) 1000 /f zero-dt [ set-dt-second ] keep ;
+: milliseconds ( n -- dt ) 1000 /f seconds ;
 
 : julian-day-number>timestamp ( n -- timestamp )
     julian-day-number>date 0 0 0 0 <timestamp> ;
@@ -186,7 +186,8 @@ M: number +second ( timestamp n -- timestamp )
     #! data
     tuple-slots
     { 1 12 365.2425 8765.82 525949.2 31556952.0 }
-    [ / ] 2map sum ;
+    v/ sum ;
+
 : dt>months ( dt -- x ) dt>years 12 * ;
 : dt>days ( dt -- x ) dt>years 365.2425 * ;
 : dt>hours ( dt -- x ) dt>years 8765.82 * ;
@@ -235,7 +236,7 @@ M: timestamp <=> ( ts1 ts2 -- n )
     unix-1970 millis 1000 /f seconds +dt ;
 
 : now ( -- timestamp ) gmt >local-time ;
-: before ( dt -- -dt ) tuple-slots [ neg ] map array>dt ;
+: before ( dt -- -dt ) tuple-slots vneg array>dt ;
 : from-now ( dt -- timestamp ) now swap +dt ;
 : ago ( dt -- timestamp ) before from-now ;
 
@@ -258,10 +259,7 @@ M: timestamp <=> ( ts1 ts2 -- n )
     1+ + 7 mod ;
 
 : day-of-week ( timestamp -- n )
-    [ timestamp-year ] keep
+    >date< zeller-congruence ;
-    [ timestamp-month ] keep
-    timestamp-day
-    zeller-congruence ;
 
 : day-of-year ( timestamp -- n )
     [

extra/combinators/cleave/cleave.factor

@@ -7,7 +7,7 @@ IN: combinators.cleave
 ! The cleaver family
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: bi ( obj quot quot -- val val ) >r over slip r> call ; inline
+: bi ( obj quot quot -- val val ) >r keep r> call ; inline
 
 : tri ( obj quot quot quot -- val val val )
   >r pick >r bi r> r> call ; inline
@@ -23,7 +23,7 @@ IN: combinators.cleave
 ! The spread family
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: bi* ( obj obj quot quot -- val val ) >r swap >r call r> r> call ; inline
+: bi* ( obj obj quot quot -- val val ) >r swap slip r> call ; inline
 
 : tri* ( obj obj obj quot quot quot -- val val val )
   >r rot >r bi* r> r> call ; inline

extra/crypto/common/common.factor

@@ -40,7 +40,7 @@ SYMBOL: big-endian?
     ] "" make 64 group ;
 
 : shift-mod ( n s w -- n )
-    >r shift r> 1 swap shift 1 - bitand ; inline
+    >r shift r> 2^ 1- bitand ; inline
 
 : update-old-new ( old new -- )
     [ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline

extra/crypto/sha1/sha1.factor

@@ -126,7 +126,7 @@ SYMBOL: K
 : string>sha1-bignum ( string -- n ) string>sha1 be> ;
 : file>sha1 ( file -- sha1 ) <file-reader> stream>sha1 ;
 
-: string>sha1-interleave ( string -- )
+: string>sha1-interleave ( string -- seq )
     [ zero? ] left-trim
     dup length odd? [ 1 tail ] when
     seq>2seq [ string>sha1 ] 2apply

extra/editors/gvim/backend/backend.factor

@@ -0,0 +1,4 @@
+USING: io.backend ;
+IN: editors.gvim.backend
+
+HOOK: gvim-path io-backend ( -- path )

extra/editors/gvim/gvim.factor

@@ -1,13 +1,10 @@
 USING: io.backend io.files kernel math math.parser
-namespaces editors.vim sequences system combinators
+namespaces sequences system combinators
-vocabs.loader ;
+editors.vim editors.gvim.backend vocabs.loader ;
 IN: editors.gvim
 
 TUPLE: gvim ;
 
-HOOK: gvim-path io-backend ( -- path )
-
-
 M: gvim vim-command ( file line -- string )
     [ "\"" % gvim-path % "\" \"" % swap % "\" +" % # ] "" make ;
 

extra/editors/gvim/unix/unix.factor

@@ -1,4 +1,4 @@
-USING: editors.gvim io.unix.backend kernel namespaces ;
+USING: io.unix.backend kernel namespaces editors.gvim.backend ;
 IN: editors.gvim.unix
 
 M: unix-io gvim-path

extra/editors/vim/vim-docs.factor

@@ -1,5 +1,6 @@
-USING: definitions editors.vim help help.markup help.syntax io io.files
+USING: definitions help help.markup help.syntax io io.files
 editors words ;
+IN: editors.vim
 
 ARTICLE: { "vim" "vim" } "Vim support"
 "This module makes the " { $link edit } " word work with Vim by setting the " { $link edit-hook } " global variable to call " { $link vim-location } ". The " { $link vim-path } " variable contains the name of the vim executable.  The default " { $link vim-path } " is " { $snippet "\"gvim\"" } "."

extra/http/client/client.factor

@@ -29,7 +29,7 @@ IN: http.client
 : crlf "\r\n" write ;
 
 : http-request ( host resource method -- )
-    write " " write write " HTTP/1.0" write crlf
+    write bl write " HTTP/1.0" write crlf
     "Host: " write write crlf ;
 
 : get-request ( host resource -- )

extra/inverse/inverse.factor

@@ -69,7 +69,7 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
     } cond ;
 
 : math-exp? ( n n word -- ? )
-    { + - * / ^ } member? -rot [ number? ] 2apply and and ;
+    { + - * / ^ } member? -rot [ number? ] both? and ;
 
 : (fold-constants) ( quot -- )
     dup length 3 < [ % ] [

extra/lint/lint.factor

@@ -83,7 +83,8 @@ def-hash get-global [
 ! Remove n m shift defs
 [
     drop dup length 3 = [
-        dup first2 [ number? ] 2apply and swap third \ shift = and not
+        dup first2 [ number? ] both?
+        swap third \ shift = and not
     ] [ drop t ] if
 ] assoc-subset 
 
@@ -120,7 +121,7 @@ M: word lint ( word -- seq )
 : word-path. ( word -- )
     [ word-vocabulary ":" ] keep unparse 3append write nl ;
 
-: lint. ( array -- )
+: (lint.) ( pair -- )
     first2 >r word-path. r> [
         bl bl bl bl
         dup .
@@ -129,31 +130,45 @@ M: word lint ( word -- seq )
         nl
     ] each nl nl ;
 
+: lint. ( alist -- )
+    [ (lint.) ] each ;
+    
 
 GENERIC: run-lint ( obj -- obj )
 
-: trim-self ( seq -- newseq )
+: (trim-self)
-    [
-        first2 [
     def-hash get-global at* [
         dupd remove empty? not
     ] [
         drop f
-            ] if
+    ] if ;
-        ] subset 2array
+
-    ] map ;
+: trim-self ( seq -- newseq )
+    [ [ (trim-self) ] subset ] assoc-map ;
+
+: filter-symbols ( alist -- alist )
+    [
+        nip first dup def-hash get at
+        [ first ] 2apply literalize = not
+    ] assoc-subset ;
 
 M: sequence run-lint ( seq -- seq )
     [
         global [ dup . flush ] bind
-        dup lint 2array
+        dup lint
-    ] map
+    ] { } map>assoc
     trim-self
-    [ second empty? not ] subset ;
+    [ second empty? not ] subset
+    filter-symbols ;
 
 M: word run-lint ( word -- seq )
     1array run-lint ;
 
 : lint-all ( -- seq )
-    all-words run-lint dup [ lint. ] each ;
+    all-words run-lint dup lint. ;
 
+: lint-vocab ( vocab -- seq )
+    words run-lint dup lint. ;
+
+: lint-word ( word -- seq )
+    1array run-lint dup lint. ;

extra/math/miller-rabin/miller-rabin.factor

@@ -18,24 +18,21 @@ SYMBOL: trials
 : next-odd ( m -- n )
     dup even? [ 1+ ] [ 2 + ] if ;
 
-: random-bits ( m -- n )
+: random-bits ( m -- n ) 2^ random ; foldable
-    #! Top bit is always set
-    2^ [ random ] keep -1 shift bitor ; foldable
 
-: (factor-2s) ( s n -- s n )
+TUPLE: positive-even-expected n ;
+
+: (factor-2s) ( r s -- r s )
     dup even? [ -1 shift >r 1+ r> (factor-2s) ] when ;
 
 : factor-2s ( n -- r s )
-    #! factor an even number into 2 ^ s * m
+    #! factor an even number into s * 2 ^ r
     dup even? over 0 > and [
-        "input must be positive and even" throw
+        positive-even-expected construct-boa throw
     ] unless 0 swap (factor-2s) ;
 
 :: (miller-rabin) | n prime?! |
-    n dup 1 = over even? or [
+    n 1- factor-2s s set r set
-        drop f
-    ] [
-        1- factor-2s s set r set
     trials get [
         n 1- [1,b] random a set
         a get s get n ^mod 1 = [
@@ -52,9 +49,7 @@ SYMBOL: trials
             ] when
         ] unless
         drop
-        ] each
+    ] each prime? ;
-        prime?
-    ] if ;
 
 TUPLE: miller-rabin-bounds ;
 
@@ -62,6 +57,7 @@ TUPLE: miller-rabin-bounds ;
     over {
         { [ dup 1 <= ] [ 3drop f ] }
         { [ dup 2 = ] [ 3drop t ] }
+        { [ dup even? ] [ 3drop f ] }
         { [ t ] [ [ drop trials set t (miller-rabin) ] with-scope ] }
     } cond ;
 
@@ -81,10 +77,9 @@ TUPLE: miller-rabin-bounds ;
     >odd (find-relative-prime) ;
 
 : find-relative-prime ( n -- p )
-    dup random >odd (find-relative-prime) ;
+    dup random find-relative-prime* ;
 
 : unique-primes ( numbits n -- seq )
     #! generate two primes
     over 5 < [ "not enough primes below 5 bits" throw ] when
     [ [ drop random-prime ] with map ] [ all-unique? ] generate ;
-

extra/openal/other/other.factor

@@ -2,13 +2,13 @@
 ! See http://factorcode.org/license.txt for BSD license.
 !
 IN: openal.other
-USING: openal alien.c-types kernel alien alien.syntax shuffle combinators.lib ;
+USING: openal.backend alien.c-types kernel alien alien.syntax shuffle combinators.lib ;
 
 LIBRARY: alut
 
 FUNCTION: void alutLoadWAVFile ( ALbyte* fileName, ALenum* format, void** data, ALsizei* size, ALsizei* frequency, ALboolean* looping ) ;
 
-M: other-openal-impl load-wav-file ( filename -- format data size frequency )
+M: other-openal-backend load-wav-file ( filename -- format data size frequency )
   0 <int> f <void*> 0 <int> 0 <int>
   [ 0 <char> alutLoadWAVFile ] 4keep
   >r >r >r *int r> *void* r> *int r> *int ;

extra/opengl/opengl.factor

@@ -27,7 +27,7 @@ IN: opengl
     swap glBegin call glEnd ; inline
 
 : do-enabled ( what quot -- )
-    over glEnable swap slip glDisable ; inline
+    over glEnable dip glDisable ; inline
 
 : do-matrix ( mode quot -- )
     swap [ glMatrixMode glPushMatrix call ] keep

extra/pack/pack.factor

@@ -2,7 +2,7 @@ USING: alien alien.c-types arrays assocs byte-arrays inference
 inference.transforms io io.binary io.streams.string kernel
 math math.parser namespaces parser prettyprint
 quotations sequences strings threads vectors
-words macros ;
+words macros math.functions ;
 IN: pack
 
 SYMBOL: big-endian
@@ -10,9 +10,6 @@ SYMBOL: big-endian
 : big-endian? ( -- ? )
     1 <int> *char zero? ;
 
-: clear-bit ( m n -- o )
-    2^ bitnot bitand ;
-
 : >endian ( obj n -- str )
     big-endian get [ >be ] [ >le ] if ; inline
 
@@ -88,7 +85,7 @@ M: string b, ( n string -- ) heap-size b, ;
     "\0" read-until [ drop f ] unless ;
 
 : read-c-string* ( n -- str/f )
-    read [ 0 = ] right-trim dup empty? [ drop f ] when ;
+    read [ zero? ] right-trim dup empty? [ drop f ] when ;
 
 : (read-128-ber) ( n -- n )
     1 read first

extra/peg/ebnf/ebnf.factor

@@ -170,7 +170,7 @@ DEFER: 'choice'
              [
                get-parser [
                  swap , \ in , \ get , \ create ,
-                 1quotation , \ define-compound , 
+                 1quotation , \ define , 
                ] [
                  drop
                ] if*

extra/peg/peg-docs.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax peg ;
+USING: help.markup help.syntax ;
+IN: peg
 
 HELP: parse
 { $values 

extra/random-tester/random-tester.factor

@@ -22,7 +22,7 @@ TUPLE: random-tester-error ;
     datastack clone after set
     clear
     before get [ ] each
-    quot get [ compile-1 ] [ errored on ] recover ;
+    quot get [ compile-call ] [ errored on ] recover ;
 
 : do-test ! ( data... quot -- )
     .s flush test-compiler

extra/random-weighted/random-weighted.factor

@@ -4,7 +4,7 @@ USING: kernel namespaces arrays quotations sequences assocs combinators
 
 IN: random-weighted
 
-: probabilities ( weights -- probabilities ) dup sum [ / ] curry map ;
+: probabilities ( weights -- probabilities ) dup sum v/n ;
 
 : layers ( probabilities -- layers )
 dup length 1+ [ head ] with map 1 tail [ sum ] map ;

extra/random/random.factor

@@ -36,7 +36,7 @@ SYMBOL: mt
 
 : set-mt-ith ( y i-get i-set -- )
     >r mt-nth >r
-    [ -1 shift ] keep odd? mt-a 0 ? r> bitxor bitxor r>
+    [ 2/ ] keep odd? mt-a 0 ? r> bitxor bitxor r>
     mt-seq set-nth ; inline
 
 : mt-y ( y1 y2 -- y )

extra/sequences/lib/lib.factor

@@ -59,7 +59,7 @@ IN: sequences.lib
     ] { } make ;
 
 : singleton? ( seq -- ? )
-    length 1 = ;
+    length 1 = ; foldable
 
 : delete-random ( seq -- value )
     [ length random ] keep [ nth ] 2keep delete-nth ;

extra/tar/tar.factor

@@ -35,7 +35,7 @@ linkname magic version uname gname devmajor devminor prefix ;
 
 : header-checksum ( seq -- x )
     148 cut-slice 8 tail-slice
-    [ 0 [ + ] reduce ] 2apply + 256 + ;
+    [ sum ] 2apply + 256 + ;
 
 TUPLE: checksum-error ;
 TUPLE: malformed-block-error ;
@@ -164,7 +164,7 @@ TUPLE: unimplemented-typeflag header ;
 ! Long file name
 : typeflag-L ( header -- )
     <string-writer> [ read-data-blocks ] keep
-    >string [ CHAR: \0 = ] right-trim filename set
+    >string [ zero? ] right-trim filename set
     global [ "long filename: " write filename get . flush ] bind
     filename get tar-path+ make-directories ;
 
@@ -196,7 +196,7 @@ TUPLE: unimplemented-typeflag header ;
         ! global [ dup tar-header-name [ print flush ] when* ] bind 
         dup tar-header-typeflag
         {
-            { CHAR: \0 [ typeflag-0 ] }
+            { 0 [ typeflag-0 ] }
             { CHAR: 0 [ typeflag-0 ] }
             { CHAR: 1 [ typeflag-1 ] }
             { CHAR: 2 [ typeflag-2 ] }

extra/visitor/authors.txt

@@ -1 +0,0 @@
-Daniel Ehrenberg

extra/visitor/summary.txt

@@ -1 +0,0 @@
-Double-dispatch generic words

extra/visitor/tags.txt

@@ -1 +0,0 @@
-extensions

extra/visitor/visitor-tests.factor

@@ -1,18 +0,0 @@
-USING: visitor math sequences math.parser strings tools.test kernel ;
-
-VISITOR: ++ ( object object -- object )
-! acts like +, coercing string arguments to a number, unless both arguments are strings, in which case it appends them
-
-V: number string ++
-    string>number + ;
-V: string number ++
-    >r string>number r> + ;
-V: number number ++
-    + ;
-V: string string ++
-    append ;
-
-[ 3 ] [ 1 2 ++ ] unit-test
-[ 3 ] [ "1" 2 ++ ] unit-test
-[ 3 ] [ 1 "2" ++ ] unit-test
-[ "12" ] [ "1" "2" ++ ] unit-test

extra/visitor/visitor.factor

@@ -1,63 +0,0 @@
-USING: kernel generic.standard syntax words parser assocs
-generic quotations sequences effects arrays classes definitions
-prettyprint sorting prettyprint.backend shuffle ;
-IN: visitor
-
-: define-visitor ( word -- )
-    dup dup reset-word define-simple-generic
-    dup H{ } clone "visitor-methods" set-word-prop
-    H{ } clone "visitors" set-word-prop ; 
-
-: VISITOR:
-    CREATE define-visitor ; parsing
-
-: record-visitor ( top-class generic method-word -- )
-    swap "visitors" word-prop swapd set-at ;
-
-: define-1generic ( word -- )
-    1 <standard-combination> define-generic ;
-
-: copy-effect ( from to -- )
-    swap stack-effect "declared-effect" set-word-prop ;
-
-: new-vmethod ( method bottom-class top-class generic -- )
-    gensym dup define-1generic
-    2dup copy-effect
-    3dup 1quotation -rot define-method
-    [ record-visitor ] keep
-    define-method ;
-
-: define-visitor-method ( method bottom-class top-class generic -- )
-    4dup >r 2array r> "visitor-methods" word-prop set-at
-    2dup "visitors" word-prop at
-    [ nip define-method ] [ new-vmethod ] ?if ;
-
-: V:
-    ! syntax: V: bottom-class top-class generic body... ;
-    f set-word scan-word scan-word scan-word
-    parse-definition -roll define-visitor-method ; parsing
-
-! see instance:
-! see must be redone because "methods" doesn't show methods
-
-PREDICATE: standard-generic visitor "visitors" word-prop ;
-PREDICATE: array triple length 3 = ;
-PREDICATE: triple visitor-spec
-    first3 visitor? >r [ class? ] 2apply and r> and ;
-
-M: visitor-spec definer drop \ V: \ ; ;
-M: visitor definer drop \ VISITOR: f ;
-
-M: visitor-spec synopsis*
-    ! same as method-spec#synopsis*
-    dup definer drop pprint-word
-    [ pprint-word ] each ;
-
-M: visitor-spec definition
-    first3 >r 2array r> "visitor-methods" word-prop at ;
-
-M: visitor see
-    dup (see)
-    dup see-class
-    dup "visitor-methods" word-prop keys natural-sort swap
-    [ >r first2 r> 3array ] curry map see-all ;