Merge branch 'master' of git://factorcode.org/git/factor

basis/alias/alias-docs.factor

@@ -1,26 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel words help.markup help.syntax ;
-IN: alias
-
-HELP: ALIAS:
-{ $syntax "ALIAS: new-word existing-word" }
-{ $values { "new-word" word } { "existing-word" word } }
-{ $description "Creates a " { $snippet "new" } " inlined word that calls the " { $snippet "existing" } " word." }
-{ $examples
-    { $example "USING: alias prettyprint sequences ;"
-               "IN: alias.test"
-               "ALIAS: sequence-nth nth"
-               "0 { 10 20 30 } sequence-nth ."
-               "10"
-    }
-} ;
-
-ARTICLE: "alias" "Word aliasing"
-"The " { $vocab-link "alias" } " vocabulary implements a way to make many different names for the same word. Although creating new names for words is generally frowned upon, aliases are useful for the Win32 API and other cases where words need to be renamed for symmetry." $nl 
-"Make a new word that aliases another word:"
-{ $subsection define-alias }
-"Make an alias at parse-time:"
-{ $subsection POSTPONE: ALIAS: } ;
-
-ABOUT: "alias"

basis/alien/c-types/c-types.factor

@@ -234,17 +234,16 @@ M: long-long-type box-return ( type -- )
     f swap box-parameter ;
 
 : define-deref ( name -- )
-    [ CHAR: * prefix "alien.c-types" create ]
+    [ CHAR: * prefix "alien.c-types" create ] [ c-getter 0 prefix ] bi
-    [ c-getter 0 prefix ] bi
+    (( c-ptr -- value )) define-inline ;
-    define-inline ;
 
 : define-out ( name -- )
     [ "alien.c-types" constructor-word ]
-    [ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ]
+    [ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi
-    bi define-inline ;
+    (( value -- c-ptr )) define-inline ;
 
 : c-bool> ( int -- ? )
-    zero? not ;
+    0 = not ; inline
 
 : define-primitive-type ( type name -- )
     [ typedef ]

basis/alien/structs/fields/fields.factor

@@ -52,8 +52,8 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
         [ (>>offset) ] [ type>> heap-size + ] 2bi
     ] reduce ;
 
-: define-struct-slot-word ( word quot spec -- )
+: define-struct-slot-word ( word quot spec effect -- )
-    offset>> prefix define-inline ;
+    [ offset>> prefix ] dip define-inline ;
 
 : define-getter ( type spec -- )
     [ set-reader-props ] keep
@@ -62,11 +62,13 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
         type>>
         [ c-getter ] [ c-type-boxer-quot ] bi append
     ]
-    [ ] tri define-struct-slot-word ;
+    [ ] tri
+    (( c-ptr -- value )) define-struct-slot-word ;
 
 : define-setter ( type spec -- )
     [ set-writer-props ] keep
-    [ writer>> ] [ type>> c-setter ] [ ] tri define-struct-slot-word ;
+    [ writer>> ] [ type>> c-setter ] [ ] tri
+    (( value c-ptr -- )) define-struct-slot-word ;
 
 : define-field ( type spec -- )
     [ define-getter ] [ define-setter ] 2bi ;

basis/alien/syntax/syntax.factor

@@ -4,7 +4,7 @@ USING: accessors arrays alien alien.c-types alien.structs
 alien.arrays alien.strings kernel math namespaces parser
 sequences words quotations math.parser splitting grouping
 effects assocs combinators lexer strings.parser alien.parser 
-fry ;
+fry vocabs.parser ;
 IN: alien.syntax
 
 : DLL" lexer get skip-blank parse-string dlopen parsed ; parsing

basis/assoc-heaps/assoc-heaps-docs.factor

@@ -1,20 +1,19 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax io.streams.string ;
+USING: help.markup help.syntax io.streams.string assocs
+heaps.private ;
 IN: assoc-heaps
 
 HELP: <assoc-heap>
+{ $values { "assoc" assoc } { "heap" heap } { "assoc-heap" assoc-heap } }
 { $description "Constructs a new " { $link assoc-heap } " from two existing data structures." } ;
 
 HELP: <unique-max-heap>
-{ $values
+{ $values { "unique-heap" assoc-heap } }
-    
-     { "unique-heap" assoc-heap } }
 { $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;
 
 HELP: <unique-min-heap>
-{ $values
+{ $values { "unique-heap" assoc-heap } }
-     { "unique-heap" assoc-heap } }
 { $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;
 
 { <unique-max-heap> <unique-min-heap> } related-words

basis/bit-arrays/bit-arrays.factor

@@ -11,7 +11,7 @@ TUPLE: bit-array
 
 <PRIVATE
 
-: n>byte -3 shift ; inline
+: n>byte ( m -- n ) -3 shift ; inline
 
 : byte/bit ( n alien -- byte bit )
     over n>byte alien-unsigned-1 swap 7 bitand ; inline
@@ -19,9 +19,9 @@ TUPLE: bit-array
 : set-bit ( ? byte bit -- byte )
     2^ rot [ bitor ] [ bitnot bitand ] if ; inline
 
-: bits>cells 31 + -5 shift ; inline
+: bits>cells ( m -- n ) 31 + -5 shift ; inline
 
-: bits>bytes 7 + n>byte ; inline
+: bits>bytes ( m -- n ) 7 + n>byte ; inline
 
 : (set-bits) ( bit-array n -- )
     [ [ length bits>cells ] keep ] dip swap underlying>>

basis/bootstrap/finish-bootstrap.factor

@@ -12,5 +12,6 @@ namespaces eval kernel vocabs.loader io ;
         ignore-cli-args? not script get and
         [ run-script ] [ "run" get run ] if*
         output-stream get [ stream-flush ] when*
+        0 exit
     ] [ print-error 1 exit ] recover
 ] set-boot-quot

basis/bootstrap/finish-staging.factor

@@ -7,4 +7,5 @@ io ;
     (command-line) parse-command-line
     "run" get run
     output-stream get [ stream-flush ] when*
+    0 exit
 ] set-boot-quot

basis/bootstrap/image/image-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax io io.files ;
+USING: help.markup help.syntax io io.files io.pathnames ;
 IN: bootstrap.image
 
 ARTICLE: "bootstrap.image" "Bootstrapping new images"

basis/bootstrap/image/image.factor

@@ -1,14 +1,15 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays byte-arrays generic assocs hashtables assocs
-hashtables.private io kernel kernel.private math namespaces make
+hashtables.private io io.binary io.files io.encodings.binary
-parser prettyprint sequences sequences.private strings sbufs
+io.pathnames kernel kernel.private math namespaces make parser
+prettyprint sequences sequences.private strings sbufs
 vectors words quotations assocs system layouts splitting
 grouping growable classes classes.builtin classes.tuple
-classes.tuple.private words.private io.binary io.files vocabs
+classes.tuple.private words.private vocabs
 vocabs.loader source-files definitions debugger
 quotations.private sequences.private combinators
-io.encodings.binary math.order math.private accessors
+math.order math.private accessors
 slots.private compiler.units ;
 IN: bootstrap.image
 
@@ -65,7 +66,7 @@ M: id equal?
 
 SYMBOL: objects
 
-: (objects) <id> objects get ; inline
+: (objects) ( obj -- id assoc ) <id> objects get ; inline
 
 : lookup-object ( obj -- n/f ) (objects) at ;
 

basis/bootstrap/image/upload/upload.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: checksums checksums.openssl splitting assocs
 kernel io.files bootstrap.image sequences io namespaces make
-io.launcher math io.encodings.ascii ;
+io.launcher math io.encodings.ascii io.files.temp io.pathnames
+io.directories ;
 IN: bootstrap.image.upload
 
 SYMBOL: upload-images-destination

basis/bootstrap/io/io.factor

@@ -1,12 +1,11 @@
 USING: system vocabs vocabs.loader kernel combinators
-namespaces sequences io.backend ;
+namespaces sequences io.backend accessors ;
 IN: bootstrap.io
 
 "bootstrap.compiler" vocab [
-    "io." {
+    "io.backend." {
         { [ "io-backend" get ] [ "io-backend" get ] }
-        { [ os unix? ] [ "unix" ] }
+        { [ os unix? ] [ "unix." os name>> append ] }
         { [ os winnt? ] [ "windows.nt" ] }
-        { [ os wince? ] [ "windows.ce" ] }
     } cond append require
 ] when

basis/bootstrap/stage2.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors init namespaces words io
+USING: accessors init namespaces words words.symbol io
 kernel.private math memory continuations kernel io.files
-io.backend system parser vocabs sequences
+io.pathnames io.backend system parser vocabs sequences
 vocabs.loader combinators splitting source-files strings
-definitions assocs compiler.errors compiler.units
+definitions assocs compiler.errors compiler.units math.parser
-math.parser generic sets command-line ;
+generic sets command-line ;
 IN: bootstrap.stage2
 
 SYMBOL: core-bootstrap-time
@@ -102,6 +102,8 @@ SYMBOL: bootstrap-time
     ] if
 ] [
     drop
-    load-help? off
+    [
-    "resource:basis/bootstrap/bootstrap-error.factor" run-file
+        load-help? off
+        "resource:basis/bootstrap/bootstrap-error.factor" run-file
+    ] with-scope
 ] recover

basis/cairo/cairo.factor

@@ -17,20 +17,21 @@ M: cairo-surface-t dispose ( alien -- ) alien>> cairo_surface_destroy ;
     [ cairo_status_to_string "Cairo error: " prepend throw ] if ;
 
 SYMBOL: cairo
-: cr ( -- cairo ) cairo get ;
+: cr ( -- cairo ) cairo get ; inline
 
 : (with-cairo) ( cairo-t quot -- )
-    >r alien>> cairo r> [ cr cairo_status check-cairo ]
+    [ alien>> cairo ] dip
-    compose with-variable ; inline
+    '[ @ cr cairo_status check-cairo ]
+    with-variable ; inline
     
 : with-cairo ( cairo quot -- )
-    >r <cairo-t> r> [ (with-cairo) ] curry with-disposal ; inline
+    [ <cairo-t> ] dip '[ _ (with-cairo) ] with-disposal ; inline
 
 : (with-surface) ( cairo-surface-t quot -- )
-    >r alien>> r> [ cairo_surface_status check-cairo ] bi ; inline
+    [ alien>> ] dip [ cairo_surface_status check-cairo ] bi ; inline
 
 : with-surface ( cairo_surface quot -- )
-    >r <cairo-surface-t> r> [ (with-surface) ] curry with-disposal ; inline
+    [ <cairo-surface-t> ] dip '[ _ (with-surface) ] with-disposal ; inline
 
 : with-cairo-from-surface ( cairo_surface quot -- )
     '[ cairo_create _ with-cairo ] with-surface ; inline

basis/cairo/ffi/ffi.factor

@@ -37,7 +37,7 @@ TYPEDEF: void* cairo_pattern_t
 
 TYPEDEF: void* cairo_destroy_func_t
 : cairo-destroy-func ( quot -- callback )
-    >r "void" { "void*" } "cdecl" r> alien-callback ; inline
+    [ "void" { "void*" } "cdecl" ] dip alien-callback ; inline
 
 ! See cairo.h for details
 C-STRUCT: cairo_user_data_key_t
@@ -78,13 +78,11 @@ TYPEDEF: int cairo_content_t
 
 TYPEDEF: void* cairo_write_func_t
 : cairo-write-func ( quot -- callback )
-    >r "cairo_status_t" { "void*" "uchar*" "int" }
+    [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline
-    "cdecl" r> alien-callback ; inline
                           
 TYPEDEF: void* cairo_read_func_t
 : cairo-read-func ( quot -- callback )
-    >r "cairo_status_t" { "void*" "uchar*" "int" }
+    [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline
-    "cdecl" r> alien-callback ; inline
 
 ! Functions for manipulating state objects
 FUNCTION: cairo_t*

basis/cairo/gadgets/gadgets.factor

@@ -26,7 +26,7 @@ M: cairo-gadget draw-gadget*
     [ dim>> ] [ render-cairo ] bi
     origin get first2 glRasterPos2i
     1.0 -1.0 glPixelZoom
-    >r first2 GL_BGRA GL_UNSIGNED_BYTE r>
+    [ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip
     glDrawPixels ;
 
 : copy-surface ( surface -- )

basis/calendar/calendar.factor

@@ -211,7 +211,7 @@ M: real +minute ( timestamp n -- timestamp )
 M: number +second ( timestamp n -- timestamp )
     [ over second>> + seconds/minutes [ >>second ] dip +minute ] unless-zero ;
 
-: (time+)
+: (time+) ( timestamp duration -- timestamp' duration )
     [ second>> +second ] keep
     [ minute>> +minute ] keep
     [ hour>>   +hour   ] keep
@@ -219,7 +219,8 @@ M: number +second ( timestamp n -- timestamp )
     [ month>>  +month  ] keep
     [ year>>   +year   ] keep ; inline
 
-: +slots [ bi@ + ] curry 2keep ; inline
+: +slots ( obj1 obj2 quot -- n obj1 obj2 )
+    [ bi@ + ] curry 2keep ; inline
 
 PRIVATE>
 

basis/channels/remote/remote-docs.factor

@@ -6,6 +6,7 @@ IN: channels.remote
 HELP: <remote-channel>
 { $values { "node" "a node object" }
           { "id" "the id of the published channel on the node" } 
+          { "remote-channel" remote-channel }
 }
 { $description "Create a remote channel that acts as a proxy for a "
 "channel on another node. The remote node's channel must have been "

basis/checksums/common/common.factor

@@ -1,21 +1,20 @@
 ! Copyright (C) 2006, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.bitwise strings io.binary namespaces
-make grouping ;
+make grouping byte-arrays ;
 IN: checksums.common
 
 SYMBOL: bytes-read
 
-: calculate-pad-length ( length -- pad-length )
+: calculate-pad-length ( length -- length' )
-    dup 56 < 55 119 ? swap - ;
+    [ 56 < 55 119 ? ] keep - ;
 
 : pad-last-block ( str big-endian? length -- str )
     [
-        rot %
+        [ % ] 2dip HEX: 80 ,
-        HEX: 80 ,
+        [ HEX: 3f bitand calculate-pad-length <byte-array> % ]
-        dup HEX: 3f bitand calculate-pad-length 0 <string> %
+        [ 3 shift 8 rot [ >be ] [ >le ] if % ] bi
-        3 shift 8 rot [ >be ] [ >le ] if %
+    ] B{ } make 64 group ;
-    ] "" make 64 group ;
 
 : update-old-new ( old new -- )
     [ [ get ] bi@ w+ dup ] 2keep [ set ] bi@ ; inline

basis/checksums/md5/md5.factor

@@ -3,7 +3,7 @@
 USING: kernel io io.binary io.files io.streams.byte-array math
 math.functions math.parser namespaces splitting grouping strings
 sequences byte-arrays locals sequences.private
-io.encodings.binary symbols math.bitwise checksums
+io.encodings.binary math.bitwise checksums
 checksums.common checksums.stream ;
 IN: checksums.md5
 

basis/checksums/openssl/openssl-docs.factor

@@ -4,8 +4,8 @@ USING: help.syntax help.markup ;
 HELP: openssl-checksum
 { $class-description "The class of checksum algorithms implemented by OpenSSL. The exact set of algorithms supported depends on how the OpenSSL library was compiled; " { $snippet "md5" } " and " { $snippet "sha1" } " should be universally available." } ;
 
-HELP: <openssl-checksum> ( name -- checksum )
+HELP: <openssl-checksum>
-{ $values { "name" "an EVP message digest name" } { "checksum" openssl-checksum } }
+{ $values { "name" "an EVP message digest name" } { "openssl-checksum" openssl-checksum } }
 { $description "Creates a new OpenSSL checksum object." } ;
 
 HELP: openssl-md5

basis/checksums/sha1/sha1.factor

@@ -3,7 +3,7 @@
 USING: arrays combinators kernel io io.encodings.binary io.files
 io.streams.byte-array math.vectors strings sequences namespaces
 make math parser sequences assocs grouping vectors io.binary
-hashtables symbols math.bitwise checksums checksums.common
+hashtables math.bitwise checksums checksums.common
 checksums.stream ;
 IN: checksums.sha1
 

basis/checksums/sha2/sha2.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel splitting grouping math sequences namespaces make
-io.binary symbols math.bitwise checksums checksums.common
+io.binary math.bitwise checksums checksums.common
 sbufs strings ;
 IN: checksums.sha2
 

basis/cocoa/application/application-docs.factor

@@ -1,5 +1,5 @@
 USING: debugger quotations help.markup help.syntax strings alien
-core-foundation ;
+core-foundation core-foundation.strings core-foundation.arrays ;
 IN: cocoa.application
 
 HELP: <NSString>
@@ -30,10 +30,6 @@ HELP: cocoa-app
 { $values { "quot" quotation } }
 { $description "Initializes Cocoa, calls the quotation, and starts the Cocoa event loop." } ;
 
-HELP: do-event
-{ $values { "app" "an " { $snippet "NSApplication" } } { "?" "a boolean" } }
-{ $description "Processes a pending event in the queue, if any, returning a boolean indicating if there was one. Does not block." } ;
-
 HELP: add-observer
 { $values { "observer" "an " { $snippet "NSObject" } } { "selector" string } { "name" "an " { $snippet "NSString" } } { "object" "an " { $snippet "NSObject" } } }
 { $description "Registers an observer with the " { $snippet "NSNotificationCenter" } " singleton." } ;
@@ -52,7 +48,6 @@ HELP: objc-error
 ARTICLE: "cocoa-application-utils" "Cocoa application utilities"
 "Utilities:"
 { $subsection NSApp }
-{ $subsection do-event }
 { $subsection add-observer }
 { $subsection remove-observer }
 { $subsection install-delegate }

basis/cocoa/application/application.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.syntax io kernel namespaces core-foundation
-core-foundation.run-loop cocoa.messages cocoa cocoa.classes
+core-foundation.arrays core-foundation.data
+core-foundation.strings cocoa.messages cocoa cocoa.classes
 cocoa.runtime sequences threads init summary kernel.private
 assocs ;
 IN: cocoa.application
@@ -34,13 +35,6 @@ FUNCTION: void NSBeep ( ) ;
 : with-cocoa ( quot -- )
     [ NSApp drop call ] with-autorelease-pool ; inline
 
-: next-event ( app -- event )
-    NSAnyEventMask f CFRunLoopDefaultMode 1
-    -> nextEventMatchingMask:untilDate:inMode:dequeue: ;
-
-: do-event ( app -- ? )
-    dup next-event [ dupd -> sendEvent: -> updateWindows t ] [ drop f ] if* ;
-
 : add-observer ( observer selector name object -- )
     [
         [ NSNotificationCenter -> defaultCenter ] 2dip

basis/cocoa/cocoa.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: compiler io kernel cocoa.runtime cocoa.subclassing
 cocoa.messages cocoa.types sequences words vocabs parser
-core-foundation namespaces assocs hashtables compiler.units
+core-foundation.bundles namespaces assocs hashtables
-lexer init ;
+compiler.units lexer init ;
 IN: cocoa
 
 : (remember-send) ( selector variable -- )

basis/cocoa/dialogs/dialogs.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel cocoa cocoa.messages cocoa.classes
-cocoa.application sequences splitting core-foundation ;
+cocoa.application sequences splitting core-foundation
+core-foundation.strings ;
 IN: cocoa.dialogs
 
 : <NSOpenPanel> ( -- panel )

basis/cocoa/nibs/nibs.factor

@@ -1,5 +1,8 @@
-USING: cocoa.application cocoa.messages cocoa.classes cocoa.runtime 
+! Copyright (C) 2008 Slava Pestov.
-kernel cocoa core-foundation alien.c-types ;
+! See http://factorcode.org/license.txt for BSD license.
+USING: cocoa.application cocoa.messages cocoa.classes
+cocoa.runtime kernel cocoa alien.c-types core-foundation
+core-foundation.arrays ;
 IN: cocoa.nibs
 
 : load-nib ( name -- )

basis/cocoa/pasteboard/pasteboard.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.accessors arrays kernel cocoa.messages
-cocoa.classes cocoa.application cocoa core-foundation sequences
+cocoa.classes cocoa.application sequences cocoa core-foundation
-;
+core-foundation.strings core-foundation.arrays ;
 IN: cocoa.pasteboard
 
 : NSStringPboardType "NSStringPboardType" ;

basis/cocoa/plists/plists.factor

@@ -3,7 +3,7 @@
 USING: strings arrays hashtables assocs sequences
 cocoa.messages cocoa.classes cocoa.application cocoa kernel
 namespaces io.backend math cocoa.enumeration byte-arrays
-combinators alien.c-types core-foundation ;
+combinators alien.c-types core-foundation core-foundation.data ;
 IN: cocoa.plists
 
 GENERIC: >plist ( value -- plist )

basis/cocoa/views/views-docs.factor

@@ -2,7 +2,7 @@ USING: help.syntax help.markup ;
 IN: cocoa.views
 
 HELP: <PixelFormat>
-{ $values { "pixelfmt" "an " { $snippet "NSOpenGLPixelFormat" } } }
+{ $values { "attributes" "a sequence of attributes" } { "pixelfmt" "an " { $snippet "NSOpenGLPixelFormat" } } }
 { $description "Creates an " { $snippet "NSOpenGLPixelFormat" } " with some reasonable defaults." } ;
 
 HELP: <GLView>

basis/cocoa/windows/windows.factor

@@ -14,7 +14,7 @@ IN: cocoa.windows
 : NSBackingStoreNonretained 1 ; inline
 : NSBackingStoreBuffered    2 ; inline
 
-: standard-window-type
+: standard-window-type ( -- n )
     {
         NSTitledWindowMask
         NSClosableWindowMask

basis/columns/columns-docs.factor

@@ -4,8 +4,8 @@ IN: columns
 HELP: column
 { $class-description "A virtual sequence which presents a fixed column of a matrix represented as a sequence of rows. New instances can be created by calling " { $link <column> } "." } ;
 
-HELP: <column> ( seq n -- column )
+HELP: <column>
-{ $values { "seq" sequence } { "n" "a non-negative integer" } { "column" column } }
+{ $values { "seq" sequence } { "col" "a non-negative integer" } { "column" column } }
 { $description "Outputs a new virtual sequence which presents a fixed column of a matrix represented as a sequence of rows." "The " { $snippet "i" } "th element of a column is the " { $snippet "n" } "th element of the " { $snippet "i" } "th element of " { $snippet "seq" } ". Every element of " { $snippet "seq" } " must be a sequence, and all sequences must have equal length." }
 { $examples
     { $example

basis/command-line/command-line.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: init continuations hashtables io io.encodings.utf8
-io.files kernel kernel.private namespaces parser sequences
+io.files io.pathnames kernel kernel.private namespaces parser
-strings system splitting vocabs.loader ;
+sequences strings system splitting vocabs.loader ;
 IN: command-line
 
 SYMBOL: script

basis/compiler/cfg/alias-analysis/alias-analysis.factor

@@ -68,7 +68,8 @@ IN: compiler.cfg.alias-analysis
 ! Map vregs -> alias classes
 SYMBOL: vregs>acs
 
-: check [ "BUG: static type error detected" throw ] unless* ; inline
+: check ( obj -- obj )
+    [ "BUG: static type error detected" throw ] unless* ; inline
  
 : vreg>ac ( vreg -- ac )
     #! Only vregs produced by ##allot, ##peek and ##slot can

basis/compiler/cfg/builder/builder-tests.factor

@@ -14,7 +14,7 @@ kernel.private math ;
     [ ]
     [ dup ]
     [ swap ]
-    [ >r r> ]
+    [ [ ] dip ]
     [ fixnum+ ]
     [ fixnum+fast ]
     [ 3 fixnum+fast ]

basis/compiler/cfg/hats/hats.factor

@@ -5,17 +5,17 @@ sequences classes.tuple cpu.architecture compiler.cfg.registers
 compiler.cfg.instructions ;
 IN: compiler.cfg.hats
 
-: i int-regs next-vreg ; inline
+: i ( -- vreg ) int-regs next-vreg ; inline
-: ^^i i dup ; inline
+: ^^i ( -- vreg vreg ) i dup ; inline
-: ^^i1 [ ^^i ] dip ; inline
+: ^^i1 ( obj -- vreg vreg obj ) [ ^^i ] dip ; inline
-: ^^i2 [ ^^i ] 2dip ; inline
+: ^^i2 ( obj obj -- vreg vreg obj obj ) [ ^^i ] 2dip ; inline
-: ^^i3 [ ^^i ] 3dip ; inline
+: ^^i3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^i ] 3dip ; inline
 
-: d double-float-regs next-vreg ; inline
+: d ( -- vreg ) double-float-regs next-vreg ; inline
-: ^^d d dup ; inline
+: ^^d  ( -- vreg vreg ) d dup ; inline
-: ^^d1 [ ^^d ] dip ; inline
+: ^^d1 ( obj -- vreg vreg obj ) [ ^^d ] dip ; inline
-: ^^d2 [ ^^d ] 2dip ; inline
+: ^^d2 ( obj obj -- vreg vreg obj obj ) [ ^^d ] 2dip ; inline
-: ^^d3 [ ^^d ] 3dip ; inline
+: ^^d3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^d ] 3dip ; inline
 
 : ^^load-literal ( obj -- dst ) ^^i1 ##load-literal ; inline
 : ^^peek ( loc -- dst ) ^^i1 ##peek ; inline

basis/compiler/cfg/instructions/syntax/syntax.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes.tuple classes.tuple.parser kernel words
-make fry sequences parser ;
+make fry sequences parser accessors ;
 IN: compiler.cfg.instructions.syntax
 
 : insn-word ( -- word )
@@ -10,10 +10,13 @@ IN: compiler.cfg.instructions.syntax
     #! this one.
     "insn" "compiler.cfg.instructions" lookup ;
 
+: insn-effect ( word -- effect )
+    boa-effect [ but-last ] change-in { } >>out ;
+
 : INSN:
     parse-tuple-definition "regs" suffix
     [ dup tuple eq? [ drop insn-word ] when ] dip
     [ define-tuple-class ]
     [ 2drop save-location ]
-    [ 2drop dup '[ f _ boa , ] define-inline ]
+    [ 2drop [ ] [ '[ f _ boa , ] ] [ insn-effect ] tri define-inline ]
     3tri ; parsing

basis/compiler/cfg/intrinsics/intrinsics.factor

@@ -1,7 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: qualified words sequences kernel combinators
+USING: words sequences kernel combinators cpu.architecture
-cpu.architecture
 compiler.cfg.hats
 compiler.cfg.instructions
 compiler.cfg.intrinsics.alien

basis/compiler/cfg/linear-scan/linear-scan-tests.factor

@@ -249,7 +249,7 @@ SYMBOL: max-uses
     ] with-scope ;
 
 : random-test ( num-intervals max-uses max-registers max-insns -- )
-    over >r random-live-intervals r> int-regs associate check-linear-scan ;
+    over [ random-live-intervals ] dip int-regs associate check-linear-scan ;
 
 [ ] [ 30 2 1 60 random-test ] unit-test
 [ ] [ 60 2 2 60 random-test ] unit-test

basis/compiler/cfg/linearization/linearization.factor

@@ -37,7 +37,7 @@ M: insn linearize-insn , drop ;
 M: ##branch linearize-insn
     drop dup successors>> first emit-branch ;
 
-: (binary-conditional)
+: (binary-conditional) ( basic-block insn -- basic-block successor1 successor2 src1 src2 cc )
     [ dup successors>> first2 ]
     [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline
 

basis/compiler/codegen/codegen.factor

@@ -95,7 +95,7 @@ M: ##dispatch-label generate-insn label>> %dispatch-label ;
 M: ##dispatch generate-insn
     [ src>> register ] [ temp>> register ] [ offset>> ] tri %dispatch ;
 
-: >slot<
+: >slot< ( insn -- dst obj slot tag )
     {
         [ dst>> register ]
         [ obj>> register ]
@@ -109,7 +109,7 @@ M: ##slot generate-insn
 M: ##slot-imm generate-insn
     >slot< %slot-imm ;
 
-: >set-slot<
+: >set-slot< ( insn -- src obj slot tag )
     {
         [ src>> register ]
         [ obj>> register ]
@@ -209,7 +209,8 @@ M: ##alien-cell       generate-insn dst/src %alien-cell       ;
 M: ##alien-float      generate-insn dst/src %alien-float      ;
 M: ##alien-double     generate-insn dst/src %alien-double     ;
 
-: >alien-setter< [ src>> register ] [ value>> register ] bi ; inline
+: >alien-setter< ( insn -- src value )
+    [ src>> register ] [ value>> register ] bi ; inline
 
 M: ##set-alien-integer-1 generate-insn >alien-setter< %set-alien-integer-1 ;
 M: ##set-alien-integer-2 generate-insn >alien-setter< %set-alien-integer-2 ;

basis/compiler/tests/codegen.factor

@@ -75,7 +75,7 @@ unit-test
     -12 -13 [ [ 0 swap fixnum-fast ] bi@ ] compile-call
 ] unit-test
 
-[ -1 2 ] [ 1 2 [ >r 0 swap fixnum- r> ] compile-call ] unit-test
+[ -1 2 ] [ 1 2 [ [ 0 swap fixnum- ] dip ] compile-call ] unit-test
 
 [ 12 13 ] [
     -12 -13 [ [ 0 swap fixnum- ] bi@ ] compile-call
@@ -88,13 +88,13 @@ unit-test
 ! Test slow shuffles
 [ 3 1 2 3 4 5 6 7 8 9 ] [
     1 2 3 4 5 6 7 8 9
-    [ >r >r >r >r >r >r >r >r >r 3 r> r> r> r> r> r> r> r> r> ]
+    [ [ [ [ [ [ [ [ [ [ 3 ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ]
     compile-call
 ] unit-test
 
 [ 2 2 2 2 2 2 2 2 2 2 1 ] [
     1 2
-    [ swap >r dup dup dup dup dup dup dup dup dup r> ] compile-call
+    [ swap [ dup dup dup dup dup dup dup dup dup ] dip ] compile-call
 ] unit-test
 
 [ ] [ [ 9 [ ] times ] compile-call ] unit-test
@@ -110,7 +110,7 @@ unit-test
     float+ swap { [ "hey" ] [ "bye" ] } dispatch ;
 
 : try-breaking-dispatch-2 ( -- ? )
-    1 1.0 2.5 try-breaking-dispatch "bye" = >r 3.5 = r> and ;
+    1 1.0 2.5 try-breaking-dispatch "bye" = [ 3.5 = ] dip and ;
 
 [ t ] [
     10000000 [ drop try-breaking-dispatch-2 ] all?
@@ -131,10 +131,10 @@ unit-test
     2dup 1 slot eq? [ 2drop ] [ 
         2dup array-nth tombstone? [ 
             [
-                [ array-nth ] 2keep >r 1 fixnum+fast r> array-nth
+                [ array-nth ] 2keep [ 1 fixnum+fast ] dip array-nth
                 pick 2dup hellish-bug-1 3drop
             ] 2keep
-        ] unless >r 2 fixnum+fast r> hellish-bug-2
+        ] unless [ 2 fixnum+fast ] dip hellish-bug-2
     ] if ; inline recursive
 
 : hellish-bug-3 ( hash array -- ) 
@@ -159,9 +159,9 @@ TUPLE: my-tuple ;
 [ 5 ] [ "hi" foox ] unit-test
 
 ! Making sure we don't needlessly unbox/rebox
-[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ >r eq? r> ] compile-call ] unit-test
+[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ [ eq? ] dip ] compile-call ] unit-test
 
-[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call >r eq? r> ] unit-test
+[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call [ eq? ] dip ] unit-test
 
 [ t ] [ 1.0 dup [ [ 2.0 float+ ] keep ] compile-call nip eq? ] unit-test
 
@@ -188,7 +188,7 @@ TUPLE: my-tuple ;
 
 [ 2 1 ] [
     2 1
-    [ 2dup fixnum< [ >r die r> ] when ] compile-call
+    [ 2dup fixnum< [ [ die ] dip ] when ] compile-call
 ] unit-test
 
 ! Regression

basis/compiler/tests/curry.factor

@@ -8,7 +8,7 @@ IN: compiler.tests
 [ 3 ] [ 5 [ 2 [ - ] 2curry call ] compile-call ] unit-test
 [ 3 ] [ 5 2 [ [ - ] 2curry call ] compile-call ] unit-test
 [ 3 ] [ 5 2 [ [ - ] 2curry 9 swap call /i ] compile-call ] unit-test
-[ 3 ] [ 5 2 [ [ - ] 2curry >r 9 r> call /i ] compile-call ] unit-test
+[ 3 ] [ 5 2 [ [ - ] 2curry [ 9 ] dip call /i ] compile-call ] unit-test
 
 [ -10 -20 ] [ 10 20 -1 [ [ * ] curry bi@ ] compile-call ] unit-test
 
@@ -21,14 +21,14 @@ IN: compiler.tests
 [ [ 6 2 + ] ]
 [
     2 5
-    [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry ]
+    [ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry ]
     compile-call >quotation
 ] unit-test
 
 [ 8 ]
 [
     2 5
-    [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry call ]
+    [ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry call ]
     compile-call
 ] unit-test
 

basis/compiler/tests/optimizer.factor

@@ -248,12 +248,12 @@ USE: binary-search.private
 
 : lift-loop-tail-test-1 ( a quot -- )
     over even? [
-        [ >r 3 - r> call ] keep lift-loop-tail-test-1
+        [ [ 3 - ] dip call ] keep lift-loop-tail-test-1
     ] [
         over 0 < [
             2drop
         ] [
-            [ >r 2 - r> call ] keep lift-loop-tail-test-1
+            [ [ 2 - ] dip call ] keep lift-loop-tail-test-1
         ] if
     ] if ; inline
 
@@ -290,7 +290,7 @@ HINTS: recursive-inline-hang-3 array ;
 
 ! Wow
 : counter-example ( a b c d -- a' b' c' d' )
-    dup 0 > [ 1 - >r rot 2 * r> counter-example ] when ; inline
+    dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline
 
 : counter-example' ( -- a' b' c' d' )
     1 2 3.0 3 counter-example ;
@@ -330,7 +330,7 @@ PREDICATE: list < improper-list
 [ 0 5 ] [ 0 interval-inference-bug ] unit-test
 
 : aggressive-flush-regression ( a -- b )
-    f over >r <array> drop r> 1 + ;
+    f over [ <array> drop ] dip 1 + ;
 
 [ 1.0 aggressive-flush-regression drop ] must-fail
 

basis/compiler/tree/dead-code/dead-code-tests.factor

@@ -79,7 +79,7 @@ IN: compiler.tree.dead-code.tests
 
 [ [ read drop 1 2 ] ] [ [ read [ 1 2 ] dip drop ] optimize-quot ] unit-test
 
-[ [ over >r + r> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test
+[ [ over >R + R> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test
 
 [ [ [ ] [ ] if ] ] [ [ [ 1 ] [ 2 ] if drop ] optimize-quot ] unit-test
 

basis/compiler/tree/debugger/debugger.factor

@@ -4,7 +4,7 @@ USING: kernel assocs match fry accessors namespaces make effects
 sequences sequences.private quotations generic macros arrays
 prettyprint prettyprint.backend prettyprint.custom
 prettyprint.sections math words combinators
-combinators.short-circuit io sorting hints qualified
+combinators.short-circuit io sorting hints
 compiler.tree
 compiler.tree.recursive
 compiler.tree.normalization
@@ -80,10 +80,12 @@ M: shuffle-node pprint* effect>> effect>string text ;
         [ out-d>> length 1 = ]
     } 1&& ;
 
+SYMBOLS: >R R> ;
+
 M: #shuffle node>quot
     {
-        { [ dup #>r? ] [ drop \ >r , ] }
+        { [ dup #>r? ] [ drop \ >R , ] }
-        { [ dup #r>? ] [ drop \ r> , ] }
+        { [ dup #r>? ] [ drop \ R> , ] }
         {
             [ dup [ in-r>> empty? ] [ out-r>> empty? ] bi and ]
             [

basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor

@@ -8,13 +8,13 @@ compiler.tree.debugger ;
 : test-modular-arithmetic ( quot -- quot' )
     build-tree optimize-tree nodes>quot ;
 
-[ [ >r >fixnum r> >fixnum fixnum+fast ] ]
+[ [ >R >fixnum R> >fixnum fixnum+fast ] ]
 [ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test
 
 [ [ +-integer-integer dup >fixnum ] ]
 [ [ { integer integer } declare + dup >fixnum ] test-modular-arithmetic ] unit-test
 
-[ [ >r >fixnum r> >fixnum fixnum+fast 4 fixnum*fast ] ]
+[ [ >R >fixnum R> >fixnum fixnum+fast 4 fixnum*fast ] ]
 [ [ { integer integer } declare + 4 * >fixnum ] test-modular-arithmetic ] unit-test
 
 TUPLE: declared-fixnum { x fixnum } ;

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -6,7 +6,7 @@ math.parser math.order layouts words sequences sequences.private
 arrays assocs classes classes.algebra combinators generic.math
 splitting fry locals classes.tuple alien.accessors
 classes.tuple.private slots.private definitions strings.private
-vectors hashtables
+vectors hashtables generic
 stack-checker.state
 compiler.tree.comparisons
 compiler.tree.propagation.info
@@ -337,3 +337,12 @@ generic-comparison-ops [
         bi
     ] [ 2drop object-info ] if
 ] "outputs" set-word-prop
+
+\ equal? [
+    ! If first input has a known type and second input is an
+    ! object, we convert this to [ swap equal? ].
+    in-d>> first2 value-info class>> object class= [
+        value-info class>> \ equal? specific-method
+        [ swap equal? ] f ?
+    ] [ drop f ] if
+] "custom-inlining" set-word-prop

basis/compiler/tree/propagation/propagation-tests.factor

@@ -18,7 +18,7 @@ IN: compiler.tree.propagation.tests
 
 [ V{ fixnum } ] [ [ 1 ] final-classes ] unit-test
 
-[ V{ fixnum } ] [ [ 1 >r r> ] final-classes ] unit-test
+[ V{ fixnum } ] [ [ 1 [ ] dip ] final-classes ] unit-test
 
 [ V{ fixnum object } ] [ [ 1 swap ] final-classes ] unit-test
 
@@ -198,7 +198,7 @@ IN: compiler.tree.propagation.tests
     [
         { fixnum byte-array } declare
         [ nth-unsafe ] 2keep [ nth-unsafe ] 2keep nth-unsafe
-        >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift
+        [ [ 298 * ] dip 100 * - ] dip 208 * - 128 + -8 shift
         255 min 0 max
     ] final-classes
 ] unit-test
@@ -640,6 +640,10 @@ MIXIN: empty-mixin
     [ { fixnum } declare log2 0 >= ] final-classes
 ] unit-test
 
+[ V{ POSTPONE: f } ] [
+    [ { word object } declare equal? ] final-classes
+] unit-test
+
 ! [ V{ string } ] [
 !     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
 ! ] unit-test

basis/concurrency/combinators/combinators.factor

@@ -28,7 +28,8 @@ PRIVATE>
 
 : [future] ( quot -- quot' ) '[ _ curry future ] ; inline
 
-: future-values dup [ ?future ] change-each ; inline
+: future-values ( futures -- futures )
+    dup [ ?future ] change-each ; inline
 
 PRIVATE>
 

basis/concurrency/distributed/distributed-tests.factor

@@ -1,7 +1,8 @@
 IN: concurrency.distributed.tests
 USING: tools.test concurrency.distributed kernel io.files
-arrays io.sockets system combinators threads math sequences
+io.files.temp io.directories arrays io.sockets system
-concurrency.messaging continuations accessors prettyprint ;
+combinators threads math sequences concurrency.messaging
+continuations accessors prettyprint ;
 
 : test-node ( -- addrspec )
     {

basis/concurrency/distributed/distributed.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: serialize sequences concurrency.messaging threads io
 io.servers.connection io.encodings.binary
-qualified arrays namespaces kernel accessors ;
+arrays namespaces kernel accessors ;
 FROM: io.sockets => host-name <inet> with-client ;
 IN: concurrency.distributed
 

basis/concurrency/messaging/messaging.factor

@@ -20,13 +20,13 @@ M: thread send ( message thread -- )
     my-mailbox mailbox-get ?linked ;
 
 : receive-timeout ( timeout -- message )
-    my-mailbox swap mailbox-get-timeout ?linked ;
+    [ my-mailbox ] dip mailbox-get-timeout ?linked ;
 
 : receive-if ( pred -- message )
-    my-mailbox swap mailbox-get? ?linked ; inline
+    [ my-mailbox ] dip mailbox-get? ?linked ; inline
 
 : receive-if-timeout ( timeout pred -- message )
-    my-mailbox -rot mailbox-get-timeout? ?linked ; inline
+    [ my-mailbox ] 2dip mailbox-get-timeout? ?linked ; inline
 
 : rethrow-linked ( error process supervisor -- )
     [ <linked-error> ] dip send ;

basis/core-foundation/arrays/arrays-docs.factor

@@ -0,0 +1,11 @@
+USING: help.syntax help.markup arrays alien ;
+IN: core-foundation.arrays
+
+HELP: CF>array
+{ $values { "alien" "a " { $snippet "CFArray" } } { "array" "an array of " { $link alien } " instances" } }
+{ $description "Creates a Factor array from a Core Foundation array." } ;
+
+HELP: <CFArray>
+{ $values { "seq" "a sequence of " { $link alien } " instances" } { "alien" "a " { $snippet "CFArray" } } }
+{ $description "Creates a Core Foundation array from a Factor array." } ;
+

basis/core-foundation/arrays/arrays.factor

@@ -0,0 +1,22 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel sequences ;
+IN: core-foundation.arrays
+
+TYPEDEF: void* CFArrayRef
+
+FUNCTION: CFArrayRef CFArrayCreateMutable ( CFAllocatorRef allocator, CFIndex capacity, void* callbacks ) ;
+
+FUNCTION: void* CFArrayGetValueAtIndex ( CFArrayRef array, CFIndex idx ) ;
+
+FUNCTION: void CFArraySetValueAtIndex ( CFArrayRef array, CFIndex index, void* value ) ;
+
+FUNCTION: CFIndex CFArrayGetCount ( CFArrayRef array ) ;
+
+: CF>array ( alien -- array )
+    dup CFArrayGetCount [ CFArrayGetValueAtIndex ] with map ;
+
+: <CFArray> ( seq -- alien )
+    [ f swap length f CFArrayCreateMutable ] keep
+    [ length ] keep
+    [ [ dupd ] dip CFArraySetValueAtIndex ] 2each ;

basis/core-foundation/arrays/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/bundles/bundles-docs.factor

@@ -0,0 +1,11 @@
+USING: help.syntax help.markup ;
+IN: core-foundation.bundles
+
+HELP: <CFBundle>
+{ $values { "string" "a pathname string" } { "bundle" "a " { $snippet "CFBundle" } } }
+{ $description "Creates a new " { $snippet "CFBundle" } "." } ;
+
+HELP: load-framework
+{ $values { "name" "a pathname string" } }
+{ $description "Loads a Core Foundation framework." } ;
+

basis/core-foundation/bundles/bundles.factor

@@ -0,0 +1,23 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel sequences core-foundation
+core-foundation.urls ;
+IN: core-foundation.bundles
+
+TYPEDEF: void* CFBundleRef
+
+FUNCTION: CFBundleRef CFBundleCreate ( CFAllocatorRef allocator, CFURLRef bundleURL ) ;
+
+FUNCTION: Boolean CFBundleLoadExecutable ( CFBundleRef bundle ) ;
+
+: <CFBundle> ( string -- bundle )
+    t <CFFileSystemURL> [
+        f swap CFBundleCreate
+    ] keep CFRelease ;
+
+: load-framework ( name -- )
+    dup <CFBundle> [
+        CFBundleLoadExecutable drop
+    ] [
+        "Cannot load bundle named " prepend throw
+    ] ?if ;

basis/core-foundation/bundles/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/core-foundation-docs.factor

@@ -1,42 +1,6 @@
 USING: alien strings arrays help.markup help.syntax destructors ;
 IN: core-foundation
 
-HELP: CF>array
-{ $values { "alien" "a " { $snippet "CFArray" } } { "array" "an array of " { $link alien } " instances" } }
-{ $description "Creates a Factor array from a Core Foundation array." } ;
-
-HELP: <CFArray>
-{ $values { "seq" "a sequence of " { $link alien } " instances" } { "alien" "a " { $snippet "CFArray" } } }
-{ $description "Creates a Core Foundation array from a Factor array." } ;
-
-HELP: <CFString>
-{ $values { "string" string } { "alien" "a " { $snippet "CFString" } } }
-{ $description "Creates a Core Foundation string from a Factor string." } ;
-
-HELP: CF>string
-{ $values { "alien" "a " { $snippet "CFString" } } { "string" string } }
-{ $description "Creates a Factor string from a Core Foundation string." } ;
-
-HELP: CF>string-array
-{ $values { "alien" "a " { $snippet "CFArray" } " of " { $snippet "CFString" } " instances" } { "seq" string } }
-{ $description "Creates an array of Factor strings from a " { $snippet "CFArray" } " of " { $snippet "CFString" } "s." } ;
-
-HELP: <CFFileSystemURL>
-{ $values { "string" "a pathname string" } { "dir?" "a boolean indicating if the pathname is a directory" } { "url" "a " { $snippet "CFURL" } } }
-{ $description "Creates a new " { $snippet "CFURL" } " pointing to the given local pathname." } ;
-
-HELP: <CFURL>
-{ $values { "string" "a URL string" } { "url" "a " { $snippet "CFURL" } } }
-{ $description "Creates a new " { $snippet "CFURL" } "." } ;
-
-HELP: <CFBundle>
-{ $values { "string" "a pathname string" } { "bundle" "a " { $snippet "CFBundle" } } }
-{ $description "Creates a new " { $snippet "CFBundle" } "." } ;
-
-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." } ;
@@ -46,24 +10,3 @@ HELP: |CFRelease
 { $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
-"Strings:"
-{ $subsection <CFString> }
-{ $subsection CF>string }
-"Arrays:"
-{ $subsection <CFArray> }
-{ $subsection CF>array }
-{ $subsection CF>string-array }
-"URLs:"
-{ $subsection <CFFileSystemURL> }
-{ $subsection <CFURL> }
-"Frameworks:"
-{ $subsection load-framework }
-"Memory management:"
-{ $subsection &CFRelease }
-{ $subsection |CFRelease } ;
-
-ABOUT: "core-foundation"

basis/core-foundation/core-foundation.factor

@@ -1,212 +1,25 @@
 ! 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
+USING: alien.syntax destructors accessors kernel ;
-math sequences io.encodings.utf8 destructors accessors
-combinators byte-arrays ;
 IN: core-foundation
 
-TYPEDEF: void* CFAllocatorRef
-TYPEDEF: void* CFArrayRef
-TYPEDEF: void* CFDataRef
-TYPEDEF: void* CFDictionaryRef
-TYPEDEF: void* CFMutableDictionaryRef
-TYPEDEF: void* CFNumberRef
-TYPEDEF: void* CFBundleRef
-TYPEDEF: void* CFSetRef
-TYPEDEF: void* CFStringRef
-TYPEDEF: void* CFURLRef
-TYPEDEF: void* CFUUIDRef
 TYPEDEF: void* CFTypeRef
-TYPEDEF: void* CFFileDescriptorRef
+
+TYPEDEF: void* CFAllocatorRef
+: kCFAllocatorDefault f ; inline
+
 TYPEDEF: bool Boolean
 TYPEDEF: long CFIndex
 TYPEDEF: int SInt32
 TYPEDEF: uint UInt32
 TYPEDEF: ulong CFTypeID
 TYPEDEF: UInt32 CFOptionFlags
-TYPEDEF: double CFTimeInterval
+TYPEDEF: void* CFUUIDRef
-TYPEDEF: double CFAbsoluteTime
-TYPEDEF: int CFFileDescriptorNativeDescriptor
-TYPEDEF: void* CFFileDescriptorCallBack
-
-TYPEDEF: int CFNumberType
-: kCFNumberSInt8Type 1 ; inline
-: kCFNumberSInt16Type 2 ; inline
-: kCFNumberSInt32Type 3 ; inline
-: kCFNumberSInt64Type 4 ; inline
-: kCFNumberFloat32Type 5 ; inline
-: kCFNumberFloat64Type 6 ; inline
-: kCFNumberCharType 7 ; inline
-: kCFNumberShortType 8 ; inline
-: kCFNumberIntType 9 ; inline
-: kCFNumberLongType 10 ; inline
-: kCFNumberLongLongType 11 ; inline
-: kCFNumberFloatType 12 ; inline
-: kCFNumberDoubleType 13 ; inline
-: kCFNumberCFIndexType 14 ; inline
-: kCFNumberNSIntegerType 15 ; inline
-: kCFNumberCGFloatType 16 ; inline
-: kCFNumberMaxType 16 ; inline
-
-TYPEDEF: int CFPropertyListMutabilityOptions
-: kCFPropertyListImmutable                  0 ; inline
-: kCFPropertyListMutableContainers          1 ; inline
-: kCFPropertyListMutableContainersAndLeaves 2 ; inline
-
-FUNCTION: CFArrayRef CFArrayCreateMutable ( CFAllocatorRef allocator, CFIndex capacity, void* callbacks ) ;
-
-FUNCTION: void* CFArrayGetValueAtIndex ( CFArrayRef array, CFIndex idx ) ;
-
-FUNCTION: void CFArraySetValueAtIndex ( CFArrayRef array, CFIndex index, void* value ) ;
-
-FUNCTION: CFIndex CFArrayGetCount ( CFArrayRef array ) ;
-
-: kCFURLPOSIXPathStyle 0 ; inline
-: kCFAllocatorDefault f ; inline
-
-FUNCTION: CFURLRef CFURLCreateWithFileSystemPath ( CFAllocatorRef allocator, CFStringRef filePath, int pathStyle, Boolean isDirectory ) ;
-
-FUNCTION: CFURLRef CFURLCreateWithString ( CFAllocatorRef allocator, CFStringRef string, CFURLRef base ) ;
-
-FUNCTION: CFURLRef CFURLCopyFileSystemPath ( CFURLRef url, int pathStyle ) ;
-
-TYPEDEF: int CFStringEncoding
-: kCFStringEncodingMacRoman HEX: 0 ;
-: kCFStringEncodingWindowsLatin1 HEX: 0500 ;
-: kCFStringEncodingISOLatin1 HEX: 0201 ;
-: kCFStringEncodingNextStepLatin HEX: 0B01 ;
-: kCFStringEncodingASCII HEX: 0600 ;
-: kCFStringEncodingUnicode HEX: 0100 ;
-: kCFStringEncodingUTF8 HEX: 08000100 ;
-: kCFStringEncodingNonLossyASCII HEX: 0BFF ;
-: kCFStringEncodingUTF16 HEX: 0100 ;
-: kCFStringEncodingUTF16BE HEX: 10000100 ;
-: kCFStringEncodingUTF16LE HEX: 14000100 ;
-: kCFStringEncodingUTF32 HEX: 0c000100 ;
-: kCFStringEncodingUTF32BE HEX: 18000100 ;
-: kCFStringEncodingUTF32LE HEX: 1c000100 ;
-
-FUNCTION: CFStringRef CFStringCreateFromExternalRepresentation (
-   CFAllocatorRef alloc,
-   CFDataRef data,
-   CFStringEncoding encoding
-) ;
-
-FUNCTION: CFStringRef CFStringCreateWithBytes (
-   CFAllocatorRef alloc,
-   UInt8* bytes,
-   CFIndex numBytes,
-   CFStringEncoding encoding,
-   Boolean isExternalRepresentation
-) ;
-
-FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ;
-
-FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ;
-
-FUNCTION: Boolean CFStringGetCString (
-   CFStringRef theString,
-   char* buffer,
-   CFIndex bufferSize,
-   CFStringEncoding encoding
-) ;
-
-FUNCTION: CFStringRef CFStringCreateWithCString (
-   CFAllocatorRef alloc,
-   char* cStr,
-   CFStringEncoding encoding
-) ;
-
-FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType theType, void* valuePtr ) ;
-
-FUNCTION: CFDataRef CFDataCreate ( CFAllocatorRef allocator, uchar* bytes, CFIndex length ) ;
-
-FUNCTION: CFBundleRef CFBundleCreate ( CFAllocatorRef allocator, CFURLRef bundleURL ) ;
-
-FUNCTION: Boolean CFBundleLoadExecutable ( CFBundleRef bundle ) ;
 
 FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf ) ;
+
 FUNCTION: void CFRelease ( CFTypeRef cf ) ;
 
-FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
-
-: CF>array ( alien -- array )
-    dup CFArrayGetCount [ CFArrayGetValueAtIndex ] with map ;
-
-: <CFArray> ( seq -- alien )
-    [ f swap length f CFArrayCreateMutable ] keep
-    [ length ] keep
-    [ [ dupd ] dip CFArraySetValueAtIndex ] 2each ;
-
-: <CFString> ( string -- alien )
-    f swap utf8 string>alien kCFStringEncodingUTF8 CFStringCreateWithCString
-    [ "CFStringCreateWithCString failed" throw ] unless* ;
-
-: CF>string ( alien -- string )
-    dup CFStringGetLength 4 * 1 + <byte-array> [
-        dup length
-        kCFStringEncodingUTF8
-        CFStringGetCString
-        [ "CFStringGetCString failed" throw ] unless
-    ] keep utf8 alien>string ;
-
-: CF>string-array ( alien -- seq )
-    CF>array [ CF>string ] map ;
-
-: <CFStringArray> ( seq -- alien )
-    [ <CFString> ] map [ <CFArray> ] [ [ CFRelease ] each ] bi ;
-
-: <CFFileSystemURL> ( string dir? -- url )
-    [ <CFString> f over kCFURLPOSIXPathStyle ] dip
-    CFURLCreateWithFileSystemPath swap CFRelease ;
-
-: <CFURL> ( string -- url )
-    <CFString>
-    [ f swap f CFURLCreateWithString ] keep
-    CFRelease ;
-
-: <CFBundle> ( string -- bundle )
-    t <CFFileSystemURL> [
-        f swap CFBundleCreate
-    ] keep CFRelease ;
-
-GENERIC: <CFNumber> ( number -- alien )
-
-M: integer <CFNumber>
-    [ f kCFNumberLongLongType ] dip <longlong> CFNumberCreate ;
-
-M: float <CFNumber>
-    [ f kCFNumberDoubleType ] dip <double> CFNumberCreate ;
-
-M: t <CFNumber>
-    drop f kCFNumberIntType 1 <int> CFNumberCreate ;
-
-M: f <CFNumber>
-    drop f kCFNumberIntType 0 <int> CFNumberCreate ;
-
-: <CFData> ( byte-array -- alien )
-    [ f ] dip dup length CFDataCreate ;
-
-FUNCTION: CFFileDescriptorRef CFFileDescriptorCreate (
-    CFAllocatorRef allocator,
-    CFFileDescriptorNativeDescriptor fd,
-    Boolean closeOnInvalidate,
-    CFFileDescriptorCallBack callout, 
-    CFFileDescriptorContext* context
-) ;
-
-FUNCTION: void CFFileDescriptorEnableCallBacks (
-    CFFileDescriptorRef f,
-    CFOptionFlags callBackTypes
-) ;
-
-: load-framework ( name -- )
-    dup <CFBundle> [
-        CFBundleLoadExecutable drop
-    ] [
-        "Cannot load bundle named " prepend throw
-    ] ?if ;
-
 TUPLE: CFRelease-destructor alien disposed ;
 
 M: CFRelease-destructor dispose* alien>> CFRelease ;

basis/core-foundation/data/data.factor

@@ -0,0 +1,57 @@
+! Copyright (C) 2008 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax alien.c-types sequences kernel math ;
+IN: core-foundation.data
+
+TYPEDEF: void* CFDataRef
+TYPEDEF: void* CFDictionaryRef
+TYPEDEF: void* CFMutableDictionaryRef
+TYPEDEF: void* CFNumberRef
+TYPEDEF: void* CFSetRef
+
+TYPEDEF: int CFNumberType
+: kCFNumberSInt8Type 1 ; inline
+: kCFNumberSInt16Type 2 ; inline
+: kCFNumberSInt32Type 3 ; inline
+: kCFNumberSInt64Type 4 ; inline
+: kCFNumberFloat32Type 5 ; inline
+: kCFNumberFloat64Type 6 ; inline
+: kCFNumberCharType 7 ; inline
+: kCFNumberShortType 8 ; inline
+: kCFNumberIntType 9 ; inline
+: kCFNumberLongType 10 ; inline
+: kCFNumberLongLongType 11 ; inline
+: kCFNumberFloatType 12 ; inline
+: kCFNumberDoubleType 13 ; inline
+: kCFNumberCFIndexType 14 ; inline
+: kCFNumberNSIntegerType 15 ; inline
+: kCFNumberCGFloatType 16 ; inline
+: kCFNumberMaxType 16 ; inline
+
+TYPEDEF: int CFPropertyListMutabilityOptions
+: kCFPropertyListImmutable                  0 ; inline
+: kCFPropertyListMutableContainers          1 ; inline
+: kCFPropertyListMutableContainersAndLeaves 2 ; inline
+
+FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType theType, void* valuePtr ) ;
+
+FUNCTION: CFDataRef CFDataCreate ( CFAllocatorRef allocator, uchar* bytes, CFIndex length ) ;
+
+FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
+
+GENERIC: <CFNumber> ( number -- alien )
+
+M: integer <CFNumber>
+    [ f kCFNumberLongLongType ] dip <longlong> CFNumberCreate ;
+
+M: float <CFNumber>
+    [ f kCFNumberDoubleType ] dip <double> CFNumberCreate ;
+
+M: t <CFNumber>
+    drop f kCFNumberIntType 1 <int> CFNumberCreate ;
+
+M: f <CFNumber>
+    drop f kCFNumberIntType 0 <int> CFNumberCreate ;
+
+: <CFData> ( byte-array -- alien )
+    [ f ] dip dup length CFDataCreate ;

basis/core-foundation/data/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/file-descriptors/file-descriptors.factor

@@ -0,0 +1,32 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel math.bitwise core-foundation ;
+IN: core-foundation.file-descriptors
+
+TYPEDEF: void* CFFileDescriptorRef
+TYPEDEF: int CFFileDescriptorNativeDescriptor
+TYPEDEF: void* CFFileDescriptorCallBack
+
+FUNCTION: CFFileDescriptorRef CFFileDescriptorCreate (
+    CFAllocatorRef allocator,
+    CFFileDescriptorNativeDescriptor fd,
+    Boolean closeOnInvalidate,
+    CFFileDescriptorCallBack callout, 
+    CFFileDescriptorContext* context
+) ;
+
+: kCFFileDescriptorReadCallBack 1 ; inline
+: kCFFileDescriptorWriteCallBack 2 ; inline
+   
+FUNCTION: void CFFileDescriptorEnableCallBacks (
+    CFFileDescriptorRef f,
+    CFOptionFlags callBackTypes
+) ;
+
+: enable-all-callbacks ( fd -- )
+    { kCFFileDescriptorReadCallBack kCFFileDescriptorWriteCallBack } flags
+    CFFileDescriptorEnableCallBacks ;
+
+: <CFFileDescriptor> ( fd callback -- handle )
+    [ f swap ] [ t swap ] bi* f CFFileDescriptorCreate
+    [ "CFFileDescriptorCreate failed" throw ] unless* ;

basis/core-foundation/file-descriptors/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/fsevents/fsevents.factor

@@ -2,11 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings alien.syntax kernel
 math sequences namespaces make assocs init accessors
-continuations combinators core-foundation
+continuations combinators io.encodings.utf8 destructors locals
-core-foundation.run-loop core-foundation.run-loop.thread
+arrays specialized-arrays.direct.alien
-io.encodings.utf8 destructors locals arrays
+specialized-arrays.direct.int specialized-arrays.direct.longlong
-specialized-arrays.direct.alien specialized-arrays.direct.int
+core-foundation core-foundation.run-loop core-foundation.strings
-specialized-arrays.direct.longlong ;
+core-foundation.time ;
 IN: core-foundation.fsevents
 
 : kFSEventStreamCreateFlagUseCFTypes 2 ; inline

basis/core-foundation/run-loop/run-loop.factor

@@ -1,6 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax core-foundation kernel namespaces ;
+USING: accessors alien alien.syntax kernel math namespaces
+sequences destructors combinators threads heaps deques calendar
+core-foundation core-foundation.strings
+core-foundation.file-descriptors core-foundation.timers
+core-foundation.time ;
 IN: core-foundation.run-loop
 
 : kCFRunLoopRunFinished 1 ; inline
@@ -32,6 +36,24 @@ FUNCTION: void CFRunLoopAddSource (
    CFStringRef mode
 ) ;
 
+FUNCTION: void CFRunLoopRemoveSource (
+   CFRunLoopRef rl,
+   CFRunLoopSourceRef source,
+   CFStringRef mode
+) ;
+
+FUNCTION: void CFRunLoopAddTimer (
+   CFRunLoopRef rl,
+   CFRunLoopTimerRef timer,
+   CFStringRef mode
+) ;
+
+FUNCTION: void CFRunLoopRemoveTimer (
+   CFRunLoopRef rl,
+   CFRunLoopTimerRef timer,
+   CFStringRef mode
+) ;
+
 : CFRunLoopDefaultMode ( -- alien )
     #! Ugly, but we don't have static NSStrings
     \ CFRunLoopDefaultMode get-global dup expired? [
@@ -39,3 +61,80 @@ FUNCTION: void CFRunLoopAddSource (
         "kCFRunLoopDefaultMode" <CFString>
         dup \ CFRunLoopDefaultMode set-global
     ] when ;
+
+TUPLE: run-loop fds sources timers ;
+
+: <run-loop> ( -- run-loop )
+    V{ } clone V{ } clone V{ } clone \ run-loop boa ;
+
+SYMBOL: expiry-check
+
+: run-loop ( -- run-loop )
+    \ run-loop get-global not expiry-check get expired? or
+    [
+        31337 <alien> expiry-check set-global
+        <run-loop> dup \ run-loop set-global
+    ] [ \ run-loop get-global ] if ;
+
+: add-source-to-run-loop ( source -- )
+    [ run-loop sources>> push ]
+    [
+        CFRunLoopGetMain
+        swap CFRunLoopDefaultMode
+        CFRunLoopAddSource
+    ] bi ;
+
+: create-fd-source ( CFFileDescriptor -- source )
+    f swap 0 CFFileDescriptorCreateRunLoopSource ;
+
+: add-fd-to-run-loop ( fd callback -- )
+    [
+        <CFFileDescriptor> |CFRelease
+        [ run-loop fds>> push ]
+        [ create-fd-source |CFRelease add-source-to-run-loop ]
+        bi
+    ] with-destructors ;
+
+: add-timer-to-run-loop ( timer -- )
+    [ run-loop timers>> push ]
+    [
+        CFRunLoopGetMain
+        swap CFRunLoopDefaultMode
+        CFRunLoopAddTimer
+    ] bi ;
+
+<PRIVATE
+
+: ((reset-timer)) ( timer counter timestamp -- )
+    nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
+
+: (reset-timer) ( timer counter -- )
+    yield {
+        { [ dup 0 = ] [ now ((reset-timer)) ] }
+        { [ run-queue deque-empty? not ] [ 1- (reset-timer) ] }
+        { [ sleep-queue heap-empty? ] [ 5 minutes hence ((reset-timer)) ] }
+        [ sleep-queue heap-peek nip micros>timestamp ((reset-timer)) ]
+    } cond ;
+
+: reset-timer ( timer -- )
+    10 (reset-timer) ;
+
+PRIVATE>
+
+: reset-run-loop ( -- )
+    run-loop
+    [ timers>> [ reset-timer ] each ]
+    [ fds>> [ enable-all-callbacks ] each ] bi ;
+
+: timer-callback ( -- callback )
+    "void" { "CFRunLoopTimerRef" "void*" } "cdecl"
+    [ 2drop reset-run-loop yield ] alien-callback ;
+
+: init-thread-timer ( -- )
+    timer-callback <CFTimer> add-timer-to-run-loop ;
+
+: run-one-iteration ( us -- handled? )
+    reset-run-loop
+    CFRunLoopDefaultMode
+    swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval
+    t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;

basis/core-foundation/run-loop/thread/summary.txt

@@ -1 +0,0 @@
-Vocabulary with init hook for running CoreFoundation event loop

basis/core-foundation/run-loop/thread/thread.factor

@@ -1,16 +0,0 @@
-! Copyright (C) 2008 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: calendar core-foundation.run-loop init kernel threads ;
-IN: core-foundation.run-loop.thread
-
-! Load this vocabulary if you need a run loop running.
-
-: run-loop-thread ( -- )
-    CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
-    kCFRunLoopRunHandledSource = [ 1 seconds sleep ] unless
-    run-loop-thread ;
-
-: start-run-loop-thread ( -- )
-    [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ;
-
-[ start-run-loop-thread ] "core-foundation.run-loop.thread" add-init-hook

basis/core-foundation/strings/strings-docs.factor

@@ -0,0 +1,14 @@
+USING: help.syntax help.markup strings ;
+IN: core-foundation.strings
+
+HELP: <CFString>
+{ $values { "string" string } { "alien" "a " { $snippet "CFString" } } }
+{ $description "Creates a Core Foundation string from a Factor string." } ;
+
+HELP: CF>string
+{ $values { "alien" "a " { $snippet "CFString" } } { "string" string } }
+{ $description "Creates a Factor string from a Core Foundation string." } ;
+
+HELP: CF>string-array
+{ $values { "alien" "a " { $snippet "CFArray" } " of " { $snippet "CFString" } " instances" } { "seq" string } }
+{ $description "Creates an array of Factor strings from a " { $snippet "CFArray" } " of " { $snippet "CFString" } "s." } ;

basis/core-foundation/strings/strings-tests.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: core-foundation tools.test kernel ;
+USING: core-foundation.strings core-foundation tools.test kernel ;
 IN: core-foundation
 
 [ ] [ "Hello" <CFString> CFRelease ] unit-test

basis/core-foundation/strings/strings.factor

@@ -0,0 +1,66 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax alien.strings kernel sequences byte-arrays
+io.encodings.utf8 math core-foundation core-foundation.arrays ;
+IN: core-foundation.strings
+
+TYPEDEF: void* CFStringRef
+
+TYPEDEF: int CFStringEncoding
+: kCFStringEncodingMacRoman HEX: 0 ;
+: kCFStringEncodingWindowsLatin1 HEX: 0500 ;
+: kCFStringEncodingISOLatin1 HEX: 0201 ;
+: kCFStringEncodingNextStepLatin HEX: 0B01 ;
+: kCFStringEncodingASCII HEX: 0600 ;
+: kCFStringEncodingUnicode HEX: 0100 ;
+: kCFStringEncodingUTF8 HEX: 08000100 ;
+: kCFStringEncodingNonLossyASCII HEX: 0BFF ;
+: kCFStringEncodingUTF16 HEX: 0100 ;
+: kCFStringEncodingUTF16BE HEX: 10000100 ;
+: kCFStringEncodingUTF16LE HEX: 14000100 ;
+: kCFStringEncodingUTF32 HEX: 0c000100 ;
+: kCFStringEncodingUTF32BE HEX: 18000100 ;
+: kCFStringEncodingUTF32LE HEX: 1c000100 ;
+
+FUNCTION: CFStringRef CFStringCreateWithBytes (
+   CFAllocatorRef alloc,
+   UInt8* bytes,
+   CFIndex numBytes,
+   CFStringEncoding encoding,
+   Boolean isExternalRepresentation
+) ;
+
+FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ;
+
+FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ;
+
+FUNCTION: Boolean CFStringGetCString (
+   CFStringRef theString,
+   char* buffer,
+   CFIndex bufferSize,
+   CFStringEncoding encoding
+) ;
+
+FUNCTION: CFStringRef CFStringCreateWithCString (
+   CFAllocatorRef alloc,
+   char* cStr,
+   CFStringEncoding encoding
+) ;
+
+: <CFString> ( string -- alien )
+    f swap utf8 string>alien kCFStringEncodingUTF8 CFStringCreateWithCString
+    [ "CFStringCreateWithCString failed" throw ] unless* ;
+
+: CF>string ( alien -- string )
+    dup CFStringGetLength 4 * 1 + <byte-array> [
+        dup length
+        kCFStringEncodingUTF8
+        CFStringGetCString
+        [ "CFStringGetCString failed" throw ] unless
+    ] keep utf8 alien>string ;
+
+: CF>string-array ( alien -- seq )
+    CF>array [ CF>string ] map ;
+
+: <CFStringArray> ( seq -- alien )
+    [ <CFString> ] map [ <CFArray> ] [ [ CFRelease ] each ] bi ;

basis/core-foundation/strings/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/time/time.factor

@@ -0,0 +1,14 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: calendar alien.syntax ;
+IN: core-foundation.time
+
+TYPEDEF: double CFTimeInterval
+TYPEDEF: double CFAbsoluteTime
+
+: >CFTimeInterval ( duration -- interval )
+    duration>seconds ; inline
+
+: >CFAbsoluteTime ( timestamp -- time )
+    T{ timestamp { year 2001 } { month 1 } { day 1 } } time-
+    duration>seconds ; inline

basis/core-foundation/timers/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/timers/timers.factor

@@ -0,0 +1,35 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax system math kernel calendar core-foundation
+core-foundation.time ;
+IN: core-foundation.timers
+
+TYPEDEF: void* CFRunLoopTimerRef
+TYPEDEF: void* CFRunLoopTimerCallBack
+TYPEDEF: void* CFRunLoopTimerContext
+
+FUNCTION: CFRunLoopTimerRef CFRunLoopTimerCreate (
+   CFAllocatorRef allocator,
+   CFAbsoluteTime fireDate,
+   CFTimeInterval interval,
+   CFOptionFlags flags,
+   CFIndex order,
+   CFRunLoopTimerCallBack callout,
+   CFRunLoopTimerContext* context
+) ;
+
+: <CFTimer> ( callback -- timer )
+    [ f now >CFAbsoluteTime 60 0 0 ] dip f CFRunLoopTimerCreate ;
+
+FUNCTION: void CFRunLoopTimerInvalidate (
+   CFRunLoopTimerRef timer
+) ;
+
+FUNCTION: Boolean CFRunLoopTimerIsValid (
+   CFRunLoopTimerRef timer
+) ;
+
+FUNCTION: void CFRunLoopTimerSetNextFireDate (
+   CFRunLoopTimerRef timer,
+   CFAbsoluteTime fireDate
+) ;

basis/core-foundation/urls/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/urls/urls-docs.factor

@@ -0,0 +1,10 @@
+USING: help.syntax help.markup ;
+IN: core-foundation.urls
+
+HELP: <CFFileSystemURL>
+{ $values { "string" "a pathname string" } { "dir?" "a boolean indicating if the pathname is a directory" } { "url" "a " { $snippet "CFURL" } } }
+{ $description "Creates a new " { $snippet "CFURL" } " pointing to the given local pathname." } ;
+
+HELP: <CFURL>
+{ $values { "string" "a URL string" } { "url" "a " { $snippet "CFURL" } } }
+{ $description "Creates a new " { $snippet "CFURL" } "." } ;

basis/core-foundation/urls/urls.factor

@@ -0,0 +1,24 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel core-foundation.strings
+core-foundation ;
+IN: core-foundation.urls
+
+: kCFURLPOSIXPathStyle 0 ; inline
+
+TYPEDEF: void* CFURLRef
+
+FUNCTION: CFURLRef CFURLCreateWithFileSystemPath ( CFAllocatorRef allocator, CFStringRef filePath, int pathStyle, Boolean isDirectory ) ;
+
+FUNCTION: CFURLRef CFURLCreateWithString ( CFAllocatorRef allocator, CFStringRef string, CFURLRef base ) ;
+
+FUNCTION: CFURLRef CFURLCopyFileSystemPath ( CFURLRef url, int pathStyle ) ;
+
+: <CFFileSystemURL> ( string dir? -- url )
+    [ <CFString> f over kCFURLPOSIXPathStyle ] dip
+    CFURLCreateWithFileSystemPath swap CFRelease ;
+
+: <CFURL> ( string -- url )
+    <CFString>
+    [ f swap f CFURLCreateWithString ] keep
+    CFRelease ;

basis/cpu/ppc/assembler/assembler.factor

@@ -189,21 +189,21 @@ MTSPR: LR 8
 MTSPR: CTR 9
 
 ! Pseudo-instructions
-: LI 0 rot ADDI ; inline
+: LI ( value dst -- ) 0 rot ADDI ; inline
-: SUBI neg ADDI ; inline
+: SUBI ( dst src1 src2 -- ) neg ADDI ; inline
-: LIS 0 rot ADDIS ; inline
+: LIS ( value dst -- ) 0 rot ADDIS ; inline
-: SUBIC neg ADDIC ; inline
+: SUBIC ( dst src1 src2 -- ) neg ADDIC ; inline
-: SUBIC. neg ADDIC. ; inline
+: SUBIC. ( dst src1 src2 -- ) neg ADDIC. ; inline
-: NOT dup NOR ; inline
+: NOT ( dst src -- ) dup NOR ; inline
-: NOT. dup NOR. ; inline
+: NOT. ( dst src -- ) dup NOR. ; inline
-: MR dup OR ; inline
+: MR ( dst src -- ) dup OR ; inline
-: MR. dup OR. ; inline
+: MR. ( dst src -- ) dup OR. ; inline
-: (SLWI) 0 31 pick - ; inline
+: (SLWI) ( d a b -- d a b x y ) 0 31 pick - ; inline
 : SLWI ( d a b -- ) (SLWI) RLWINM ;
 : SLWI. ( d a b -- ) (SLWI) RLWINM. ;
-: (SRWI) 32 over - swap 31 ; inline
+: (SRWI) ( d a b -- d a b x y ) 32 over - swap 31 ; inline
 : SRWI ( d a b -- ) (SRWI) RLWINM ;
 : SRWI. ( d a b -- ) (SRWI) RLWINM. ;
-: LOAD32 ( n r -- ) >r w>h/h r> tuck LIS dup rot ORI ;
+: LOAD32 ( n r -- ) [ w>h/h ] dip tuck LIS dup rot ORI ;
 : immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ;
 : LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ;

basis/cpu/ppc/assembler/backend/backend.factor

@@ -79,8 +79,8 @@ M: label (B) 0 -rot (B) rc-relative-ppc-3 label-fixup ;
 
 GENERIC: BC ( a b c -- )
 M: integer BC 0 0 16 b-insn ;
-M: word BC >r 0 BC r> rc-relative-ppc-2 rel-word ;
+M: word BC [ 0 BC ] dip rc-relative-ppc-2 rel-word ;
-M: label BC >r 0 BC r> rc-relative-ppc-2 label-fixup ;
+M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ;
 
 : CREATE-B ( -- word ) scan "B" prepend create-in ;
 

basis/cpu/ppc/bootstrap.factor

@@ -302,9 +302,7 @@ big-endian on
     4 ds-reg 0 STW
 ] f f f \ -rot define-sub-primitive
 
-[ jit->r ] f f f \ >r define-sub-primitive
+[ jit->r ] f f f \ load-local define-sub-primitive
-
-[ jit-r> ] f f f \ r> define-sub-primitive
 
 ! Comparisons
 : jit-compare ( insn -- )

basis/cpu/ppc/ppc.factor

@@ -467,19 +467,21 @@ M: ppc %gc
 M: ppc %prologue ( n -- )
     0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
     0 MFLR
-    1 1 pick neg ADDI
+    {
-    11 1 pick xt-save STW
+        [ [ 1 1 ] dip neg ADDI ]
-    dup 11 LI
+        [ [ 11 1 ] dip xt-save STW ]
-    11 1 pick next-save STW
+        [ 11 LI ]
-    0 1 rot lr-save + STW ;
+        [ [ 11 1 ] dip next-save STW ]
+        [ [ 0 1 ] dip lr-save + STW ]
+    } cleave ;
 
 M: ppc %epilogue ( n -- )
     #! At the end of each word that calls a subroutine, we store
     #! the previous link register value in r0 by popping it off
     #! the stack, set the link register to the contents of r0,
     #! and jump to the link register.
-    0 1 pick lr-save + LWZ
+    [ [ 0 1 ] dip lr-save + LWZ ]
-    1 1 rot ADDI
+    [ [ 1 1 ] dip ADDI ] bi
     0 MTLR ;
 
 :: (%boolean) ( dst temp word -- )
@@ -541,17 +543,17 @@ GENERIC: STF ( src dst off reg-class -- )
 M: single-float-regs STF drop STFS ;
 M: double-float-regs STF drop STFD ;
 
-M: float-regs %save-param-reg >r 1 rot local@ r> STF ;
+M: float-regs %save-param-reg [ 1 rot local@ ] dip STF ;
 
 GENERIC: LF ( dst src off reg-class -- )
 
 M: single-float-regs LF drop LFS ;
 M: double-float-regs LF drop LFD ;
 
-M: float-regs %load-param-reg >r 1 rot local@ r> LF ;
+M: float-regs %load-param-reg [ 1 rot local@ ] dip LF ;
 
 M: stack-params %load-param-reg ( stack reg reg-class -- )
-    drop >r 0 1 rot local@ LWZ 0 1 r> param@ STW ;
+    drop [ 0 1 rot local@ LWZ 0 1 ] dip param@ STW ;
 
 : next-param@ ( n -- x ) param@ stack-frame get total-size>> + ;
 
@@ -559,8 +561,8 @@ M: stack-params %save-param-reg ( stack reg reg-class -- )
     #! Funky. Read the parameter from the caller's stack frame.
     #! This word is used in callbacks
     drop
-    0 1 rot next-param@ LWZ
+    [ 0 1 ] dip next-param@ LWZ
-    0 1 rot local@ STW ;
+    [ 0 1 ] dip local@ STW ;
 
 M: ppc %prepare-unbox ( -- )
     ! First parameter is top of stack
@@ -580,14 +582,14 @@ M: ppc %unbox-long-long ( n func -- )
     f %alien-invoke
     ! Store the return value on the C stack
     [
-        3 1 pick local@ STW
+        [ [ 3 1 ] dip local@ STW ]
-        4 1 rot cell + local@ STW
+        [ [ 4 1 ] dip cell + local@ STW ] bi
     ] when* ;
 
 M: ppc %unbox-large-struct ( n c-type -- )
     ! Value must be in r3
     ! Compute destination address and load struct size
-    [ 4 1 rot local@ ADDI ] [ heap-size 5 LI ] bi*
+    [ [ 4 1 ] dip local@ ADDI ] [ heap-size 5 LI ] bi*
     ! Call the function
     "to_value_struct" f %alien-invoke ;
 
@@ -595,15 +597,16 @@ M: ppc %box ( n reg-class func -- )
     ! If the source is a stack location, load it into freg #0.
     ! If the source is f, then we assume the value is already in
     ! freg #0.
-    >r
+    [ over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if ] dip
-    over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if
+    f %alien-invoke ;
-    r> f %alien-invoke ;
 
 M: ppc %box-long-long ( n func -- )
-    >r [
+    [
-        3 1 pick local@ LWZ
+        [
-        4 1 rot cell + local@ LWZ
+            [ [ 3 1 ] dip local@ LWZ ]
-    ] when* r> f %alien-invoke ;
+            [ [ 4 1 ] dip cell + local@ LWZ ] bi
+        ] when*
+    ] dip f %alien-invoke ;
 
 : struct-return@ ( n -- n )
     [ stack-frame get params>> ] unless* local@ ;
@@ -616,7 +619,7 @@ M: ppc %prepare-box-struct ( -- )
 M: ppc %box-large-struct ( n c-type -- )
     ! If n = f, then we're boxing a returned struct
     ! Compute destination address and load struct size
-    [ 3 1 rot struct-return@ ADDI ] [ heap-size 4 LI ] bi*
+    [ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi*
     ! Call the function
     "box_value_struct" f %alien-invoke ;
 

basis/cpu/x86/64/64.factor

@@ -37,7 +37,7 @@ M:: x86.64 %dispatch ( src temp offset -- )
 
 M: x86.64 param-reg-1 int-regs param-regs first ;
 M: x86.64 param-reg-2 int-regs param-regs second ;
-: param-reg-3 int-regs param-regs third ; inline
+: param-reg-3 ( -- reg ) int-regs param-regs third ; inline
 
 M: int-regs return-reg drop RAX ;
 M: float-regs return-reg drop XMM0 ;
@@ -50,8 +50,8 @@ M: x86.64 %prologue ( n -- )
 
 M: stack-params %load-param-reg
     drop
-    >r R11 swap param@ MOV
+    [ R11 swap param@ MOV ] dip
-    r> param@ R11 MOV ;
+    param@ R11 MOV ;
 
 M: stack-params %save-param-reg
     drop

basis/cpu/x86/assembler/syntax/syntax.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel words sequences lexer parser fry ;
+USING: kernel words words.symbol sequences lexer parser fry ;
 IN: cpu.x86.assembler.syntax
 
 : define-register ( name num size -- )

basis/cpu/x86/bootstrap.factor

@@ -79,9 +79,10 @@ big-endian off
     ! compute quotation location
     temp0 temp1 ADD
     ! load quotation
-    temp0 temp0 array-start-offset [+] MOV
+    arg temp0 array-start-offset [+] MOV
-    ! execute branch
+    ! execute branch. the quot must be in arg, since it might
-    temp0 quot-xt-offset [+] JMP
+    ! not be compiled yet
+    arg quot-xt-offset [+] JMP
 ] rc-absolute-cell rt-immediate 1 rex-length + jit-dispatch jit-define
 
 : jit->r ( -- )
@@ -318,9 +319,7 @@ big-endian off
     ds-reg [] temp1 MOV
 ] f f f \ -rot define-sub-primitive
 
-[ jit->r ] f f f \ >r define-sub-primitive
+[ jit->r ] f f f \ load-local define-sub-primitive
-
-[ jit-r> ] f f f \ r> define-sub-primitive
 
 ! Comparisons
 : jit-compare ( insn -- )

basis/csv/csv.factor

@@ -12,7 +12,7 @@ SYMBOL: delimiter
 
 CHAR: , delimiter set-global
 
-: delimiter> delimiter get ; inline
+: delimiter> ( -- delimiter ) delimiter get ; inline
     
 DEFER: quoted-field ( -- endchar )