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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
basis/alien/destructors/destructors.factor
View File

@ -1,32 +1,23 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors destructors effects functors generalizations USING: functors2 ;
kernel parser sequences ;
IN: alien.destructors IN: alien.destructors
TUPLE: alien-destructor alien ; 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 TUPLE: ${F}-destructor < alien-destructor ;
<F-destructor> DEFINES <${F}-destructor>
&F DEFINES &${F}
|F DEFINES |${F}
N [ F stack-effect out>> length ]
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} ( alien -- alien ) dup <${F}-destructor> |dispose drop ; inline
F-destructor boa ; 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 ;

2
basis/core-foundation/core-foundation.factor
View File

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

9
basis/tools/deploy/backend/backend.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2007, 2010 Slava Pestov. ! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs bootstrap.image hashtables io io.directories USING: accessors assocs bootstrap.image hashtables io
io.encodings.utf8 io.files io.files.temp io.launcher io.pathnames io.directories io.encodings.utf8 io.files io.files.temp
kernel locals make namespaces prettyprint sequences splitting system io.launcher io.pathnames kernel make namespaces prettyprint
tools.deploy.config tools.deploy.config.editor tools.deploy.embed sequences splitting system tools.deploy.config
tools.deploy.config.editor tools.deploy.embed
tools.deploy.libraries vocabs.loader vocabs.metadata.resources tools.deploy.libraries vocabs.loader vocabs.metadata.resources
webbrowser ; webbrowser ;
IN: tools.deploy.backend IN: tools.deploy.backend

18
core/words/words.factor
View File

@ -119,25 +119,7 @@ M: word parent-word drop f ;
2tri 2tri
] if ; ] 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 -- ) : define-declared ( word def effect -- )
! apply-inlined-effects
[ nip swap set-stack-effect ] [ drop define ] 3bi ; [ nip swap set-stack-effect ] [ drop define ] 3bi ;
: make-deprecated ( word -- ) : make-deprecated ( word -- )