alien.destructors: new functors.

modern-harvey2
Doug Coleman 2017-12-02 17:21:49 -06:00
parent 7616f6e95d
commit 56d437a1e7
4 changed files with 18 additions and 42 deletions

View File

@ -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 ;
]]

View File

@ -38,6 +38,8 @@ STRUCT: CFRange
FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf )
<<
FUNCTION: void CFRelease ( CFTypeRef cf )
>>
DESTRUCTOR: CFRelease

View File

@ -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

View File

@ -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 -- )