alien.destructors: new functors.
parent
7616f6e95d
commit
56d437a1e7
|
@ -1,32 +1,23 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors destructors effects functors generalizations
|
||||
kernel parser sequences ;
|
||||
USING: functors2 ;
|
||||
IN: alien.destructors
|
||||
|
||||
TUPLE: alien-destructor alien ;
|
||||
|
||||
<FUNCTOR: define-destructor ( F -- )
|
||||
SAME-FUNCTOR: destructor ( F: existing-word -- ) [[
|
||||
USING: accessors alien.destructors effects generalizations
|
||||
destructors kernel literals sequences ;
|
||||
|
||||
F-destructor DEFINES-CLASS ${F}-destructor
|
||||
<F-destructor> DEFINES <${F}-destructor>
|
||||
&F DEFINES &${F}
|
||||
|F DEFINES |${F}
|
||||
N [ F stack-effect out>> length ]
|
||||
TUPLE: ${F}-destructor < alien-destructor ;
|
||||
|
||||
WHERE
|
||||
: <${F}-destructor> ( alien -- destructor )
|
||||
${F}-destructor boa ; inline
|
||||
|
||||
TUPLE: F-destructor < alien-destructor ;
|
||||
: &${F} ( alien -- alien ) dup <${F}-destructor> &dispose drop ; inline
|
||||
|
||||
: <F-destructor> ( alien -- destructor )
|
||||
F-destructor boa ; inline
|
||||
: |${F} ( alien -- alien ) dup <${F}-destructor> |dispose drop ; inline
|
||||
|
||||
M: F-destructor dispose alien>> F N ndrop ;
|
||||
M: ${F}-destructor dispose alien>> ${F} $[ \ ${F} stack-effect out>> length ] ndrop ;
|
||||
|
||||
: &F ( alien -- alien ) dup <F-destructor> &dispose drop ; inline
|
||||
|
||||
: |F ( alien -- alien ) dup <F-destructor> |dispose drop ; inline
|
||||
|
||||
;FUNCTOR>
|
||||
|
||||
SYNTAX: \DESTRUCTOR: scan-word define-destructor ;
|
||||
]]
|
||||
|
|
|
@ -38,6 +38,8 @@ STRUCT: CFRange
|
|||
|
||||
FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf )
|
||||
|
||||
<<
|
||||
FUNCTION: void CFRelease ( CFTypeRef cf )
|
||||
>>
|
||||
|
||||
DESTRUCTOR: CFRelease
|
||||
|
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2007, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs bootstrap.image hashtables io io.directories
|
||||
io.encodings.utf8 io.files io.files.temp io.launcher io.pathnames
|
||||
kernel locals make namespaces prettyprint sequences splitting system
|
||||
tools.deploy.config tools.deploy.config.editor tools.deploy.embed
|
||||
USING: accessors assocs bootstrap.image hashtables io
|
||||
io.directories io.encodings.utf8 io.files io.files.temp
|
||||
io.launcher io.pathnames kernel make namespaces prettyprint
|
||||
sequences splitting system tools.deploy.config
|
||||
tools.deploy.config.editor tools.deploy.embed
|
||||
tools.deploy.libraries vocabs.loader vocabs.metadata.resources
|
||||
webbrowser ;
|
||||
IN: tools.deploy.backend
|
||||
|
|
|
@ -119,25 +119,7 @@ M: word parent-word drop f ;
|
|||
2tri
|
||||
] if ;
|
||||
|
||||
![[
|
||||
: inline-quotation? ( obj -- ? )
|
||||
{ [ dup array? [ length>> 2 >= ] [ drop f ] if ] [ second quotation? ] } 1&& ;
|
||||
|
||||
: effect>inline-quotations ( effect -- quot/f )
|
||||
in>>
|
||||
[ dup inline-quotation? [ last ] [ drop [ ] ] if ] map
|
||||
dup [ length 0 > ] any? [ '[ _ spread ] ] [ drop f ] if ;
|
||||
|
||||
: apply-inlined-effects ( def effect -- def effect )
|
||||
dup effect>inline-quotations dup [
|
||||
swap [ prepose ] dip
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
]]
|
||||
|
||||
: define-declared ( word def effect -- )
|
||||
! apply-inlined-effects
|
||||
[ nip swap set-stack-effect ] [ drop define ] 3bi ;
|
||||
|
||||
: make-deprecated ( word -- )
|
||||
|
|
Loading…
Reference in New Issue