steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Cleanups

db4
Slava Pestov 2008-11-29 15:21:23 -06:00
parent 594751381e
commit 8b863ed5e5
2 changed files with 9 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/cocoa/messages/messages.factor
View File

@ -62,23 +62,18 @@ objc-methods global [ H{ } assoc-like ] change-at
dup objc-methods get at dup objc-methods get at
[ ] [ "No such method: " prepend throw ] ?if ; [ ] [ "No such method: " prepend throw ] ?if ;
: make-dip ( quot n -- quot' )
dup
\ >r <repetition> >quotation -rot
\ r> <repetition> >quotation 3append ;
MEMO: make-prepare-send ( selector method super? -- quot ) MEMO: make-prepare-send ( selector method super? -- quot )
[ [
[ \ <super> , ] when [ \ <super> , ] when
swap <selector> , \ selector , swap <selector> , \ selector ,
] [ ] make ] [ ] make
swap second length 2 - make-dip ; swap second length 2 - '[ @ _ ndip ] ;
MACRO: (send) ( selector super? -- quot ) MACRO: (send) ( selector super? -- quot )
[ dup lookup-method ] dip [ dup lookup-method ] dip
[ make-prepare-send ] 2keep [ make-prepare-send ] 2keep
super-message-senders message-senders ? get at super-message-senders message-senders ? get at
[ slip execute ] 2curry ; '[ _ _ slip execute ] ;
: send ( receiver args... selector -- return... ) f (send) ; inline : send ( receiver args... selector -- return... ) f (send) ; inline
@ -172,7 +167,7 @@ assoc-union alien>objc-types set-global
] unless ; ] unless ;
: (parse-objc-type) ( i string -- ctype ) : (parse-objc-type) ( i string -- ctype )
2dup nth [ 1+ ] 2dip { [ 1+ ] [ nth ] 2bi {
{ [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] } { [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] }
{ [ dup CHAR: ^ = ] [ 3drop "void*" ] } { [ dup CHAR: ^ = ] [ 3drop "void*" ] }
{ [ dup CHAR: { = ] [ drop objc-struct-type ] } { [ dup CHAR: { = ] [ drop objc-struct-type ] }
@ -234,11 +229,12 @@ assoc-union alien>objc-types set-global
: import-objc-class ( name quot -- ) : import-objc-class ( name quot -- )
2dup unless-defined 2dup unless-defined
dupd define-objc-class-word dupd define-objc-class-word
[ '[
_
dup dup
objc-class register-objc-methods objc-class register-objc-methods
objc-meta-class register-objc-methods objc-meta-class register-objc-methods
] curry try ; ] try ;
: root-class ( class -- root ) : root-class ( class -- root )
dup class_getSuperclass [ root-class ] [ ] ?if ; dup class_getSuperclass [ root-class ] [ ] ?if ;

6
basis/hash2/hash2.factor
View File

@ -14,10 +14,10 @@ IN: hash2
: <hash2> ( size -- hash2 ) f <array> ; : <hash2> ( size -- hash2 ) f <array> ;
: 2= ( a b pair -- ? ) : 2= ( a b pair -- ? )
first2 swapd [ = ] 2dip = and ; inline first2 swapd [ = ] 2bi@ and ; inline
: (assoc2) ( a b alist -- {a,b,val} ) : (assoc2) ( a b alist -- {a,b,val} )
[ [ 2dup ] dip 2= ] find [ 3drop ] dip ; inline [ 2= ] with with find nip ; inline
: assoc2 ( a b alist -- value ) : assoc2 ( a b alist -- value )
(assoc2) dup [ third ] when ; inline (assoc2) dup [ third ] when ; inline
@ -29,7 +29,7 @@ IN: hash2
[ 2dup hashcode2 ] dip [ length mod ] keep ; inline [ 2dup hashcode2 ] dip [ length mod ] keep ; inline
: hash2 ( a b hash2 -- value/f ) : hash2 ( a b hash2 -- value/f )
hash2@ nth [ assoc2 ] [ 2drop f ] if* ; hash2@ nth dup [ assoc2 ] [ 3drop f ] if ;
: set-hash2 ( a b value hash2 -- ) : set-hash2 ( a b value hash2 -- )
[ -rot ] dip hash2@ [ set-assoc2 ] change-nth ; [ -rot ] dip hash2@ [ set-assoc2 ] change-nth ;