Finishing eliminating prune as a synonym of members

db4
Daniel Ehrenberg 2010-02-27 14:52:24 -05:00
parent 434605c0b5
commit da57436180
28 changed files with 42 additions and 40 deletions

View File

@ -5,6 +5,7 @@ unicode.categories combinators.short-circuit sequences
fry macros arrays assocs sets classes mirrors unicode.script fry macros arrays assocs sets classes mirrors unicode.script
unicode.data ; unicode.data ;
FROM: ascii => ascii? ; FROM: ascii => ascii? ;
FROM: sets => members ;
IN: regexp.classes IN: regexp.classes
SINGLETONS: dot letter-class LETTER-class Letter-class digit-class SINGLETONS: dot letter-class LETTER-class Letter-class digit-class
@ -157,7 +158,7 @@ DEFER: substitute
TUPLE: class-partition integers not-integers simples not-simples and or other ; TUPLE: class-partition integers not-integers simples not-simples and or other ;
: partition-classes ( seq -- class-partition ) : partition-classes ( seq -- class-partition )
prune members
[ integer? ] partition [ integer? ] partition
[ not-integer? ] partition [ not-integer? ] partition
[ simple-class? ] partition [ simple-class? ] partition
@ -194,7 +195,7 @@ TUPLE: class-partition integers not-integers simples not-simples and or other ;
[ t swap remove ] change-other [ t swap remove ] change-other
dup contradiction? dup contradiction?
[ drop f ] [ drop f ]
[ filter-not-integers class-partition>seq prune t and-class seq>instance ] if ; [ filter-not-integers class-partition>seq members t and-class seq>instance ] if ;
: <and-class> ( seq -- class ) : <and-class> ( seq -- class )
dup and-class flatten partition-classes dup and-class flatten partition-classes
@ -225,7 +226,7 @@ TUPLE: class-partition integers not-integers simples not-simples and or other ;
[ f swap remove ] change-other [ f swap remove ] change-other
dup tautology? dup tautology?
[ drop t ] [ drop t ]
[ filter-integers class-partition>seq prune f or-class seq>instance ] if ; [ filter-integers class-partition>seq members f or-class seq>instance ] if ;
: <or-class> ( seq -- class ) : <or-class> ( seq -- class )
dup or-class flatten partition-classes dup or-class flatten partition-classes
@ -329,7 +330,7 @@ M: object class>questions 1array ;
: condition-states ( condition -- states ) : condition-states ( condition -- states )
dup condition? [ dup condition? [
[ yes>> ] [ no>> ] bi [ yes>> ] [ no>> ] bi
[ condition-states ] bi@ append prune [ condition-states ] bi@ union
] [ 1array ] if ; ] [ 1array ] if ;
: condition-at ( condition assoc -- new-condition ) : condition-at ( condition assoc -- new-condition )

View File

@ -27,7 +27,7 @@ ERROR: bad-class name ;
[ [ simple ] keep ] H{ } map>assoc ; [ [ simple ] keep ] H{ } map>assoc ;
MEMO: simple-script-table ( -- table ) MEMO: simple-script-table ( -- table )
script-table interval-values prune simple-table ; script-table interval-values members simple-table ;
MEMO: simple-category-table ( -- table ) MEMO: simple-category-table ( -- table )
categories simple-table ; categories simple-table ;

View File

@ -239,7 +239,7 @@ PRIVATE>
dup class? [ dup seeing-implementors % ] when dup class? [ dup seeing-implementors % ] when
dup generic? [ dup seeing-methods % ] when dup generic? [ dup seeing-methods % ] when
drop drop
] { } make prune ; ] { } make members ;
: see-methods ( word -- ) : see-methods ( word -- )
methods see-all nl ; methods see-all nl ;

View File

@ -47,7 +47,7 @@ SYMBOL: interned
] { } make <interval-map> ; ] { } make <interval-map> ;
: process-interval-file ( ranges -- table ) : process-interval-file ( ranges -- table )
dup values prune interned dup values members interned
[ expand-ranges ] with-variable ; [ expand-ranges ] with-variable ;
: load-interval-file ( filename -- table ) : load-interval-file ( filename -- table )

View File

@ -35,5 +35,5 @@ SYNTAX: SA{ \ } [ >suffix-array ] parse-literal ;
: query ( begin suffix-array -- matches ) : query ( begin suffix-array -- matches )
2dup find-index dup 2dup find-index dup
[ -rot [ from-to ] keep <funky-slice> [ seq>> ] map prune ] [ -rot [ from-to ] keep <funky-slice> [ seq>> ] map members ]
[ 3drop { } ] if ; [ 3drop { } ] if ;

View File

@ -21,6 +21,7 @@ QUALIFIED: source-files.errors
QUALIFIED: vocabs QUALIFIED: vocabs
FROM: alien.libraries.private => >deployed-library-path ; FROM: alien.libraries.private => >deployed-library-path ;
FROM: namespaces => set ; FROM: namespaces => set ;
FROM: sets => members ;
IN: tools.deploy.shaker IN: tools.deploy.shaker
! This file is some hairy shit. ! This file is some hairy shit.
@ -507,7 +508,7 @@ SYMBOL: deploy-vocab
: write-vocab-manifest ( vocab-manifest-out -- ) : write-vocab-manifest ( vocab-manifest-out -- )
"Writing vocabulary manifest to " write dup print flush "Writing vocabulary manifest to " write dup print flush
vocabs "VOCABS:" prefix vocabs "VOCABS:" prefix
deploy-libraries get [ libraries get at path>> ] map prune "LIBRARIES:" prefix append deploy-libraries get [ libraries get at path>> ] map members "LIBRARIES:" prefix append
swap utf8 set-file-lines ; swap utf8 set-file-lines ;
: prepare-deploy-libraries ( -- ) : prepare-deploy-libraries ( -- )

View File

@ -5,6 +5,7 @@ io io.styles namespaces assocs kernel.private strings
combinators sorting math.parser vocabs definitions combinators sorting math.parser vocabs definitions
tools.profiler.private tools.crossref continuations generic tools.profiler.private tools.crossref continuations generic
compiler.units compiler.crossref sets classes fry ; compiler.units compiler.crossref sets classes fry ;
FROM: sets => members ;
IN: tools.profiler IN: tools.profiler
: profile ( quot -- ) : profile ( quot -- )
@ -41,7 +42,7 @@ IN: tools.profiler
[ smart-usage [ word? ] filter ] [ smart-usage [ word? ] filter ]
[ generic-call-sites-of keys ] [ generic-call-sites-of keys ]
[ effect-dependencies-of keys ] [ effect-dependencies-of keys ]
tri 3append prune ; tri 3append members ;
: usage-counters ( word -- alist ) : usage-counters ( word -- alist )
profiler-usage counters ; profiler-usage counters ;

View File

@ -6,6 +6,7 @@ math.vectors classes.tuple classes boxes calendar alarms combinators
sets columns fry deques ui.gadgets ui.gadgets.private ascii sets columns fry deques ui.gadgets ui.gadgets.private ascii
combinators.short-circuit ; combinators.short-circuit ;
FROM: namespaces => set ; FROM: namespaces => set ;
FROM: sets => members ;
IN: ui.gestures IN: ui.gestures
: get-gesture-handler ( gesture gadget -- quot ) : get-gesture-handler ( gesture gadget -- quot )
@ -235,7 +236,7 @@ SYMBOL: drag-timer
: modifier ( mod modifiers -- seq ) : modifier ( mod modifiers -- seq )
[ second swap bitand 0 > ] with filter [ second swap bitand 0 > ] with filter
0 <column> prune [ f ] [ >array ] if-empty ; 0 <column> members [ f ] [ >array ] if-empty ;
: drag-loc ( -- loc ) : drag-loc ( -- loc )
hand-loc get-global hand-click-loc get-global v- ; hand-loc get-global hand-click-loc get-global v- ;

View File

@ -138,7 +138,7 @@ M: world ungraft*
layout-queue [ layout-queue [
dup layout find-world [ , ] when* dup layout find-world [ , ] when*
] slurp-deque ] slurp-deque
] { } make prune ; ] { } make members ;
: redraw-worlds ( seq -- ) : redraw-worlds ( seq -- )
[ dup update-hand draw-world ] each ; [ dup update-hand draw-world ] each ;

View File

@ -184,7 +184,7 @@ C: <code-point> code-point
] assoc-map ; ] assoc-map ;
: properties>intervals ( properties -- assoc[str,interval] ) : properties>intervals ( properties -- assoc[str,interval] )
dup values prune [ f ] H{ } map>assoc dup values members [ f ] H{ } map>assoc
[ [ push-at ] curry assoc-each ] keep [ [ push-at ] curry assoc-each ] keep
[ <interval-set> ] assoc-map ; [ <interval-set> ] assoc-map ;

View File

@ -73,7 +73,7 @@ M: vocab-link summary vocab-summary ;
dup vocab-tags-path set-vocab-file-contents ; dup vocab-tags-path set-vocab-file-contents ;
: add-vocab-tags ( tags vocab -- ) : add-vocab-tags ( tags vocab -- )
[ vocab-tags append prune ] keep set-vocab-tags ; [ vocab-tags append members ] keep set-vocab-tags ;
: remove-vocab-tags ( tags vocab -- ) : remove-vocab-tags ( tags vocab -- )
[ vocab-tags swap diff ] keep set-vocab-tags ; [ vocab-tags swap diff ] keep set-vocab-tags ;

View File

@ -39,7 +39,7 @@ TR: convert-separators "/\\" ".." ;
: monitor-thread ( -- ) : monitor-thread ( -- )
[ [
[ [
vocab-roots get prune [ add-monitor-for-path ] each vocab-roots get [ add-monitor-for-path ] each
H{ } clone changed-vocabs set-global H{ } clone changed-vocabs set-global
vocabs [ changed-vocab ] each vocabs [ changed-vocab ] each

View File

@ -82,7 +82,7 @@ SYMBOL: modified-docs
[ [ vocab f >>docs-loaded? drop ] each ] bi* [ [ vocab f >>docs-loaded? drop ] each ] bi*
] ]
[ [
append prune union
[ unchanged-vocabs ] [ unchanged-vocabs ]
[ require-all load-failures. ] bi [ require-all load-failures. ] bi
] 2bi ; ] 2bi ;

View File

@ -32,7 +32,7 @@ M: keyword-map >alist
assoc>> >alist ; assoc>> >alist ;
: (keyword-map-no-word-sep) ( assoc -- str ) : (keyword-map-no-word-sep) ( assoc -- str )
keys concat [ alpha? not ] filter prune natural-sort ; keys combine [ alpha? not ] filter natural-sort ;
: keyword-map-no-word-sep* ( keyword-map -- str ) : keyword-map-no-word-sep* ( keyword-map -- str )
dup no-word-sep>> [ ] [ dup no-word-sep>> [ ] [

View File

@ -4,6 +4,7 @@ USING: kernel classes classes.private combinators accessors
sequences arrays vectors assocs namespaces words sorting layouts sequences arrays vectors assocs namespaces words sorting layouts
math hashtables kernel.private sets math.order ; math hashtables kernel.private sets math.order ;
FROM: classes => members ; FROM: classes => members ;
RENAME: members sets => set-members
IN: classes.algebra IN: classes.algebra
<PRIVATE <PRIVATE
@ -11,13 +12,14 @@ IN: classes.algebra
TUPLE: anonymous-union { members read-only } ; TUPLE: anonymous-union { members read-only } ;
: <anonymous-union> ( members -- class ) : <anonymous-union> ( members -- class )
[ null eq? not ] filter prune [ null eq? not ] filter set-members
dup length 1 = [ first ] [ anonymous-union boa ] if ; dup length 1 = [ first ] [ anonymous-union boa ] if ;
TUPLE: anonymous-intersection { participants read-only } ; TUPLE: anonymous-intersection { participants read-only } ;
: <anonymous-intersection> ( participants -- class ) : <anonymous-intersection> ( participants -- class )
prune dup length 1 = [ first ] [ anonymous-intersection boa ] if ; set-members dup length 1 =
[ first ] [ anonymous-intersection boa ] if ;
TUPLE: anonymous-complement { class read-only } ; TUPLE: anonymous-complement { class read-only } ;

View File

@ -105,7 +105,6 @@ M: sequence all-unique?
! Temporarily for compatibility ! Temporarily for compatibility
ALIAS: prune members
: unique ( seq -- assoc ) : unique ( seq -- assoc )
[ dup ] H{ } map>assoc ; [ dup ] H{ } map>assoc ;
: conjoin ( elt assoc -- ) : conjoin ( elt assoc -- )

View File

@ -11,7 +11,7 @@ IN: contributors
] with-directory ; ] with-directory ;
: patch-counts ( authors -- assoc ) : patch-counts ( authors -- assoc )
dup prune dup members
[ dup rot [ = ] with count ] with [ dup rot [ = ] with count ] with
{ } map>assoc ; { } map>assoc ;

View File

@ -29,7 +29,7 @@ IN: fuel.xref
[ word? ] filter [ word>xref ] map ; [ word? ] filter [ word>xref ] map ;
: filter-prefix ( seq prefix -- seq ) : filter-prefix ( seq prefix -- seq )
[ drop-prefix nip length 0 = ] curry filter prune ; [ drop-prefix nip length 0 = ] curry filter members ;
MEMO: (vocab-words) ( name -- seq ) MEMO: (vocab-words) ( name -- seq )
>vocab-link words [ name>> ] map ; >vocab-link words [ name>> ] map ;
@ -40,7 +40,7 @@ MEMO: (vocab-words) ( name -- seq )
append H{ } [ assoc-union ] reduce keys ; append H{ } [ assoc-union ] reduce keys ;
: vocabs-words ( names -- seq ) : vocabs-words ( names -- seq )
prune [ (vocab-words) ] map concat ; members [ (vocab-words) ] map concat ;
PRIVATE> PRIVATE>

View File

@ -145,7 +145,7 @@ TUPLE: link attributes clickable ;
[ >url ] map ; [ >url ] map ;
: find-all-links ( vector -- vector' ) : find-all-links ( vector -- vector' )
[ find-hrefs ] [ find-frame-links ] bi append prune ; [ find-hrefs ] [ find-frame-links ] bi union ;
: find-forms ( vector -- vector' ) : find-forms ( vector -- vector' )
"form" over find-opening-tags-by-name "form" over find-opening-tags-by-name

View File

@ -79,11 +79,8 @@ SYMBOL: terms
[ nth ] 2keep swap 1 + tail-slice (inversions) + [ nth ] 2keep swap 1 + tail-slice (inversions) +
] curry each ; ] curry each ;
: duplicates? ( seq -- ? )
dup prune [ length ] bi@ > ;
: (wedge) ( n basis1 basis2 -- n basis ) : (wedge) ( n basis1 basis2 -- n basis )
append dup duplicates? [ append dup all-unique? not [
2drop 0 { } 2drop 0 { }
] [ ] [
dup permutation inversions -1^ rot * dup permutation inversions -1^ rot *

View File

@ -23,7 +23,7 @@ M: method word-vocabulary "method-generic" word-prop word-vocabulary ;
:: do-step ( errors summary-file details-file -- ) :: do-step ( errors summary-file details-file -- )
errors errors
[ error-type +linkage-error+ eq? not ] filter [ error-type +linkage-error+ eq? not ] filter
[ file>> ] map prune natural-sort summary-file to-file [ file>> ] map members natural-sort summary-file to-file
errors details-file utf8 [ errors. ] with-file-writer ; errors details-file utf8 [ errors. ] with-file-writer ;
: do-tests ( -- ) : do-tests ( -- )
@ -55,7 +55,7 @@ M: method word-vocabulary "method-generic" word-prop word-vocabulary ;
"" to-refresh drop 2dup [ empty? not ] either? "" to-refresh drop 2dup [ empty? not ] either?
[ [
"Boot image is out of date. Changed vocabs:" print "Boot image is out of date. Changed vocabs:" print
append prune [ print ] each members [ print ] each
flush flush
1 exit 1 exit
] [ 2drop ] if ; ] [ 2drop ] if ;

View File

@ -29,7 +29,7 @@ IN: project-euler.004
PRIVATE> PRIVATE>
: euler004 ( -- answer ) : euler004 ( -- answer )
source-004 dup [ * ] cartesian-map concat prune max-palindrome ; source-004 dup [ * ] cartesian-map combine max-palindrome ;
! [ euler004 ] 100 ave-time ! [ euler004 ] 100 ave-time
! 1164 ms ave run time - 39.35 SD (100 trials) ! 1164 ms ave run time - 39.35 SD (100 trials)

View File

@ -29,7 +29,7 @@ IN: project-euler.029
! -------- ! --------
: euler029 ( -- answer ) : euler029 ( -- answer )
2 100 [a,b] dup [ ^ ] cartesian-map concat prune length ; 2 100 [a,b] dup [ ^ ] cartesian-map concat members length ;
! [ euler029 ] 100 ave-time ! [ euler029 ] 100 ave-time
! 704 ms ave run time - 28.07 SD (100 trials) ! 704 ms ave run time - 28.07 SD (100 trials)

View File

@ -48,7 +48,7 @@ IN: project-euler.032
PRIVATE> PRIVATE>
: euler032 ( -- answer ) : euler032 ( -- answer )
source-032 [ valid? ] filter products prune sum ; source-032 [ valid? ] filter products members sum ;
! [ euler032 ] 10 ave-time ! [ euler032 ] 10 ave-time
! 16361 ms ave run time - 417.8 SD (10 trials) ! 16361 ms ave run time - 417.8 SD (10 trials)
@ -72,7 +72,7 @@ PRIVATE>
50 [1,b] 2000 [1,b] 50 [1,b] 2000 [1,b]
[ mmp ] cartesian-map concat [ mmp ] cartesian-map concat
[ pandigital? ] filter [ pandigital? ] filter
products prune sum ; products members sum ;
! [ euler032a ] 10 ave-time ! [ euler032a ] 10 ave-time
! 2624 ms ave run time - 131.91 SD (10 trials) ! 2624 ms ave run time - 131.91 SD (10 trials)

View File

@ -70,7 +70,7 @@ INSTANCE: rollover immutable-sequence
over length <rollover> swap [ bitxor ] 2map ; over length <rollover> swap [ bitxor ] 2map ;
: frequency-analysis ( seq -- seq ) : frequency-analysis ( seq -- seq )
dup prune [ dup members [
[ 2dup [ = ] curry count 2array , ] each [ 2dup [ = ] curry count 2array , ] each
] { } make nip ; inline ] { } make nip ; inline

View File

@ -35,7 +35,7 @@ IN: project-euler.079
] { } make ; ] { } make ;
: find-source ( seq -- elt ) : find-source ( seq -- elt )
unzip diff prune unzip diff
[ "Topological sort failed" throw ] [ first ] if-empty ; [ "Topological sort failed" throw ] [ first ] if-empty ;
: remove-source ( seq elt -- seq ) : remove-source ( seq elt -- seq )
@ -52,7 +52,7 @@ PRIVATE>
: topological-sort ( seq -- seq ) : topological-sort ( seq -- seq )
[ [ (topological-sort) ] { } make ] keep [ [ (topological-sort) ] { } make ] keep
concat prune over diff append ; combine over diff append ;
: euler079 ( -- answer ) : euler079 ( -- answer )
source-079 >edges topological-sort 10 digits>integer ; source-079 >edges topological-sort 10 digits>integer ;
@ -60,7 +60,7 @@ PRIVATE>
! [ euler079 ] 100 ave-time ! [ euler079 ] 100 ave-time
! 1 ms ave run time - 0.46 SD (100 trials) ! 1 ms ave run time - 0.46 SD (100 trials)
! TODO: prune and diff are relatively slow; topological sort could be ! TODO: set words on sequences are relatively slow; topological sort could be
! cleaned up and generalized much better, but it works for this problem ! cleaned up and generalized much better, but it works for this problem
SOLUTION: euler079 SOLUTION: euler079

View File

@ -45,7 +45,7 @@ IN: project-euler.203
[ 0 prefix ] [ 0 suffix ] bi [ + ] 2map ; [ 0 prefix ] [ 0 suffix ] bi [ + ] 2map ;
: generate ( n -- seq ) : generate ( n -- seq )
1 - { 1 } [ (generate) ] iterate concat prune ; 1 - { 1 } [ (generate) ] iterate combine ;
: squarefree ( n -- ? ) : squarefree ( n -- ? )
factors all-unique? ; factors all-unique? ;

View File

@ -48,7 +48,7 @@ fetched-in parsed-html links processed-in fetched-at ;
nonmatching>> push-links ; nonmatching>> push-links ;
: filter-base-links ( spider spider-result -- base-links nonmatching-links ) : filter-base-links ( spider spider-result -- base-links nonmatching-links )
[ base>> host>> ] [ links>> prune ] bi* [ base>> host>> ] [ links>> members ] bi*
[ host>> = ] with partition ; [ host>> = ] with partition ;
: add-spidered ( spider spider-result -- ) : add-spidered ( spider spider-result -- )