Merge branch 'master' of git://factorforge.org/git/william42

diff --git a/core/arrays/arrays.factor b/core/arrays/arrays.factor
index 9c5f40d88327f3d2fc4d1686cfca22e207a45694..02e0e45544169faa504d6f09d57ad2ff6233c066 100755 (executable)
--- a/core/arrays/arrays.factor
+++ b/core/arrays/arrays.factor
@@ -1,11 +1,11 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private math math.private sequences
-sequences.private ;
+USING: accessors kernel kernel.private math math.private
+sequences sequences.private ;
 IN: arrays
 
 M: array clone (clone) ;
-M: array length array-capacity ;
+M: array length length>> ;
 M: array nth-unsafe >r >fixnum r> array-nth ;
 M: array set-nth-unsafe >r >fixnum r> set-array-nth ;
 M: array resize resize-array ;

diff --git a/core/bootstrap/compiler/compiler.factor b/core/bootstrap/compiler/compiler.factor
index 04e53046fe5eca2bae455b380fbfcd7fdc37f92a..f25eafeb17d79c2ccae7f795fdb87857f018a734 100755 (executable)
--- a/core/bootstrap/compiler/compiler.factor
+++ b/core/bootstrap/compiler/compiler.factor
@@ -37,7 +37,7 @@ nl
     array? hashtable? vector?
     tuple? sbuf? node? tombstone?
 
-    array-capacity array-nth set-array-nth
+    array-nth set-array-nth
 
     wrap probe
 

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index b2b6dc4e59087131ee7d53ff54a8782956387a2a..a6ebf13f4de510d6b0893f181875b89c599c76eb 100755 (executable)
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -225,7 +225,9 @@ bi
     { "imaginary" { "real" "math" } read-only }
 } define-builtin
 
-"array" "arrays" create { } define-builtin
+"array" "arrays" create {
+    { "length" { "array-capacity" "sequences.private" } read-only }
+} define-builtin
 
 "wrapper" "kernel" create {
     { "wrapped" read-only }
@@ -261,7 +263,9 @@ bi
     { "sub-primitive" read-only }
 } define-builtin
 
-"byte-array" "byte-arrays" create { } define-builtin
+"byte-array" "byte-arrays" create {
+    { "length" { "array-capacity" "sequences.private" } read-only }
+} define-builtin
 
 "callstack" "kernel" create { } define-builtin
 

diff --git a/core/byte-arrays/byte-arrays.factor b/core/byte-arrays/byte-arrays.factor
index d6034708102abf55812b929702621822f7e42615..5461da2b84f307eb98af8c2697eb677e71a951d0 100755 (executable)
--- a/core/byte-arrays/byte-arrays.factor
+++ b/core/byte-arrays/byte-arrays.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private alien.accessors sequences
+USING: accessors kernel kernel.private alien.accessors sequences
 sequences.private math ;
 IN: byte-arrays
 
 M: byte-array clone (clone) ;
-M: byte-array length array-capacity ;
+M: byte-array length length>> ;
 M: byte-array nth-unsafe swap >fixnum alien-unsigned-1 ;
 M: byte-array set-nth-unsafe swap >fixnum set-alien-unsigned-1 ;
 : >byte-array ( seq -- byte-array ) B{ } clone-like ; inline

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 17d8e3693527722aa7510f98500161ed8b725769..4216a5dc3d672928e01eb462cf51a5382b603bdf 100755 (executable)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -91,7 +91,7 @@ ERROR: bad-superclass class ;
     #! 4 slot == superclasses>>
     rot dup tuple? [
         layout-of 4 slot
-        2dup array-capacity fixnum<
+        2dup 1 slot fixnum<
         [ array-nth eq? ] [ 3drop f ] if
     ] [ 3drop f ] if ; inline
 

diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor
index e804bb76fab665e3315c9af4bf2c3a8fa192d336..943071a9f8dbc4f943546e73020062ae650040d9 100755 (executable)
--- a/core/hashtables/hashtables.factor
+++ b/core/hashtables/hashtables.factor
@@ -12,7 +12,7 @@ TUPLE: hashtable
 <PRIVATE
 
 : wrap ( i array -- n )
-    array-capacity 1 fixnum-fast fixnum-bitand ; inline
+    length>> 1 fixnum-fast fixnum-bitand ; inline
 
 : hash@ ( key array -- i )
     >r hashcode >fixnum dup fixnum+fast r> wrap ; inline
@@ -30,7 +30,7 @@ TUPLE: hashtable
     ] if ; inline
 
 : key@ ( key hash -- array n ? )
-    array>> dup array-capacity 0 eq?
+    array>> dup length>> 0 eq?
     [ no-key ] [ 2dup hash@ (key@) ] if ; inline
 
 : <hash-array> ( n -- array )
@@ -71,7 +71,7 @@ TUPLE: hashtable
 
 : hash-large? ( hash -- ? )
     [ count>> 3 fixnum*fast 1 fixnum+fast ]
-    [ array>> array-capacity ] bi fixnum> ; inline
+    [ array>> length>> ] bi fixnum> ; inline
 
 : hash-stale? ( hash -- ? )
     [ deleted>> 10 fixnum*fast ] [ count>> ] bi fixnum> ; inline

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 11cfb975df0e37bb6c444d0774799d74a4e3558c..07900a900db15a1182ac42767a4d903f20bdc846 100755 (executable)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -60,9 +60,6 @@ INSTANCE: immutable-sequence sequence
 
 <PRIVATE
 
-: array-capacity ( array -- n )
-    1 slot { array-capacity } declare ; inline
-
 : array-nth ( n array -- elt )
     swap 2 fixnum+fast slot ; inline
 

diff --git a/extra/benchmark/backtrack/backtrack.factor b/extra/benchmark/backtrack/backtrack.factor
index 5d011b5d363277b4d6a0057bdb1538077e2c76e4..df67872b1143ac8afc75cc2aa81356bcd94382c2 100755 (executable)
--- a/extra/benchmark/backtrack/backtrack.factor
+++ b/extra/benchmark/backtrack/backtrack.factor
@@ -51,3 +51,5 @@ MEMO: 24-from-4 ( a b c d -- ? )
         dup pprint " tested " write "memoize" word-prop assoc-size pprint
         " possibilities" print
     ] each ;
+
+MAIN: backtrack-benchmark

diff --git a/extra/core-foundation/core-foundation-docs.factor b/extra/core-foundation/core-foundation-docs.factor
index ef8f5842a22cf918b047af6407c58834a24cda18..3cd9b838d403a6ad1574ebc5268e2e5abe88541e 100644 (file)
--- a/extra/core-foundation/core-foundation-docs.factor
+++ b/extra/core-foundation/core-foundation-docs.factor
@@ -1,4 +1,4 @@
-USING: alien strings arrays help.markup help.syntax ;
+USING: alien strings arrays help.markup help.syntax destructors ;
 IN: core-foundation
 
 HELP: CF>array
@@ -37,6 +37,16 @@ HELP: load-framework
 { $values { "name" "a pathname string" } }
 { $description "Loads a Core Foundation framework." } ;
 
+HELP: &CFRelease
+{ $values { "alien" "Pointer to a Core Foundation object" } }
+{ $description "Marks the given Core Foundation object for unconditional release via " { $link CFRelease } " at the end of the enclosing " { $link with-destructors } " scope." } ;
+
+HELP: |CFRelease
+{ $values { "interface" "Pointer to a Core Foundation object" } }
+{ $description "Marks the given Core Foundation object for release via " { $link CFRelease } " in the event of an error at the end of the enclosing " { $link with-destructors } " scope." } ;
+
+{ CFRelease |CFRelease &CFRelease } related-words
+
 ARTICLE: "core-foundation" "Core foundation utilities"
 "The " { $vocab-link "core-foundation" } " vocabulary defines bindings for some frequently-used Core Foundation functions. It also provides some utility words."
 $nl
@@ -51,7 +61,9 @@ $nl
 { $subsection <CFFileSystemURL> }
 { $subsection <CFURL> }
 "Frameworks:"
-{ $subsection load-framework } ;
+{ $subsection load-framework }
+"Memory management:"
+{ $subsection &CFRelease }
+{ $subsection |CFRelease } ;
 
-IN: core-foundation
 ABOUT: "core-foundation"

diff --git a/extra/core-foundation/core-foundation.factor b/extra/core-foundation/core-foundation.factor
index d2376997e504e02eb90205a9bbed9545679c0192..c511a24320527a5e4c00ca3c93d6e0d2ae951780 100644 (file)
--- a/extra/core-foundation/core-foundation.factor
+++ b/extra/core-foundation/core-foundation.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings alien.syntax kernel
-math sequences io.encodings.utf16 ;
+math sequences io.encodings.utf16 destructors accessors ;
 IN: core-foundation
 
 TYPEDEF: void* CFAllocatorRef
@@ -135,3 +135,9 @@ M: f <CFNumber>
         "Cannot load bundled named " prepend throw
     ] ?if ;
 
+TUPLE: CFRelease-destructor alien disposed ;
+M: CFRelease-destructor dispose* alien>> CFRelease ;
+: &CFRelease ( alien -- alien )
+    dup f CFRelease-destructor boa &dispose drop ; inline
+: |CFRelease ( alien -- alien )
+    dup f CFRelease-destructor boa |dispose drop ; inline

diff --git a/extra/html/components/components-tests.factor b/extra/html/components/components-tests.factor
index 5779371078b7471de8aa93f4a3736ad45b7b5e8e..56c7118ab96e95e0090b88cb8666a3f29073a0fc 100644 (file)
--- a/extra/html/components/components-tests.factor
+++ b/extra/html/components/components-tests.factor
@@ -155,7 +155,7 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ;
 
 [ ] [ "-foo\n-bar" "farkup" set-value ] unit-test
 
-[ "<ul><li>foo</li><li>bar</li></ul>" ] [
+[ "<ul><li>foo</li>\n<li>bar</li></ul>" ] [
     [ "farkup" T{ farkup } render ] with-string-writer
 ] unit-test
 

diff --git a/extra/iokit/iokit.factor b/extra/iokit/iokit.factor
index 1babd697c14cd703874d3c4d9efe97f0f44b280d..680723def903f61c37779395caa1deb2c616a42c 100644 (file)
--- a/extra/iokit/iokit.factor
+++ b/extra/iokit/iokit.factor
@@ -2,10 +2,11 @@ USING: alien.syntax alien.c-types core-foundation system
 combinators kernel sequences debugger io accessors ;
 IN: iokit
 
-<< {
-    { [ os macosx? ] [ "/System/Library/Frameworks/IOKit.framework" load-framework ] }
-    [ "IOKit only supported on Mac OS X" ]
-} cond >>
+<<
+    os macosx?
+    [ "/System/Library/Frameworks/IOKit.framework" load-framework ]
+    when
+>>
 
 : kIOKitBuildVersionKey   "IOKitBuildVersion" ; inline
 : kIOKitDiagnosticsKey   "IOKitDiagnostics" ; inline

diff --git a/extra/ui/gadgets/panes/panes.factor b/extra/ui/gadgets/panes/panes.factor
index 31a7249a7969750a9da11fc93520feb13a002f13..cca757e0eb708de096d22416c14938175f9e8ed3 100755 (executable)
--- a/extra/ui/gadgets/panes/panes.factor
+++ b/extra/ui/gadgets/panes/panes.factor
@@ -332,10 +332,8 @@ M: paragraph stream-format
 
 GENERIC: sloppy-pick-up* ( loc gadget -- n )
 
-M: pack sloppy-pick-up*
-    dup gadget-orientation
-    swap gadget-children
-    (fast-children-on) ;
+M: pack sloppy-pick-up* ( loc gadget -- n )
+   [ orientation>> ] [ children>> ] bi (fast-children-on) ;
 
 M: gadget sloppy-pick-up*
     gadget-children [ inside? ] with find-last drop ;

diff --git a/extra/windows/com/com-docs.factor b/extra/windows/com/com-docs.factor
index 68663b4cdbc6f1a3377dda975386b321d641ac2d..8c7584828fc382980d0a01562ef506380bd37d8f 100644 (file)
--- a/extra/windows/com/com-docs.factor
+++ b/extra/windows/com/com-docs.factor
@@ -1,5 +1,5 @@
 USING: help.markup help.syntax io kernel math quotations\r
-multiline ;\r
+multiline destructors ;\r
 IN: windows.com\r
 \r
 HELP: com-query-interface\r
@@ -13,3 +13,14 @@ HELP: com-add-ref
 HELP: com-release\r
 { $values { "interface" "Pointer to a COM interface implementing " { $snippet "IUnknown" } } }\r
 { $description "A small wrapper around " { $link IUnknown::Release } ". Decrements the reference count on " { $snippet "interface" } ", releasing the underlying object if the reference count has reached zero." } ;\r
+\r
+HELP: &com-release\r
+{ $values { "interface" "Pointer to a COM interface implementing " { $snippet "IUnknown" } } }\r
+{ $description "Marks the given COM interface for unconditional release via " { $link com-release } " at the end of the enclosing " { $link with-destructors } " scope." } ;\r
+\r
+HELP: |com-release\r
+{ $values { "interface" "Pointer to a COM interface implementing " { $snippet "IUnknown" } } }\r
+{ $description "Marks the given COM interface for release via " { $link com-release } " in the event of an error at the end of the enclosing " { $link with-destructors } " scope." } ;\r
+\r
+{ com-release &com-release |com-release } related-words\r
+\r

diff --git a/extra/windows/com/com.factor b/extra/windows/com/com.factor
index 4202ed4c56ce32015be810fc4d388fc2f319eed4..9649de6402f214a1c2572430152bd0165a9852e8 100755 (executable)
--- a/extra/windows/com/com.factor
+++ b/extra/windows/com/com.factor
@@ -1,5 +1,6 @@
 USING: alien alien.c-types windows.com.syntax windows.ole32\r
-windows.types continuations kernel alien.syntax libc ;\r
+windows.types continuations kernel alien.syntax libc\r
+destructors accessors ;\r
 IN: windows.com\r
 \r
 LIBRARY: ole32\r
@@ -39,3 +40,11 @@ COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}
 \r
 : with-com-interface ( interface quot -- )\r
     over [ slip ] [ com-release ] [ ] cleanup ; inline\r
+\r
+TUPLE: com-destructor interface disposed ;\r
+M: com-destructor dispose* interface>> com-release ;\r
+\r
+: &com-release ( interface -- interface )\r
+    dup f com-destructor boa &dispose drop ;\r
+: |com-release ( interface -- interface )\r
+    dup f com-destructor boa |dispose drop ;\r

diff --git a/extra/windows/dinput/dinput.factor b/extra/windows/dinput/dinput.factor
index 25abbb7534649e0aa9375382a5ca76300a309132..a41f2ed80d3319b7c71e3041d3eb6f5e4083c103 100755 (executable)
--- a/extra/windows/dinput/dinput.factor
+++ b/extra/windows/dinput/dinput.factor
@@ -2,9 +2,10 @@ USING: windows.kernel32 windows.ole32 windows.com windows.com.syntax
 alien alien.c-types alien.syntax kernel system namespaces math ;
 IN: windows.dinput
 
-<< os windows?
+<<
+    os windows?
     [ "dinput" "dinput8.dll" "stdcall" add-library ]
-    [ "DirectInput only supported on Windows" throw ] if
+    when
 >>
 
 LIBRARY: dinput