From d26735c98f1887c0de61bf4f62b82f440d644b92 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 29 Aug 2009 10:29:41 -0500 Subject: [PATCH 1/5] mark integer sequence methods as deprecated --- core/sequences/sequences.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 177a157994..90103a79f9 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -98,9 +98,9 @@ M: f like drop [ f ] when-empty ; inline INSTANCE: f immutable-sequence -! Integers support the sequence protocol -M: integer length ; inline -M: integer nth-unsafe drop ; inline +! Integers used to support the sequence protocol +M: integer length ; inline deprecated +M: integer nth-unsafe drop ; inline deprecated INSTANCE: integer immutable-sequence From 8a9d0e13bbfd821d12d0a0ecaec7b2f4fd50e473 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 29 Aug 2009 11:15:23 -0500 Subject: [PATCH 2/5] deprecate , and make malloc-array box its returned buffer in a direct array --- basis/alien/c-types/c-types-docs.factor | 10 ++++++---- basis/alien/c-types/c-types.factor | 4 ++-- basis/specialized-arrays/functor/functor.factor | 3 +++ 3 files changed, 11 insertions(+), 6 deletions(-) diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor index f5f9e004c4..e7083a2a3a 100644 --- a/basis/alien/c-types/c-types-docs.factor +++ b/basis/alien/c-types/c-types-docs.factor @@ -49,12 +49,11 @@ HELP: c-setter { $errors "Throws an error if the type does not exist." } ; HELP: +{ $deprecated "New code should use " { $link } " or the " { $vocab-link "specialized-arrays" } " vocabularies." } { $values { "n" "a non-negative integer" } { "type" "a C type" } { "array" byte-array } } { $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." } { $errors "Throws an error if the type does not exist or the requested size is negative." } ; -{ malloc-array } related-words - HELP: { $values { "type" "a C type" } { "array" byte-array } } { $description "Creates a byte array suitable for holding a value with the given C type." } @@ -73,9 +72,10 @@ HELP: byte-array>memory HELP: malloc-array { $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } } -{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type." } +{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link } "." } +{ $notes "The appropriate direct specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." } ; { $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } -{ $errors "Throws an error if the type does not exist, if the requested size is negative, or if memory allocation fails." } ; +{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ; HELP: malloc-object { $values { "type" "a C type" } { "alien" alien } } @@ -89,6 +89,8 @@ HELP: malloc-byte-array { $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } { $errors "Throws an error if memory allocation fails." } ; +{ malloc-array } related-words + HELP: box-parameter { $values { "n" integer } { "ctype" string } } { $description "Generates code for converting a C value stored at offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." } diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 4c3c8d1668..6b56f52232 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -254,13 +254,13 @@ M: f byte-length drop 0 ; inline ] unless* ; : ( n type -- array ) - heap-size * ; inline + heap-size * ; inline deprecated : ( type -- array ) 1 swap ; inline : malloc-array ( n type -- alien ) - heap-size calloc ; inline + [ heap-size calloc ] [ ] 2bi ; inline : malloc-object ( type -- alien ) 1 swap malloc-array ; inline diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor index 3341a909d2..f5aca7fb95 100644 --- a/basis/specialized-arrays/functor/functor.factor +++ b/basis/specialized-arrays/functor/functor.factor @@ -13,6 +13,9 @@ M: bad-byte-array-length summary : (c-array) ( n c-type -- array ) heap-size * (byte-array) ; inline +: ( n type -- array ) + heap-size * ; inline + FUNCTOR: define-array ( T -- ) A DEFINES-CLASS ${T}-array From 2eff5542735dc37fa072096c73b145e4bb1ae628 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 29 Aug 2009 12:22:55 -0500 Subject: [PATCH 3/5] update cocoa and core-foundation stuff to use classes.struct and boxed malloc-arrays --- basis/cocoa/enumeration/enumeration.factor | 19 ++--- basis/cocoa/messages/messages.factor | 17 ++--- basis/cocoa/runtime/runtime.factor | 8 +- basis/cocoa/types/types.factor | 24 +++--- basis/cocoa/views/views.factor | 2 +- basis/core-foundation/core-foundation.factor | 14 ++-- .../core-foundation/fsevents/fsevents.factor | 18 ++--- basis/core-graphics/types/types.factor | 73 +++++++++---------- basis/core-text/core-text.factor | 4 +- 9 files changed, 83 insertions(+), 96 deletions(-) diff --git a/basis/cocoa/enumeration/enumeration.factor b/basis/cocoa/enumeration/enumeration.factor index 1f9430e443..9da68e368b 100644 --- a/basis/cocoa/enumeration/enumeration.factor +++ b/basis/cocoa/enumeration/enumeration.factor @@ -1,27 +1,28 @@ ! Copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel cocoa cocoa.types alien.c-types locals math -sequences vectors fry libc destructors -specialized-arrays.direct.alien ; +USING: accessors kernel classes.struct cocoa cocoa.types alien.c-types +locals math sequences vectors fry libc destructors ; IN: cocoa.enumeration +<< "id" require-c-type-arrays >> + CONSTANT: NS-EACH-BUFFER-SIZE 16 : with-enumeration-buffers ( quot -- ) '[ - "NSFastEnumerationState" malloc-object &free + NSFastEnumerationState malloc-struct &free NS-EACH-BUFFER-SIZE "id" malloc-array &free NS-EACH-BUFFER-SIZE @ ] with-destructors ; inline :: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- ) - object state stackbuf count -> countByEnumeratingWithState:objects:count: - dup 0 = [ drop ] [ - state NSFastEnumerationState-itemsPtr [ stackbuf ] unless* - swap quot each + object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count + items-count 0 = [ + state itemsPtr>> [ items-count "id" ] [ stackbuf ] if* :> items + items-count iota [ items nth quot call ] each object quot state stackbuf count (NSFastEnumeration-each) - ] if ; inline recursive + ] unless ; inline recursive : NSFastEnumeration-each ( object quot -- ) [ (NSFastEnumeration-each) ] with-enumeration-buffers ; inline diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 9da285f34c..fe003c32e1 100644 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.c-types alien.strings arrays assocs -continuations combinators compiler compiler.alien stack-checker kernel -math namespaces make quotations sequences strings words -cocoa.runtime io macros memoize io.encodings.utf8 effects libc -libc.private lexer init core-foundation fry generalizations -specialized-arrays.direct.alien ; +classes.struct continuations combinators compiler compiler.alien +stack-checker kernel math namespaces make quotations sequences +strings words cocoa.runtime io macros memoize io.encodings.utf8 +effects libc libc.private lexer init core-foundation fry +generalizations specialized-arrays.direct.alien ; IN: cocoa.messages : make-sender ( method function -- quot ) @@ -31,11 +31,8 @@ super-message-senders [ H{ } clone ] initialize bi ; : ( receiver -- super ) - "objc-super" [ - [ dup object_getClass class_getSuperclass ] dip - set-objc-super-class - ] keep - [ set-objc-super-receiver ] keep ; + [ ] [ object_getClass class_getSuperclass ] bi + objc-super ; TUPLE: selector name object ; diff --git a/basis/cocoa/runtime/runtime.factor b/basis/cocoa/runtime/runtime.factor index 7817d0006c..28d812a489 100644 --- a/basis/cocoa/runtime/runtime.factor +++ b/basis/cocoa/runtime/runtime.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006, 2007 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax ; +USING: alien.syntax classes.struct ; IN: cocoa.runtime TYPEDEF: void* SEL @@ -17,9 +17,9 @@ TYPEDEF: void* Class TYPEDEF: void* Method TYPEDEF: void* Protocol -C-STRUCT: objc-super - { "id" "receiver" } - { "Class" "class" } ; +STRUCT: objc-super + { receiver id } + { class Class } ; CONSTANT: CLS_CLASS HEX: 1 CONSTANT: CLS_META HEX: 2 diff --git a/basis/cocoa/types/types.factor b/basis/cocoa/types/types.factor index 6e03a21bbc..0e0ef72ad2 100644 --- a/basis/cocoa/types/types.factor +++ b/basis/cocoa/types/types.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006, 2009 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types alien.syntax combinators kernel layouts -core-graphics.types ; +classes.struct core-graphics.types ; IN: cocoa.types TYPEDEF: long NSInteger @@ -16,9 +16,9 @@ TYPEDEF: NSSize _NSSize TYPEDEF: CGRect NSRect TYPEDEF: NSRect _NSRect -C-STRUCT: NSRange - { "NSUInteger" "location" } - { "NSUInteger" "length" } ; +STRUCT: NSRange + { location NSUInteger } + { length NSUInteger } ; TYPEDEF: NSRange _NSRange @@ -27,13 +27,11 @@ TYPEDEF: int long32 TYPEDEF: uint ulong32 TYPEDEF: void* unknown_type -: ( length location -- size ) - "NSRange" - [ set-NSRange-length ] keep - [ set-NSRange-location ] keep ; +: ( location length -- size ) + NSRange ; -C-STRUCT: NSFastEnumerationState - { "ulong" "state" } - { "id*" "itemsPtr" } - { "ulong*" "mutationsPtr" } - { "ulong[5]" "extra" } ; +STRUCT: NSFastEnumerationState + { state ulong } + { itemsPtr id* } + { mutationsPtr ulong* } + { extra ulong[5] } ; diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor index ce785dd8df..badcac5cdb 100644 --- a/basis/cocoa/views/views.factor +++ b/basis/cocoa/views/views.factor @@ -58,6 +58,6 @@ CONSTANT: NSOpenGLCPSwapInterval 222 : mouse-location ( view event -- loc ) [ -> locationInWindow f -> convertPoint:fromView: - [ CGPoint-x ] [ CGPoint-y ] bi + [ x>> ] [ y>> ] bi ] [ drop -> frame CGRect-h ] 2bi swap - [ >integer ] bi@ 2array ; diff --git a/basis/core-foundation/core-foundation.factor b/basis/core-foundation/core-foundation.factor index 82f836f28e..63bfaf37ce 100644 --- a/basis/core-foundation/core-foundation.factor +++ b/basis/core-foundation/core-foundation.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006, 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax alien.c-types alien.destructors accessors kernel ; +USING: alien.syntax alien.c-types alien.destructors accessors classes.struct kernel ; IN: core-foundation TYPEDEF: void* CFTypeRef @@ -20,17 +20,15 @@ TYPEDEF: void* CFUUIDRef ALIAS: ALIAS: *CFIndex *long -C-STRUCT: CFRange -{ "CFIndex" "location" } -{ "CFIndex" "length" } ; +STRUCT: CFRange + { location CFIndex } + { length CFIndex } ; : ( location length -- range ) - "CFRange" - [ set-CFRange-length ] keep - [ set-CFRange-location ] keep ; + CFRange ; FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf ) ; FUNCTION: void CFRelease ( CFTypeRef cf ) ; -DESTRUCTOR: CFRelease \ No newline at end of file +DESTRUCTOR: CFRelease diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index 4aa531f182..4b2cce994a 100644 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -3,7 +3,7 @@ USING: alien alien.c-types alien.strings alien.syntax kernel math sequences namespaces make assocs init accessors continuations combinators io.encodings.utf8 destructors locals -arrays specialized-arrays.direct.alien +arrays specialized-arrays.direct.alien classes.struct specialized-arrays.direct.int specialized-arrays.direct.longlong core-foundation core-foundation.run-loop core-foundation.strings core-foundation.time ; @@ -26,12 +26,12 @@ TYPEDEF: int FSEventStreamEventFlags TYPEDEF: longlong FSEventStreamEventId TYPEDEF: void* FSEventStreamRef -C-STRUCT: FSEventStreamContext - { "CFIndex" "version" } - { "void*" "info" } - { "void*" "retain" } - { "void*" "release" } - { "void*" "copyDescription" } ; +STRUCT: FSEventStreamContext + { version CFIndex } + { info void* } + { retain void* } + { release void* } + { copyDescription void* } ; ! callback(FSEventStreamRef streamRef, void *clientCallBackInfo, size_t numEvents, void *eventPaths, const FSEventStreamEventFlags eventFlags[], const FSEventStreamEventId eventIds[]); TYPEDEF: void* FSEventStreamCallback @@ -104,8 +104,8 @@ FUNCTION: void FSEventStreamShow ( FSEventStreamRef streamRef ) ; FUNCTION: CFStringRef FSEventStreamCopyDescription ( FSEventStreamRef streamRef ) ; : make-FSEventStreamContext ( info -- alien ) - "FSEventStreamContext" - [ set-FSEventStreamContext-info ] keep ; + FSEventStreamContext + swap >>info ; :: ( callback info paths latency flags -- event-stream ) f ! allocator diff --git a/basis/core-graphics/types/types.factor b/basis/core-graphics/types/types.factor index 0acdad9c0c..ad4620e174 100644 --- a/basis/core-graphics/types/types.factor +++ b/basis/core-graphics/types/types.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types alien.syntax kernel layouts +USING: accessors alien.c-types alien.syntax classes.struct kernel layouts math math.rectangles arrays ; IN: core-graphics.types @@ -12,63 +12,56 @@ IN: core-graphics.types : *CGFloat ( alien -- x ) cell 4 = [ *float ] [ *double ] if ; inline -C-STRUCT: CGPoint - { "CGFloat" "x" } - { "CGFloat" "y" } ; +STRUCT: CGPoint + { x CGFloat } + { y CGFloat } ; : ( x y -- point ) - "CGPoint" - [ set-CGPoint-y ] keep - [ set-CGPoint-x ] keep ; + CGPoint ; -C-STRUCT: CGSize - { "CGFloat" "w" } - { "CGFloat" "h" } ; +STRUCT: CGSize + { w CGFloat } + { h CGFloat } ; : ( w h -- size ) - "CGSize" - [ set-CGSize-h ] keep - [ set-CGSize-w ] keep ; + CGSize ; -C-STRUCT: CGRect - { "CGPoint" "origin" } - { "CGSize" "size" } ; +STRUCT: CGRect + { origin CGPoint } + { size CGSize } ; : CGPoint>loc ( CGPoint -- loc ) - [ CGPoint-x ] [ CGPoint-y ] bi 2array ; + [ x>> ] [ y>> ] bi 2array ; : CGSize>dim ( CGSize -- dim ) - [ CGSize-w ] [ CGSize-h ] bi 2array ; + [ w>> ] [ h>> ] bi 2array ; : CGRect>rect ( CGRect -- rect ) - [ CGRect-origin CGPoint>loc ] - [ CGRect-size CGSize>dim ] + [ origin>> CGPoint>loc ] + [ size>> CGSize>dim ] bi ; inline : CGRect-x ( CGRect -- x ) - CGRect-origin CGPoint-x ; inline + origin>> x>> ; inline : CGRect-y ( CGRect -- y ) - CGRect-origin CGPoint-y ; inline + origin>> y>> ; inline : CGRect-w ( CGRect -- w ) - CGRect-size CGSize-w ; inline + size>> w>> ; inline : CGRect-h ( CGRect -- h ) - CGRect-size CGSize-h ; inline + size>> h>> ; inline : set-CGRect-x ( x CGRect -- ) - CGRect-origin set-CGPoint-x ; inline + origin>> (>>x) ; inline : set-CGRect-y ( y CGRect -- ) - CGRect-origin set-CGPoint-y ; inline + origin>> (>>y) ; inline : set-CGRect-w ( w CGRect -- ) - CGRect-size set-CGSize-w ; inline + size>> (>>w) ; inline : set-CGRect-h ( h CGRect -- ) - CGRect-size set-CGSize-h ; inline + size>> (>>h) ; inline : ( x y w h -- rect ) - "CGRect" - [ set-CGRect-h ] keep - [ set-CGRect-w ] keep - [ set-CGRect-y ] keep - [ set-CGRect-x ] keep ; + [ CGPoint ] [ CGSize ] 2bi* + CGRect ; : CGRect-x-y ( alien -- origin-x origin-y ) [ CGRect-x ] [ CGRect-y ] bi ; @@ -76,13 +69,13 @@ C-STRUCT: CGRect : CGRect-top-left ( alien -- x y ) [ CGRect-x ] [ [ CGRect-y ] [ CGRect-h ] bi + ] bi ; -C-STRUCT: CGAffineTransform - { "CGFloat" "a" } - { "CGFloat" "b" } - { "CGFloat" "c" } - { "CGFloat" "d" } - { "CGFloat" "tx" } - { "CGFloat" "ty" } ; +STRUCT: CGAffineTransform + { a CGFloat } + { b CGFloat } + { c CGFloat } + { d CGFloat } + { tx CGFloat } + { ty CGFloat } ; TYPEDEF: void* CGColorRef TYPEDEF: void* CGColorSpaceRef diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor index 52f4eb5e2e..99849c1666 100644 --- a/basis/core-text/core-text.factor +++ b/basis/core-text/core-text.factor @@ -116,8 +116,8 @@ TUPLE: line < disposable line metrics image loc dim ; line [ string open-font font foreground>> |CFRelease ] rect [ line line-rect ] - (loc) [ rect CGRect-origin CGPoint>loc ] - (dim) [ rect CGRect-size CGSize>dim ] + (loc) [ rect origin>> CGPoint>loc ] + (dim) [ rect size>> CGSize>dim ] (ext) [ (loc) (dim) v+ ] loc [ (loc) [ floor ] map ] ext [ (loc) (dim) [ + ceiling ] 2map ] From 64baa58a3d8a5fabb9e9bf632dfcb76045d7b9ad Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 29 Aug 2009 12:23:09 -0500 Subject: [PATCH 4/5] typo in alien.c-types docs --- basis/alien/c-types/c-types-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor index e7083a2a3a..cd0f90f81c 100644 --- a/basis/alien/c-types/c-types-docs.factor +++ b/basis/alien/c-types/c-types-docs.factor @@ -73,7 +73,7 @@ HELP: byte-array>memory HELP: malloc-array { $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } } { $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link } "." } -{ $notes "The appropriate direct specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." } ; +{ $notes "The appropriate direct specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." } { $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } { $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ; From 0e8fe01d11279b97cbfd03c87e3db0a93943b11b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 29 Aug 2009 12:45:59 -0500 Subject: [PATCH 5/5] change malloc-object and not to be in terms of malloc-array and --- basis/alien/c-types/c-types.factor | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 6b56f52232..8a1b60a0db 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -257,13 +257,16 @@ M: f byte-length drop 0 ; inline heap-size * ; inline deprecated : ( type -- array ) - 1 swap ; inline + heap-size ; inline + +: (c-object) ( type -- array ) + heap-size (byte-array) ; inline : malloc-array ( n type -- alien ) [ heap-size calloc ] [ ] 2bi ; inline : malloc-object ( type -- alien ) - 1 swap malloc-array ; inline + heap-size malloc ; inline : malloc-byte-array ( byte-array -- alien ) dup byte-length [ nip malloc dup ] 2keep memcpy ;