Merge branch 'master' into new_ui

diff --git a/basis/io/encodings/chinese/chinese.factor b/basis/io/encodings/chinese/chinese.factor
index 01ddb810ba6a80409213c1e267087e664eec8164..b0013b6e08fecc585761bad8a2a9bfb4b8fd5e63 100644 (file)
--- a/basis/io/encodings/chinese/chinese.factor
+++ b/basis/io/encodings/chinese/chinese.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: xml xml.data kernel io io.encodings interval-maps splitting fry
-math.parser sequences combinators assocs locals accessors math 
-arrays values io.encodings.ascii ascii io.files biassocs math.order
-combinators.short-circuit io.binary io.encodings.iana ;
+math.parser sequences combinators assocs locals accessors math arrays
+byte-arrays values io.encodings.ascii ascii io.files biassocs
+math.order combinators.short-circuit io.binary io.encodings.iana ;
 IN: io.encodings.chinese
 
 SINGLETON: gb18030
@@ -17,6 +17,14 @@ gb18030 "GB18030" register-encoding
 ! Resource file from:
 ! http://source.icu-project.org/repos/icu/data/trunk/charset/data/xml/gb-18030-2000.xml
 
+! Algorithms from:
+! http://www-128.ibm.com/developerworks/library/u-china.html
+
+: linear ( bytes -- num )
+    ! This hard-codes bMin and bMax
+    reverse first4
+    10 * + 126 * + 10 * + ; foldable
+
 TUPLE: range ufirst ulast bfirst blast ;
 
 : b>byte-array ( string -- byte-array )
@@ -27,8 +35,8 @@ TUPLE: range ufirst ulast bfirst blast ;
         {
             [ "uFirst" attr hex> ]
             [ "uLast" attr hex> ]
-            [ "bFirst" attr b>byte-array ]
-            [ "bLast" attr b>byte-array ]
+            [ "bFirst" attr b>byte-array linear ]
+            [ "bLast" attr b>byte-array linear ]
         } cleave range boa
     ] dip push ;
 
@@ -51,21 +59,13 @@ TUPLE: range ufirst ulast bfirst blast ;
         ] each-element mapping ranges 
     ] ;
 
-! Algorithms from:
-! http://www-128.ibm.com/developerworks/library/u-china.html
-
-: linear ( bytes -- num )
-    ! This hard-codes bMin and bMax
-    reverse first4
-    10 * + 126 * + 10 * + ;
-
 : unlinear ( num -- bytes )
     B{ HEX: 81 HEX: 30 HEX: 81 HEX: 30 } linear -
-    10 /mod swap [ HEX: 30 + ] dip
-    126 /mod swap [ HEX: 81 + ] dip
-    10 /mod swap [ HEX: 30 + ] dip
+    10 /mod HEX: 30 + swap
+    126 /mod HEX: 81 + swap
+    10 /mod HEX: 30 + swap
     HEX: 81 +
-    B{ } 4sequence reverse ;
+    4byte-array dup reverse-here ;
 
 : >interval-map-by ( start-quot end-quot value-quot seq -- interval-map )
     '[ _ [ @ 2array ] _ tri ] { } map>assoc <interval-map> ; inline
@@ -74,7 +74,7 @@ TUPLE: range ufirst ulast bfirst blast ;
     [ ufirst>> ] [ ulast>> ] [ ] >interval-map-by ;
 
 : ranges-gb>u ( ranges -- interval-map )
-    [ bfirst>> linear ] [ blast>> linear ] [ ] >interval-map-by ;
+    [ bfirst>> ] [ blast>> ] [ ] >interval-map-by ;
 
 VALUE: gb>u
 VALUE: u>gb
@@ -87,7 +87,7 @@ ascii <file-reader> xml>gb-data
 
 : lookup-range ( char -- byte-array )
     dup u>gb interval-at [
-        [ ufirst>> - ] [ bfirst>> linear ] bi + unlinear
+        [ ufirst>> - ] [ bfirst>> ] bi + unlinear
     ] [ encode-error ] if* ;
 
 M: gb18030 encode-char ( char stream encoding -- )
@@ -109,19 +109,19 @@ M: gb18030 encode-char ( char stream encoding -- )
 : decode-quad ( byte-array -- char )
     dup mapping value-at [ ] [
         linear dup gb>u interval-at [
-            [ bfirst>> linear - ] [ ufirst>> ] bi +
+            [ bfirst>> - ] [ ufirst>> ] bi +
         ] [ drop replacement-char ] if*
     ] ?if ;
 
 : four-byte ( stream byte1 byte2 -- char )
     rot 2 swap stream-read dup last-bytes?
-    [ first2 B{ } 4sequence decode-quad ]
+    [ first2 4byte-array decode-quad ]
     [ 3drop replacement-char ] if ;
 
 : two-byte ( stream byte -- char )
     over stream-read1 {
         { [ dup not ] [ 3drop replacement-char ] }
-        { [ dup second-byte? ] [ B{ } 2sequence mapping value-at nip ] }
+        { [ dup second-byte? ] [ 2byte-array mapping value-at nip ] }
         { [ dup quad-2/4? ] [ four-byte ] }
         [ 3drop replacement-char ]
     } cond ;
@@ -129,7 +129,7 @@ M: gb18030 encode-char ( char stream encoding -- )
 M: gb18030 decode-char ( stream encoding -- char )
     drop dup stream-read1 {
         { [ dup not ] [ 2drop f ] }
-        { [ dup ascii? ] [ nip 1array B{ } like mapping value-at ] }
+        { [ dup ascii? ] [ nip 1byte-array mapping value-at ] }
         { [ dup quad-1/3? ] [ two-byte ] }
         [ 2drop replacement-char ]
     } cond ;

diff --git a/basis/io/encodings/japanese/japanese.factor b/basis/io/encodings/japanese/japanese.factor
index e3257ad63ebed5ba57ad5415820e9d9ef0205b77..194ade377b244b827237ea739285e5f1ac0f8762 100644 (file)
--- a/basis/io/encodings/japanese/japanese.factor
+++ b/basis/io/encodings/japanese/japanese.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: sequences kernel io io.files combinators.short-circuit
-math.order values assocs io.encodings io.binary fry strings
-math io.encodings.ascii arrays accessors splitting math.parser
-biassocs io.encodings.iana ;
+math.order values assocs io.encodings io.binary fry strings math
+io.encodings.ascii arrays byte-arrays accessors splitting
+math.parser biassocs io.encodings.iana ;
 IN: io.encodings.japanese
 
 SINGLETON: shift-jis
@@ -55,7 +55,7 @@ make-jis to: shift-jis-table
     { [ 0 HEX: 7F between? ] [ HEX: A1 HEX: DF between? ] } 1|| ;
 
 : write-halfword ( stream halfword -- )
-    h>b/b swap B{ } 2sequence swap stream-write ;
+    h>b/b swap 2byte-array swap stream-write ;
 
 M: jis encode-char
     swapd ch>jis

diff --git a/core/byte-arrays/byte-arrays-tests.factor b/core/byte-arrays/byte-arrays-tests.factor
index edaea108a18d23d10d1a36d43741ff9dd04e68dc..1c3e4d3bdfdc4ca3755f0b1402e66e04a0e19cd4 100644 (file)
--- a/core/byte-arrays/byte-arrays-tests.factor
+++ b/core/byte-arrays/byte-arrays-tests.factor
@@ -9,3 +9,5 @@ USING: tools.test byte-arrays sequences kernel ;
 [ B{ 1 2 } ] [ 2 B{ 1 2 3 4 5 6 7 8 9 } resize-byte-array ] unit-test\r
 \r
 [ -10 B{ } resize-byte-array ] must-fail\r
+\r
+[ B{ 123 } ] [ 123 1byte-array ] unit-test
\ No newline at end of file

diff --git a/core/byte-arrays/byte-arrays.factor b/core/byte-arrays/byte-arrays.factor
index f0d188ce4a705855a356eb3b07c3e332a55e090a..72989ac447069d04fd48c9460b1136010589bca4 100644 (file)
--- a/core/byte-arrays/byte-arrays.factor
+++ b/core/byte-arrays/byte-arrays.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel kernel.private alien.accessors sequences
 sequences.private math ;
@@ -19,7 +19,7 @@ M: byte-array resize
 
 INSTANCE: byte-array sequence
 
-: 1byte-array ( x -- byte-array ) 1 <byte-array> [ set-first ] keep ; inline
+: 1byte-array ( x -- byte-array ) B{ } 1sequence ; inline
 
 : 2byte-array ( x y -- byte-array ) B{ } 2sequence ; inline
 

diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index 81d0d41177d02aecdf261d57c6df78e6629a87ea..aa000e23d202953570c1e4c6f73558c57d0822c9 100755 (executable)
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -207,6 +207,10 @@ HELP: first4-unsafe
 { $values { "seq" sequence } { "first" "the first element" } { "second" "the second element" } { "third" "the third element" } { "fourth" "the fourth element" } }
 { $contract "Unsafe variant of " { $link first4 } " that does not perform bounds checks." } ;
 
+HELP: 1sequence
+{ $values { "obj" object } { "exemplar" sequence } { "seq" sequence } }
+{ $description "Creates a one-element sequence of the same type as " { $snippet "exemplar" } "." } ;
+
 HELP: 2sequence
 { $values { "obj1" object } { "obj2" object } { "exemplar" sequence } { "seq" sequence } }
 { $description "Creates a two-element sequence of the same type as " { $snippet "exemplar" } "." } ;

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index ce40f4ae803e6494a150ec8d7c8073f77c0e1629..63df6c9d27a674734e2afe0aafbc65e94c899391 100755 (executable)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -137,9 +137,12 @@ INSTANCE: iota immutable-sequence
 
 : from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline
 
+: (1sequence) ( obj seq -- seq )
+    [ 0 swap set-nth-unsafe ] keep ; inline
+
 : (2sequence) ( obj1 obj2 seq -- seq )
     [ 1 swap set-nth-unsafe ] keep
-    [ 0 swap set-nth-unsafe ] keep ; inline
+    (1sequence) ; inline
 
 : (3sequence) ( obj1 obj2 obj3 seq -- seq )
     [ 2 swap set-nth-unsafe ] keep
@@ -151,6 +154,9 @@ INSTANCE: iota immutable-sequence
 
 PRIVATE>
 
+: 1sequence ( obj exemplar -- seq )
+    1 swap [ (1sequence) ] new-like ; inline
+
 : 2sequence ( obj1 obj2 exemplar -- seq )
     2 swap [ (2sequence) ] new-like ; inline
 

diff --git a/core/vectors/vectors-tests.factor b/core/vectors/vectors-tests.factor
index f2e29d79e84de3c3ddc3c27a8de5fe937ab59cb2..12e2ea49f78d250e24c668c84dc4631712ed8c5c 100644 (file)
--- a/core/vectors/vectors-tests.factor
+++ b/core/vectors/vectors-tests.factor
@@ -97,3 +97,5 @@ IN: vectors.tests
 [ fixnum ] [ 1 >bignum V{ } new-sequence length class ] unit-test
 
 [ fixnum ] [ 1 >bignum [ ] V{ } map-as length class ] unit-test
+
+[ V{ "lulz" } ] [ "lulz" 1vector ] unit-test
\ No newline at end of file

diff --git a/core/vectors/vectors.factor b/core/vectors/vectors.factor
index a6bfef71d016a656b1abe56bb483970eb62c3280..1bdda7b69da91567ffdfc642df421faa8a0917cd 100644 (file)
--- a/core/vectors/vectors.factor
+++ b/core/vectors/vectors.factor
@@ -40,7 +40,7 @@ M: sequence new-resizable drop <vector> ;
 
 INSTANCE: vector growable
 
-: 1vector ( x -- vector ) 1array >vector ;
+: 1vector ( x -- vector ) V{ } 1sequence ;
 
 : ?push ( elt seq/f -- seq )
     [ 1 <vector> ] unless* [ push ] keep ;