Add a lint check for swap .. swap that can be replaced by dip. Clean up the cases it finds.
parent
1882e3de3e
commit
7b6f27eda6
|
@ -27,7 +27,7 @@ IN: opengl.capabilities
|
||||||
"." split [ string>number ] map ;
|
"." split [ string>number ] map ;
|
||||||
|
|
||||||
: version-before? ( version1 version2 -- ? )
|
: version-before? ( version1 version2 -- ? )
|
||||||
swap version-seq swap version-seq before=? ;
|
[ version-seq ] bi@ before=? ;
|
||||||
|
|
||||||
: (gl-version) ( -- version vendor )
|
: (gl-version) ( -- version vendor )
|
||||||
GL_VERSION glGetString " " split1 ;
|
GL_VERSION glGetString " " split1 ;
|
||||||
|
|
|
@ -14,8 +14,7 @@ TUPLE: border < gadget
|
||||||
new swap add-gadget ; inline
|
new swap add-gadget ; inline
|
||||||
|
|
||||||
: <border> ( child gap -- border )
|
: <border> ( child gap -- border )
|
||||||
swap border new-border
|
[ border new-border ] dip >>size ;
|
||||||
swap >>size ;
|
|
||||||
|
|
||||||
: <filled-border> ( child gap -- border )
|
: <filled-border> ( child gap -- border )
|
||||||
<border> { 1 1 } >>fill ;
|
<border> { 1 1 } >>fill ;
|
||||||
|
|
|
@ -25,8 +25,8 @@ TUPLE: presentation < button object hook ;
|
||||||
[ [ object>> ] keep show-summary ] [ button-update ] bi ;
|
[ [ object>> ] keep show-summary ] [ button-update ] bi ;
|
||||||
|
|
||||||
: <presentation> ( label object -- button )
|
: <presentation> ( label object -- button )
|
||||||
swap [ invoke-primary ] presentation new-button
|
[ [ invoke-primary ] presentation new-button ] dip
|
||||||
swap >>object
|
>>object
|
||||||
[ drop ] >>hook
|
[ drop ] >>hook
|
||||||
roll-button-theme ;
|
roll-button-theme ;
|
||||||
|
|
||||||
|
|
|
@ -16,7 +16,7 @@ SINGLETON: utf8
|
||||||
|
|
||||||
: append-nums ( stream byte -- stream char )
|
: append-nums ( stream byte -- stream char )
|
||||||
over stream-read1 dup starts-2?
|
over stream-read1 dup starts-2?
|
||||||
[ swap 6 shift swap BIN: 111111 bitand bitor ]
|
[ [ 6 shift ] dip BIN: 111111 bitand bitor ]
|
||||||
[ 2drop replacement-char ] if ; inline
|
[ 2drop replacement-char ] if ; inline
|
||||||
|
|
||||||
: minimum-code-point ( char minimum -- char )
|
: minimum-code-point ( char minimum -- char )
|
||||||
|
|
|
@ -2,10 +2,11 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
|
||||||
USING: accessors alien arrays assocs classes
|
USING: accessors alien arrays assocs classes
|
||||||
classes.tuple.private combinators.short-circuit fry hashtables
|
classes.tuple.private combinators.short-circuit continuations
|
||||||
io kernel kernel.private locals.backend make math namespaces
|
fry hashtables io kernel kernel.private locals.backend make
|
||||||
prettyprint quotations sequences sequences.deep shuffle
|
math namespaces prettyprint quotations sequences sequences.deep
|
||||||
slots.private vectors vocabs words words.alias ;
|
shuffle slots.private splitting stack-checker vectors vocabs
|
||||||
|
words words.alias ;
|
||||||
|
|
||||||
IN: lint
|
IN: lint
|
||||||
|
|
||||||
|
@ -287,6 +288,18 @@ M: word run-lint ( word -- seq ) 1array run-lint ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
: find-swap/swap ( word -- ? )
|
||||||
|
def>> [ callable? ] deep-filter
|
||||||
|
[
|
||||||
|
{
|
||||||
|
[ [ \ swap = ] count 2 >= ]
|
||||||
|
[
|
||||||
|
{ swap } split rest but-last
|
||||||
|
[ [ infer ] [ 2drop ( -- ) ] recover ( x -- x ) = ] any?
|
||||||
|
]
|
||||||
|
} 1&&
|
||||||
|
] any? ;
|
||||||
|
|
||||||
: lint-all ( -- seq )
|
: lint-all ( -- seq )
|
||||||
all-words run-lint dup lint. ;
|
all-words run-lint dup lint. ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue