more cleanups, lint fix

db4
Doug Coleman 2008-01-12 09:09:49 -10:00
parent 0f7d1a83f8
commit 3f7943fb08
4 changed files with 21 additions and 17 deletions

View File

@ -128,7 +128,7 @@ PRIVATE>
: cleanup ( try cleanup-always cleanup-error -- )
over >r compose [ dip rethrow ] curry
>r (catch) r> ifcc r> call ; inline
recover r> call ; inline
: attempt-all ( seq quot -- obj )
[

View File

@ -69,7 +69,7 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
} cond ;
: math-exp? ( n n word -- ? )
{ + - * / ^ } member? -rot [ number? ] 2apply and and ;
{ + - * / ^ } member? -rot [ number? ] both? and ;
: (fold-constants) ( quot -- )
dup length 3 < [ % ] [

View File

@ -83,7 +83,8 @@ def-hash get-global [
! Remove n m shift defs
[
drop dup length 3 = [
dup first2 [ number? ] 2apply and swap third \ shift = and not
dup first2 [ number? ] both?
swap third \ shift = and not
] [ drop t ] if
] assoc-subset
@ -132,22 +133,21 @@ M: word lint ( word -- seq )
GENERIC: run-lint ( obj -- obj )
: (trim-self)
def-hash get-global at* [
dupd remove empty? not
] [
drop f
] if ;
: trim-self ( seq -- newseq )
[
first2 [
def-hash get-global at* [
dupd remove empty? not
] [
drop f
] if
] subset 2array
] map ;
[ [ (trim-self) ] subset ] assoc-map ;
M: sequence run-lint ( seq -- seq )
[
global [ dup . flush ] bind
dup lint 2array
] map
dup lint
] { } map>assoc
trim-self
[ second empty? not ] subset ;
@ -155,5 +155,9 @@ M: word run-lint ( word -- seq )
1array run-lint ;
: lint-all ( -- seq )
all-words run-lint dup [ lint. ] each ;
all-words run-lint
[
nip first dup def-hash get at
[ first ] 2apply literalize = not
] assoc-subset
dup [ lint. ] each ;

View File

@ -43,7 +43,7 @@ IN: visitor
PREDICATE: standard-generic visitor "visitors" word-prop ;
PREDICATE: array triple length 3 = ;
PREDICATE: triple visitor-spec
first3 visitor? >r [ class? ] 2apply and r> and ;
first3 visitor? >r [ class? ] both? r> and ;
M: visitor-spec definer drop \ V: \ ; ;
M: visitor definer drop \ VISITOR: f ;