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

diff --combined basis/prettyprint/backend/backend.factor
index 5af29bf8553dd554e738b580d1b5974b30f57bca,22dec9d2fcf28a5e2a4407a66835c165ac2cf3d1..3dcd7fb0ede27ec5079c4488793191d1d723be25
--- 1/basis/prettyprint/backend/backend.factor
--- 2/basis/prettyprint/backend/backend.factor
+++ b/basis/prettyprint/backend/backend.factor
@@@ -1,10 -1,11 +1,10 @@@
 -! Copyright (C) 2003, 2008 Slava Pestov.
 +! Copyright (C) 2003, 2009 Slava Pestov.
  ! See http://factorcode.org/license.txt for BSD license.
 -USING: accessors arrays byte-arrays generic hashtables io assocs
 -kernel math namespaces make sequences strings sbufs vectors
 +USING: accessors arrays byte-arrays byte-vectors generic hashtables io
 +assocs kernel math namespaces make sequences strings sbufs vectors
  words prettyprint.config prettyprint.custom prettyprint.sections
 -quotations io io.pathnames io.styles math.parser effects
 -classes.tuple math.order classes.tuple.private classes
 -combinators colors ;
 +quotations io io.pathnames io.styles math.parser effects classes.tuple
 +math.order classes.tuple.private classes combinators colors ;
  IN: prettyprint.backend
  
  M: effect pprint* effect>string "(" ")" surround text ;
@@@ -134,8 -135,8 +134,8 @@@ M: pathname pprint
      [ text ] [ f <inset pprint* block> ] bi*
      \ } pprint-word block> ;
  
- M: tuple pprint*
-     boa-tuples? get [ call-next-method ] [
+ : pprint-tuple ( tuple -- )
+     boa-tuples? get [ pprint-object ] [
          [
              <flow
              \ T{ pprint-word
@@@ -148,6 -149,9 +148,9 @@@
          ] check-recursion
      ] if ;
  
+ M: tuple pprint*
+     pprint-tuple ;
+ 
  : do-length-limit ( seq -- trimmed n/f )
      length-limit get dup [
          over length over [-]
@@@ -164,7 -168,6 +167,7 @@@ M: curry pprint-delims drop \ [ \ ] 
  M: compose pprint-delims drop \ [ \ ] ;
  M: array pprint-delims drop \ { \ } ;
  M: byte-array pprint-delims drop \ B{ \ } ;
 +M: byte-vector pprint-delims drop \ BV{ \ } ;
  M: vector pprint-delims drop \ V{ \ } ;
  M: hashtable pprint-delims drop \ H{ \ } ;
  M: tuple pprint-delims drop \ T{ \ } ;
@@@ -173,7 -176,6 +176,7 @@@ M: callstack pprint-delims drop \ CS{ 
  
  M: object >pprint-sequence ;
  M: vector >pprint-sequence ;
 +M: byte-vector >pprint-sequence ;
  M: curry >pprint-sequence ;
  M: compose >pprint-sequence ;
  M: hashtable >pprint-sequence >alist ;
@@@ -203,7 -205,6 +206,7 @@@ M: object pprint-object ( obj -- 
  
  M: object pprint* pprint-object ;
  M: vector pprint* pprint-object ;
 +M: byte-vector pprint* pprint-object ;
  M: hashtable pprint* pprint-object ;
  M: curry pprint* pprint-object ;
  M: compose pprint* pprint-object ;

diff --combined core/bootstrap/primitives.factor
index 1aed59503cd3a05e59c7593fd6fd3cd236f68f9e,ec791857541d7052f97a6265720711c0e8611bc3..75a6c3179a2d86415f7511edb8ccb7b8d668d64d
--- 1/core/bootstrap/primitives.factor
--- 2/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@@ -82,10 -82,8 +82,10 @@@ bootstrapping? o
      "kernel"
      "kernel.private"
      "math"
 +    "math.parser.private"
      "math.private"
      "memory"
 +    "memory.private"
      "quotations"
      "quotations.private"
      "sbufs"
@@@ -368,8 -366,8 +368,8 @@@ tupl
      { "float>bignum" "math.private" (( x -- y )) }
      { "fixnum>float" "math.private" (( x -- y )) }
      { "bignum>float" "math.private" (( x -- y )) }
 -    { "string>float" "math.private" (( str -- n/f )) }
 -    { "float>string" "math.private" (( n -- str )) }
 +    { "(string>float)" "math.parser.private" (( str -- n/f )) }
 +    { "(float>string)" "math.parser.private" (( n -- str )) }
      { "float>bits" "math" (( x -- n )) }
      { "double>bits" "math" (( x -- n )) }
      { "bits>float" "math" (( n -- x )) }
@@@ -416,8 -414,8 +416,8 @@@
      { "(exists?)" "io.files.private" (( path -- ? )) }
      { "gc" "memory" (( -- )) }
      { "gc-stats" "memory" f }
 -    { "save-image" "memory" (( path -- )) }
 -    { "save-image-and-exit" "memory" (( path -- )) }
 +    { "(save-image)" "memory.private" (( path -- )) }
 +    { "(save-image-and-exit)" "memory.private" (( path -- )) }
      { "datastack" "kernel" (( -- ds )) }
      { "retainstack" "kernel" (( -- rs )) }
      { "callstack" "kernel" (( -- cs )) }
@@@ -429,38 -427,38 +429,38 @@@
      { "code-room" "memory" (( -- code-free code-total )) }
      { "micros" "system" (( -- us )) }
      { "modify-code-heap" "compiler.units" (( alist -- )) }
 -    { "dlopen" "alien.libraries" (( path -- dll )) }
 -    { "dlsym" "alien.libraries" (( name dll -- alien )) }
 +    { "(dlopen)" "alien.libraries" (( path -- dll )) }
 +    { "(dlsym)" "alien.libraries" (( name dll -- alien )) }
      { "dlclose" "alien.libraries" (( dll -- )) }
      { "<byte-array>" "byte-arrays" (( n -- byte-array )) }
      { "(byte-array)" "byte-arrays" (( n -- byte-array )) }
      { "<displaced-alien>" "alien" (( displacement c-ptr -- alien )) }
 -    { "alien-signed-cell" "alien.accessors" f }
 -    { "set-alien-signed-cell" "alien.accessors" f }
 -    { "alien-unsigned-cell" "alien.accessors" f }
 -    { "set-alien-unsigned-cell" "alien.accessors" f }
 -    { "alien-signed-8" "alien.accessors" f }
 -    { "set-alien-signed-8" "alien.accessors" f }
 -    { "alien-unsigned-8" "alien.accessors" f }
 -    { "set-alien-unsigned-8" "alien.accessors" f }
 -    { "alien-signed-4" "alien.accessors" f }
 -    { "set-alien-signed-4" "alien.accessors" f }
 -    { "alien-unsigned-4" "alien.accessors" f }
 -    { "set-alien-unsigned-4" "alien.accessors" f }
 -    { "alien-signed-2" "alien.accessors" f }
 -    { "set-alien-signed-2" "alien.accessors" f }
 -    { "alien-unsigned-2" "alien.accessors" f }
 -    { "set-alien-unsigned-2" "alien.accessors" f }
 -    { "alien-signed-1" "alien.accessors" f }
 -    { "set-alien-signed-1" "alien.accessors" f }
 -    { "alien-unsigned-1" "alien.accessors" f }
 -    { "set-alien-unsigned-1" "alien.accessors" f }
 -    { "alien-float" "alien.accessors" f }
 -    { "set-alien-float" "alien.accessors" f }
 -    { "alien-double" "alien.accessors" f }
 -    { "set-alien-double" "alien.accessors" f }
 -    { "alien-cell" "alien.accessors" f }
 -    { "set-alien-cell" "alien.accessors" f }
 +    { "alien-signed-cell" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-signed-cell" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-unsigned-cell" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-unsigned-cell" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-signed-8" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-signed-8" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-unsigned-8" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-unsigned-8" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-signed-4" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-signed-4" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-unsigned-4" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-unsigned-4" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-signed-2" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-signed-2" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-unsigned-2" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-unsigned-2" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-signed-1" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-signed-1" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-unsigned-1" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-unsigned-1" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-float" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-float" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-double" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-double" "alien.accessors" (( value c-ptr n -- )) }
 +    { "alien-cell" "alien.accessors" (( c-ptr n -- value )) }
 +    { "set-alien-cell" "alien.accessors" (( value c-ptr n -- )) }
      { "alien-address" "alien" (( c-ptr -- addr )) }
      { "set-slot" "slots.private" (( value obj n -- )) }
      { "string-nth" "strings.private" (( n string -- ch )) }
@@@ -474,7 -472,7 +474,7 @@@
      { "end-scan" "memory" (( -- )) }
      { "size" "memory" (( obj -- n )) }
      { "die" "kernel" (( -- )) }
 -    { "fopen" "io.streams.c" (( path mode -- alien )) }
 +    { "(fopen)" "io.streams.c" (( path mode -- alien )) }
      { "fgetc" "io.streams.c" (( alien -- ch/f )) }
      { "fread" "io.streams.c" (( n alien -- str/f )) }
      { "fputc" "io.streams.c" (( ch alien -- )) }
@@@ -515,4 -513,4 +515,4 @@@
  } [ [ first3 ] dip swap make-primitive ] each-index
  
  ! Bump build number
- "build" "kernel" create build 1+ [ ] curry (( -- n )) define-declared
+ "build" "kernel" create build 1 + [ ] curry (( -- n )) define-declared

diff --combined core/generic/standard/standard.factor
index 499adcc8184592d900e81ae29d4955c7800f2474,c8d1acba8f4a13d32a3add0f7d9e5d11ae42acbe..87611a76d0a8ab7fa1dce518a1f8015e4969f999
--- 1/core/generic/standard/standard.factor
--- 2/core/generic/standard/standard.factor
+++ b/core/generic/standard/standard.factor
@@@ -28,7 -28,7 +28,7 @@@ CONSTANT: simple-combination T{ standar
          { 0 [ [ dup ] ] }
          { 1 [ [ over ] ] }
          { 2 [ [ pick ] ] }
-         [ 1- (picker) [ dip swap ] curry ]
+         [ 1 - (picker) [ dip swap ] curry ]
      } case ;
  
  M: standard-combination picker
@@@ -44,7 -44,7 +44,7 @@@ M: standard-combination inline-cache-qu
      #! Direct calls to the generic word (not tail calls or indirect calls)
      #! will jump to the inline cache entry point instead of the megamorphic
      #! dispatch entry point.
 -    combination get #>> [ f inline-cache-miss ] 3curry [ ] like ;
 +    combination get #>> [ { } inline-cache-miss ] 3curry [ ] like ;
  
  : make-empty-cache ( -- array )
      mega-cache-size get f <array> ;

diff --combined core/io/files/files.factor
index b2f2f87ad0c57cec46a85dae0274f0fa4660edb8,0f3041e67025e6b34621c894bd0427959c2084f1..6779c6d09429bc14bc4d055354a2ed709e59bf22
--- 1/core/io/files/files.factor
--- 2/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@@ -1,8 -1,7 +1,8 @@@
 -! Copyright (C) 2004, 2008 Slava Pestov, Daniel Ehrenberg.
 +! Copyright (C) 2004, 2009 Slava Pestov, Daniel Ehrenberg.
  ! See http://factorcode.org/license.txt for BSD license.
  USING: kernel kernel.private sequences init namespaces system io
 -io.backend io.pathnames io.encodings io.files.private ;
 +io.backend io.pathnames io.encodings io.files.private
 +alien.strings ;
  IN: io.files
  
  HOOK: (file-reader) io-backend ( path -- stream )
@@@ -21,13 -20,13 +21,13 @@@ HOOK: (file-appender) io-backend ( pat
      swap normalize-path (file-appender) swap <encoder> ;
  
  : file-lines ( path encoding -- seq )
-     <file-reader> lines ;
+     <file-reader> stream-lines ;
  
  : with-file-reader ( path encoding quot -- )
      [ <file-reader> ] dip with-input-stream ; inline
  
  : file-contents ( path encoding -- seq )
-     <file-reader> contents ;
+     <file-reader> stream-contents ;
  
  : with-file-writer ( path encoding quot -- )
      [ <file-writer> ] dip with-output-stream ; inline
@@@ -41,8 -40,7 +41,8 @@@
  : with-file-appender ( path encoding quot -- )
      [ <file-appender> ] dip with-output-stream ; inline
  
 -: exists? ( path -- ? ) normalize-path (exists?) ;
 +: exists? ( path -- ? )
 +    normalize-path native-string>alien (exists?) ;
  
  ! Current directory
  <PRIVATE
@@@ -57,7 -55,7 +57,7 @@@ PRIVATE
  
  [
      cwd current-directory set-global
 -    13 getenv cwd prepend-path \ image set-global
 -    14 getenv cwd prepend-path \ vm set-global
 +    13 getenv alien>native-string cwd prepend-path \ image set-global
 +    14 getenv alien>native-string cwd prepend-path \ vm set-global
      image parent-directory "resource-path" set-global
  ] "io.files" add-init-hook

diff --combined core/io/streams/byte-array/byte-array-tests.factor
index 3cf52c6a78dc472f89aaf163619b6d889f4c776f,0000000000000000000000000000000000000000..0cd35dfa213b11583f61ad91958703ffbe53004a
mode 100644,000000..100644
--- 1/core/io/streams/byte-array/byte-array-tests.factor
--- /dev/null
+++ b/core/io/streams/byte-array/byte-array-tests.factor
@@@ -1,29 -1,0 +1,29 @@@
- [ { BIN: 101111111000000111111 } t ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } utf8 <byte-reader> contents dup >array swap string? ] unit-test
 +USING: tools.test io.streams.byte-array io.encodings.binary
 +io.encodings.utf8 io kernel arrays strings namespaces ;
 +
 +[ B{ 1 2 3 } ] [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test
 +[ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test
 +
 +[ B{ BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 BIN: 11101111 BIN: 10000000 BIN: 10111111 BIN: 11011111 BIN: 10000000 CHAR: x } ]
 +[ { BIN: 101111111000000111111 BIN: 1111000000111111 BIN: 11111000000 CHAR: x } >string utf8 [ write ] with-byte-writer ] unit-test
- ] unit-test
++[ { BIN: 101111111000000111111 } t ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } utf8 <byte-reader> stream-contents dup >array swap string? ] unit-test
 +
 +[ B{ 121 120 } 0 ] [
 +    B{ 0 121 120 0 0 0 0 0 0 } binary
 +    [ 1 read drop "\0" read-until ] with-byte-reader
 +] unit-test
 +
 +[ 1 1 4 11 f ] [
 +    B{ 1 2 3 4 5 6 7 8 9 10 11 12 } binary
 +    [
 +        read1
 +        0 seek-absolute input-stream get stream-seek
 +        read1
 +        2 seek-relative input-stream get stream-seek
 +        read1
 +        -2 seek-end input-stream get stream-seek
 +        read1
 +        0 seek-end input-stream get stream-seek
 +        read1
 +    ] with-byte-reader
++] unit-test