extra: swap 3append -> glue, remove some >r r>

db4
Doug Coleman 2008-12-03 19:11:55 -06:00
parent db30415dcb
commit 3ab0d03a19
9 changed files with 19 additions and 23 deletions

View File

@ -9,7 +9,7 @@ IN: benchmark.knucleotide
"." split1 rot
over length over <
[ CHAR: 0 pad-right ]
[ head ] if "." swap 3append ;
[ head ] if "." glue ;
: discard-lines ( -- )
readln

View File

@ -80,7 +80,7 @@ M: check< summary drop "Number exceeds upper bound" ;
[ ":" split1 string>number [ dup length ] unless* ] { } map>assoc ;
: define-slots ( prefix names quots -- )
>r [ "-" swap 3append create-in ] with map r>
>r [ "-" glue create-in ] with map r>
[ define ] 2each ;
: define-accessors ( classname slots -- )

View File

@ -285,7 +285,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
[ get-label ]
[ skip-label get-name ]
2bi
"." swap 3append
"." glue
]
}
}

View File

@ -31,7 +31,7 @@ M: object handle-message drop ;
"git-log" ,
"--no-merges" ,
"--pretty=format:%h %an: %s" ,
".." swap 3append ,
".." glue ,
] { } make
latin1 [ input-stream get lines ] with-process-reader ;

View File

@ -56,7 +56,7 @@ SYMBOL: and-needed?
: text-with-scale ( index seq -- str )
[ nth 3digits>text ] [ drop scale-numbers ] 2bi
[ " " swap 3append ] unless-empty ;
[ " " glue ] unless-empty ;
: append-with-conjunction ( str1 str2 -- newstr )
over length zero? [

View File

@ -12,7 +12,7 @@ CHAR: $ \ currency-token set-global
: (money>string) ( dollars cents -- string )
[ number>string ] bi@
[ <reversed> 3 group "," join <reversed> ]
[ 2 CHAR: 0 pad-left ] bi* "." swap 3append ;
[ 2 CHAR: 0 pad-left ] bi* "." glue ;
: money>string ( object -- string )
dollars/cents (money>string) currency-token get prefix ;

View File

@ -28,7 +28,7 @@ IN: printf
[ 0 ] [ string>number ] if-empty ;
: pad-digits ( string digits -- string' )
[ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." swap 3append ;
[ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." glue ;
: max-digits ( n digits -- n' )
10 swap ^ [ * round ] keep / ;

View File

@ -23,11 +23,11 @@ IN: sequences.lib
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: each-percent ( seq quot -- )
>r
[
dup length
dup [ / ] curry
[ 1+ ] prepose
r> compose
] dip compose
2each ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -68,7 +68,7 @@ IN: sequences.lib
: minmax ( seq -- min max )
#! find the min and max of a seq in one pass
1/0. -1/0. rot [ tuck max >r min r> ] each ;
1/0. -1/0. rot [ tuck max [ min ] dip ] each ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -78,7 +78,7 @@ IN: sequences.lib
: (monotonic-split) ( seq quot -- newseq )
[
>r dup unclip suffix r>
[ dup unclip suffix ] dip
v, [ pick ,, call [ v, ] unless ] curry 2each ,v
] { } make ;
@ -88,7 +88,7 @@ IN: sequences.lib
ERROR: element-not-found ;
: split-around ( seq quot -- before elem after )
dupd find over [ element-not-found ] unless
>r cut rest r> swap ; inline
[ cut rest ] dip swap ; inline
: map-until ( seq quot pred -- newseq )
'[ [ @ dup @ [ drop t ] [ , f ] if ] find 2drop ] { } make ;
@ -115,14 +115,14 @@ ERROR: element-not-found ;
PRIVATE>
: exact-strings ( alphabet length -- seqs )
>r dup length r> exact-number-strings map-alphabet ;
[ dup length ] dip exact-number-strings map-alphabet ;
: strings ( alphabet length -- seqs )
>r dup length r> number-strings map-alphabet ;
[ dup length ] dip number-strings map-alphabet ;
: switches ( seq1 seq -- subseq )
! seq1 is a sequence of ones and zeroes
>r [ length ] keep [ nth 1 = ] curry filter r>
[ [ length ] keep [ nth 1 = ] curry filter ] dip
[ nth ] curry { } map-as ;
: power-set ( seq -- subsets )
@ -147,7 +147,3 @@ PRIVATE>
dup length 1 (a,b] [ dup random pick exchange ] each ;
: enumerate ( seq -- seq' ) <enum> >alist ;
: splice ( left-seq right-seq seq -- newseq ) swap 3append ;
: surround ( seq left-seq right-seq -- newseq ) swapd 3append ;

View File

@ -50,7 +50,7 @@ M: entity feed-entry-date date>> ;
TUPLE: post < entity title comments ;
M: post feed-entry-title
[ author>> ] [ title>> ] bi ": " swap 3append ;
[ author>> ] [ title>> ] bi ": " glue ;
M: post entity-url
id>> view-post-url ;