remove >r r>
parent
9d5732671d
commit
829c379c49
|
@ -189,11 +189,11 @@ M: string >ber ( str -- byte-array )
|
||||||
>byte-array append ;
|
>byte-array append ;
|
||||||
|
|
||||||
: >ber-application-string ( n str -- byte-array )
|
: >ber-application-string ( n str -- byte-array )
|
||||||
>r HEX: 40 + set-tag r> >ber ;
|
[ HEX: 40 + set-tag ] dip >ber ;
|
||||||
|
|
||||||
GENERIC: >ber-contextspecific ( n obj -- byte-array )
|
GENERIC: >ber-contextspecific ( n obj -- byte-array )
|
||||||
M: string >ber-contextspecific ( n str -- byte-array )
|
M: string >ber-contextspecific ( n str -- byte-array )
|
||||||
>r HEX: 80 + set-tag r> >ber ;
|
[ HEX: 80 + set-tag ] dip >ber ;
|
||||||
|
|
||||||
! =========================================================
|
! =========================================================
|
||||||
! Array
|
! Array
|
||||||
|
|
|
@ -10,10 +10,10 @@ IN: assocs.lib
|
||||||
dupd at [ nip ] when* ;
|
dupd at [ nip ] when* ;
|
||||||
|
|
||||||
: replace-at ( assoc value key -- assoc )
|
: replace-at ( assoc value key -- assoc )
|
||||||
>r >r dup r> 1vector r> rot set-at ;
|
[ dupd 1vector ] dip rot set-at ;
|
||||||
|
|
||||||
: peek-at* ( assoc key -- obj ? )
|
: peek-at* ( assoc key -- obj ? )
|
||||||
swap at* dup [ >r peek r> ] when ;
|
swap at* dup [ [ peek ] dip ] when ;
|
||||||
|
|
||||||
: peek-at ( assoc key -- obj )
|
: peek-at ( assoc key -- obj )
|
||||||
peek-at* drop ;
|
peek-at* drop ;
|
||||||
|
@ -27,7 +27,7 @@ IN: assocs.lib
|
||||||
: insert ( value variable -- ) namespace push-at ;
|
: insert ( value variable -- ) namespace push-at ;
|
||||||
|
|
||||||
: generate-key ( assoc -- str )
|
: generate-key ( assoc -- str )
|
||||||
>r 32 random-bits >hex r>
|
[ 32 random-bits >hex ] dip
|
||||||
2dup key? [ nip generate-key ] [ drop ] if ;
|
2dup key? [ nip generate-key ] [ drop ] if ;
|
||||||
|
|
||||||
: set-at-unique ( value assoc -- key )
|
: set-at-unique ( value assoc -- key )
|
||||||
|
|
|
@ -31,7 +31,7 @@ IN: combinators.lib
|
||||||
! Generalized versions of core combinators
|
! Generalized versions of core combinators
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: quad ( x p q r s -- ) >r >r >r keep r> keep r> keep r> call ; inline
|
: quad ( x p q r s -- ) [ keep ] 3dip [ keep ] 2dip [ keep ] dip call ; inline
|
||||||
|
|
||||||
: 4slip ( quot a b c d -- a b c d ) 4 nslip ; inline
|
: 4slip ( quot a b c d -- a b c d ) 4 nslip ; inline
|
||||||
|
|
||||||
|
@ -123,10 +123,10 @@ MACRO: construct-slots ( assoc tuple-class -- tuple )
|
||||||
>r pick >r with r> r> swapd with ;
|
>r pick >r with r> r> swapd with ;
|
||||||
|
|
||||||
: or? ( obj quot1 quot2 -- ? )
|
: or? ( obj quot1 quot2 -- ? )
|
||||||
>r keep r> rot [ 2nip ] [ call ] if* ; inline
|
[ keep ] dip rot [ 2nip ] [ call ] if* ; inline
|
||||||
|
|
||||||
: and? ( obj quot1 quot2 -- ? )
|
: and? ( obj quot1 quot2 -- ? )
|
||||||
>r keep r> rot [ call ] [ 2drop f ] if ; inline
|
[ keep ] dip rot [ call ] [ 2drop f ] if ; inline
|
||||||
|
|
||||||
MACRO: multikeep ( word out-indexes -- ... )
|
MACRO: multikeep ( word out-indexes -- ... )
|
||||||
[
|
[
|
||||||
|
@ -139,7 +139,7 @@ MACRO: multikeep ( word out-indexes -- ... )
|
||||||
[ drop ] rot compose attempt-all ; inline
|
[ drop ] rot compose attempt-all ; inline
|
||||||
|
|
||||||
: do-while ( pred body tail -- )
|
: do-while ( pred body tail -- )
|
||||||
>r tuck 2slip r> while ; inline
|
[ tuck 2slip ] dip while ; inline
|
||||||
|
|
||||||
: generate ( generator predicate -- obj )
|
: generate ( generator predicate -- obj )
|
||||||
[ dup ] swap [ dup [ nip ] unless not ] 3compose
|
[ dup ] swap [ dup [ nip ] unless not ] 3compose
|
||||||
|
@ -147,7 +147,7 @@ MACRO: multikeep ( word out-indexes -- ... )
|
||||||
|
|
||||||
MACRO: predicates ( seq -- quot/f )
|
MACRO: predicates ( seq -- quot/f )
|
||||||
dup [ 1quotation [ drop ] prepend ] map
|
dup [ 1quotation [ drop ] prepend ] map
|
||||||
>r [ [ dup ] prepend ] map r> zip [ drop f ] suffix
|
[ [ [ dup ] prepend ] map ] dip zip [ drop f ] suffix
|
||||||
[ cond ] curry ;
|
[ cond ] curry ;
|
||||||
|
|
||||||
: %chance ( quot n -- ) 100 random > swap when ; inline
|
: %chance ( quot n -- ) 100 random > swap when ; inline
|
||||||
|
|
|
@ -26,7 +26,7 @@ SYMBOL: tagstack
|
||||||
swap >>name ;
|
swap >>name ;
|
||||||
|
|
||||||
: make-tag ( string attribs -- tag )
|
: make-tag ( string attribs -- tag )
|
||||||
>r [ closing-tag? ] keep "/" trim1 r> rot <tag> ;
|
[ [ closing-tag? ] keep "/" trim1 ] dip rot <tag> ;
|
||||||
|
|
||||||
: make-text-tag ( string -- tag )
|
: make-text-tag ( string -- tag )
|
||||||
tag new
|
tag new
|
||||||
|
|
Loading…
Reference in New Issue