using [ ] [ ... ] ?if instead of [ nip ] [ ... ] if*.
parent
de4495875f
commit
55cf5472a5
|
@ -19,6 +19,6 @@ HOOK: find-library* os ( name -- path/f )
|
||||||
! or "library_not_found" as a last resort for better debugging.
|
! or "library_not_found" as a last resort for better debugging.
|
||||||
: find-library-from-list ( seq -- path/f )
|
: find-library-from-list ( seq -- path/f )
|
||||||
dup [ find-library* ] map-find drop
|
dup [ find-library* ] map-find drop
|
||||||
[ nip ] [ ?first "library_not_found" or ] if* ;
|
[ ] [ ?first "library_not_found" or ] ?if ;
|
||||||
|
|
||||||
"alien.libraries.finder." os name>> append require
|
"alien.libraries.finder." os name>> append require
|
||||||
|
|
|
@ -304,7 +304,7 @@ M: array-type field-type>c-type type>c-type ;
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
dup find-existing-boxed-type
|
dup find-existing-boxed-type
|
||||||
[ nip ] [ c-type>> defer-c-type ] if*
|
[ ] [ c-type>> defer-c-type ] ?if
|
||||||
]
|
]
|
||||||
[ name>> qualified-name ] bi
|
[ name>> qualified-name ] bi
|
||||||
boxed-info new swap register-type
|
boxed-info new swap register-type
|
||||||
|
|
|
@ -59,7 +59,7 @@ ERROR: more-than-8-components ;
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: ipv6-component ( str -- n )
|
: ipv6-component ( str -- n )
|
||||||
dup hex> [ nip ] [ bad-ipv6-component ] if* ;
|
dup hex> [ ] [ bad-ipv6-component ] ?if ;
|
||||||
|
|
||||||
: split-ipv6 ( string -- seq )
|
: split-ipv6 ( string -- seq )
|
||||||
":" split CHAR: . over last member? [ unclip-last ] [ f ] if
|
":" split CHAR: . over last member? [ unclip-last ] [ f ] if
|
||||||
|
|
|
@ -17,7 +17,7 @@ ERROR: not-a-json-number string ;
|
||||||
{ "Infinity" [ 1/0. ] }
|
{ "Infinity" [ 1/0. ] }
|
||||||
{ "-Infinity" [ -1/0. ] }
|
{ "-Infinity" [ -1/0. ] }
|
||||||
{ "NaN" [ 0/0. ] }
|
{ "NaN" [ 0/0. ] }
|
||||||
[ dup string>number [ nip ] [ not-a-json-number ] if* ]
|
[ dup string>number [ ] [ not-a-json-number ] ?if ]
|
||||||
} case
|
} case
|
||||||
] dip ;
|
] dip ;
|
||||||
|
|
||||||
|
|
|
@ -21,7 +21,7 @@ SYMBOL: matrix
|
||||||
: cols ( -- n ) 0 nth-row length ;
|
: cols ( -- n ) 0 nth-row length ;
|
||||||
|
|
||||||
: skip ( i seq quot -- n )
|
: skip ( i seq quot -- n )
|
||||||
over [ find-from drop ] dip swap [ nip ] [ length ] if* ; inline
|
over [ find-from drop ] dip swap [ ] [ length ] ?if ; inline
|
||||||
|
|
||||||
: first-col ( row# -- n )
|
: first-col ( row# -- n )
|
||||||
! First non-zero column
|
! First non-zero column
|
||||||
|
|
|
@ -46,7 +46,7 @@ IN: memoize
|
||||||
out>> [
|
out>> [
|
||||||
packer '[
|
packer '[
|
||||||
_ dup first-unsafe
|
_ dup first-unsafe
|
||||||
[ nip ] [ @ @ [ 0 rot set-nth-unsafe ] keep ] if*
|
[ ] [ @ @ [ 0 rot set-nth-unsafe ] keep ] ?if
|
||||||
]
|
]
|
||||||
] keep unpacker compose ;
|
] keep unpacker compose ;
|
||||||
|
|
||||||
|
|
|
@ -45,7 +45,7 @@ TUPLE: line words width height baseline ;
|
||||||
|
|
||||||
: cached-wrapped ( paragraph -- wrapped-paragraph )
|
: cached-wrapped ( paragraph -- wrapped-paragraph )
|
||||||
dup wrapped>>
|
dup wrapped>>
|
||||||
[ nip ] [ [ wrap-paragraph dup ] keep wrapped<< ] if* ;
|
[ ] [ [ wrap-paragraph dup ] keep wrapped<< ] ?if ;
|
||||||
|
|
||||||
: max-line-width ( wrapped-paragraph -- x )
|
: max-line-width ( wrapped-paragraph -- x )
|
||||||
[ width>> ] [ max ] map-reduce ;
|
[ width>> ] [ max ] map-reduce ;
|
||||||
|
|
|
@ -366,7 +366,7 @@ M: object accept-completion-hook 2drop ;
|
||||||
M: interactor stream-read-quot ( stream -- quot/f )
|
M: interactor stream-read-quot ( stream -- quot/f )
|
||||||
dup interactor-yield dup array? [
|
dup interactor-yield dup array? [
|
||||||
over interactor-finish try-parse
|
over interactor-finish try-parse
|
||||||
[ nip ] [ stream-read-quot ] if*
|
[ ] [ stream-read-quot ] ?if
|
||||||
] [ nip ] if ;
|
] [ nip ] if ;
|
||||||
|
|
||||||
: interactor-operation ( gesture interactor -- ? )
|
: interactor-operation ( gesture interactor -- ? )
|
||||||
|
|
|
@ -51,7 +51,7 @@ PRIVATE>
|
||||||
] [
|
] [
|
||||||
group-struct [ gr_name>> ] [ f ] if*
|
group-struct [ gr_name>> ] [ f ] if*
|
||||||
] if*
|
] if*
|
||||||
[ nip ] [ number>string ] if* ;
|
[ ] [ number>string ] ?if ;
|
||||||
|
|
||||||
: group-id ( string -- id/f )
|
: group-id ( string -- id/f )
|
||||||
group-struct dup [ gr_gid>> ] when ;
|
group-struct dup [ gr_gid>> ] when ;
|
||||||
|
|
|
@ -25,7 +25,7 @@ SYMBOL: ns-stack
|
||||||
|
|
||||||
: add-ns ( name -- )
|
: add-ns ( name -- )
|
||||||
dup space>> dup ns-stack get assoc-stack
|
dup space>> dup ns-stack get assoc-stack
|
||||||
[ nip ] [ nonexist-ns ] if* >>url drop ;
|
[ ] [ nonexist-ns ] ?if >>url drop ;
|
||||||
|
|
||||||
: push-ns ( hash -- )
|
: push-ns ( hash -- )
|
||||||
ns-stack get push ;
|
ns-stack get push ;
|
||||||
|
|
|
@ -4,4 +4,15 @@ IN: benchmark.sha1
|
||||||
: sha1-benchmark ( -- )
|
: sha1-benchmark ( -- )
|
||||||
2000000 iota >byte-array sha1 checksum-bytes drop ;
|
2000000 iota >byte-array sha1 checksum-bytes drop ;
|
||||||
|
|
||||||
|
: sha224-benchmark ( -- )
|
||||||
|
2000000 iota >byte-array sha-224 checksum-bytes drop ;
|
||||||
|
|
||||||
|
: sha256-benchmark ( -- )
|
||||||
|
2000000 iota >byte-array sha-256 checksum-bytes drop ;
|
||||||
|
|
||||||
|
USE: checksums.openssl
|
||||||
|
|
||||||
|
: openssl-sha1-benchmark ( -- )
|
||||||
|
2000000 iota >byte-array openssl-sha1 checksum-bytes drop ;
|
||||||
|
|
||||||
MAIN: sha1-benchmark
|
MAIN: sha1-benchmark
|
||||||
|
|
|
@ -19,7 +19,7 @@ M: ec-key dispose
|
||||||
EC_KEY_new_by_curve_name dup ssl-error ec-key boa ;
|
EC_KEY_new_by_curve_name dup ssl-error ec-key boa ;
|
||||||
|
|
||||||
: ec-key-handle ( -- handle )
|
: ec-key-handle ( -- handle )
|
||||||
ec-key get dup handle>> [ nip ] [ already-disposed ] if* ;
|
ec-key get dup handle>> [ ] [ already-disposed ] ?if ;
|
||||||
|
|
||||||
DESTRUCTOR: BN_clear_free
|
DESTRUCTOR: BN_clear_free
|
||||||
|
|
||||||
|
|
|
@ -43,7 +43,7 @@ GML: faceCCW ( e0 -- e1 ) face-ccw ;
|
||||||
|
|
||||||
GML: baseface ( e0 -- e1 ) base-face>> ;
|
GML: baseface ( e0 -- e1 ) base-face>> ;
|
||||||
|
|
||||||
GML: nextring ( e0 -- e1 ) dup next-ring>> [ nip ] [ base-face>> ] if* ;
|
GML: nextring ( e0 -- e1 ) dup next-ring>> [ ] [ base-face>> ] ?if ;
|
||||||
|
|
||||||
GML: facenormal ( e0 -- n ) face-normal ;
|
GML: facenormal ( e0 -- n ) face-normal ;
|
||||||
GML: faceplanedist ( e0 -- d ) face-plane-dist ;
|
GML: faceplanedist ( e0 -- d ) face-plane-dist ;
|
||||||
|
|
|
@ -310,7 +310,7 @@ SYMBOL: padding-no
|
||||||
{ } <struct-slot-spec> ;
|
{ } <struct-slot-spec> ;
|
||||||
|
|
||||||
: shader-filename ( shader/program -- filename )
|
: shader-filename ( shader/program -- filename )
|
||||||
dup filename>> [ nip ] [ name>> where first ] if* file-name ;
|
dup filename>> [ ] [ name>> where first ] ?if file-name ;
|
||||||
|
|
||||||
: numbered-log-line? ( log-line-components -- ? )
|
: numbered-log-line? ( log-line-components -- ? )
|
||||||
{
|
{
|
||||||
|
|
|
@ -35,7 +35,7 @@ M: to-me chat-name sender>> ;
|
||||||
! ":flogbot2_!~flogbot2@c-50-174-221-28.hsd1.ca.comcast.net JOIN #concatenative-bots"
|
! ":flogbot2_!~flogbot2@c-50-174-221-28.hsd1.ca.comcast.net JOIN #concatenative-bots"
|
||||||
! The channel>> field is empty and it's in parameters instead.
|
! The channel>> field is empty and it's in parameters instead.
|
||||||
! This fixes chat> for these kinds of messages.
|
! This fixes chat> for these kinds of messages.
|
||||||
M: to-channel chat-name dup channel>> [ nip ] [ parameters>> ?first ] if* ;
|
M: to-channel chat-name dup channel>> [ ] [ parameters>> ?first ] ?if ;
|
||||||
|
|
||||||
GENERIC: chat> ( obj -- chat/f )
|
GENERIC: chat> ( obj -- chat/f )
|
||||||
M: string chat> irc> chats>> at ;
|
M: string chat> irc> chats>> at ;
|
||||||
|
|
|
@ -28,7 +28,7 @@ ERROR: not-an-integer x ;
|
||||||
: parse-decimal ( str -- ratio )
|
: parse-decimal ( str -- ratio )
|
||||||
split-decimal [ [ "0" ] when-empty ] bi@
|
split-decimal [ [ "0" ] when-empty ] bi@
|
||||||
[
|
[
|
||||||
[ dup string>number [ nip ] [ not-an-integer ] if* ] bi@
|
[ dup string>number [ ] [ not-an-integer ] ?if ] bi@
|
||||||
] keep length 10^ / + swap [ neg ] when ;
|
] keep length 10^ / + swap [ neg ] when ;
|
||||||
|
|
||||||
SYNTAX: DECIMAL: scan-token parse-decimal suffix! ;
|
SYNTAX: DECIMAL: scan-token parse-decimal suffix! ;
|
||||||
|
|
|
@ -41,7 +41,7 @@ MACRO: case-probas ( data -- quot )
|
||||||
[ first2 [ 1quotation ] dip [ swap 2array ] when* ] map 1quotation ;
|
[ first2 [ 1quotation ] dip [ swap 2array ] when* ] map 1quotation ;
|
||||||
|
|
||||||
: expected ( data name -- float )
|
: expected ( data name -- float )
|
||||||
dupd of [ nip ] [ values sift sum 1 swap - ] if* ;
|
dupd of [ ] [ values sift sum 1 swap - ] ?if ;
|
||||||
|
|
||||||
: generate ( # case-probas -- seq )
|
: generate ( # case-probas -- seq )
|
||||||
H{ } clone [
|
H{ } clone [
|
||||||
|
|
|
@ -34,7 +34,7 @@ C: <entry> cache-entry
|
||||||
|
|
||||||
: get-entry ( gadget -- {texture,dims} )
|
: get-entry ( gadget -- {texture,dims} )
|
||||||
dup cache-key* textures get at
|
dup cache-key* textures get at
|
||||||
[ nip ] [ make-entry ] if* ;
|
[ ] [ make-entry ] ?if ;
|
||||||
|
|
||||||
: get-dims ( gadget -- dims )
|
: get-dims ( gadget -- dims )
|
||||||
get-entry dims>> ;
|
get-entry dims>> ;
|
||||||
|
|
|
@ -20,7 +20,7 @@ node "node"
|
||||||
: load-node ( id -- node ) f <node> select-tuple ;
|
: load-node ( id -- node ) f <node> select-tuple ;
|
||||||
|
|
||||||
: node-content ( node -- content )
|
: node-content ( node -- content )
|
||||||
dup content>> [ nip ] [ select-tuple content>> ] if* ;
|
dup content>> [ ] [ select-tuple content>> ] ?if ;
|
||||||
|
|
||||||
: node= ( node node -- ? ) [ id>> ] same? ;
|
: node= ( node node -- ? ) [ id>> ] same? ;
|
||||||
|
|
||||||
|
|
|
@ -13,7 +13,7 @@ RELATION: before
|
||||||
get-menus [ node-content = ] with find nip ;
|
get-menus [ node-content = ] with find nip ;
|
||||||
|
|
||||||
: ensure-menu ( name -- node )
|
: ensure-menu ( name -- node )
|
||||||
dup get-menu [ nip ] [ create-node ] if* ;
|
dup get-menu [ ] [ create-node ] ?if ;
|
||||||
|
|
||||||
: load-menu ( name -- menu )
|
: load-menu ( name -- menu )
|
||||||
get-menu subitem-of-relation get-node-tree-s ;
|
get-menu subitem-of-relation get-node-tree-s ;
|
||||||
|
|
Loading…
Reference in New Issue