diff --git a/library/arrays.factor b/library/arrays.factor index 72eb6ba59f..85f2df1656 100644 --- a/library/arrays.factor +++ b/library/arrays.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: kernel-internals -USING: generic math-internals kernel lists vectors ; +USING: generic kernel lists math-internals sequences vectors ; ! An array is a range of memory storing pointers to other ! objects. Arrays are not used directly, and their access words @@ -23,15 +23,6 @@ BUILTIN: array 8 [ 1 "array-capacity" f ] ; #! Unsafe. swap 2 fixnum+ set-slot ; inline -: (array>list) ( n i array -- list ) - #! Unsafe. - pick pick fixnum<= [ - 3drop [ ] - ] [ - 2dup array-nth >r >r 1 fixnum+ r> (array>list) r> - swap cons - ] ifte ; - -: array>list ( n array -- list ) - #! Unsafe. - 0 swap (array>list) ; +M: array length array-capacity ; +M: array nth array-nth ; +M: array set-nth set-array-nth ; diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 5d83ae71b8..c7f1c0f73c 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -16,6 +16,7 @@ hashtables ; "/version.factor" "/library/stack.factor" "/library/combinators.factor" + "/library/sequences.factor" "/library/arrays.factor" "/library/kernel.factor" "/library/cons.factor" @@ -28,6 +29,7 @@ hashtables ; "/library/lists.factor" "/library/vectors.factor" "/library/strings.factor" + "/library/sequences-epilogue.factor" "/library/hashtables.factor" "/library/namespaces.factor" "/library/words.factor" diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index 80979c647c..e9681f4260 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -16,7 +16,8 @@ IN: image USING: errors generic hashtables kernel lists math namespaces -parser prettyprint stdio streams strings vectors words ; +parser prettyprint sequences sequences stdio streams strings +vectors words ; ! The image being constructed; a vector of word-size integers SYMBOL: image @@ -196,7 +197,7 @@ M: cons ' ( c -- tagged ) tuck string-length - CHAR: \0 fill cat2 ; : emit-chars ( str -- ) - string>list "big-endian" get [ reverse ] unless + >list "big-endian" get [ reverse ] unless 0 swap [ swap 16 shift + ] each emit ; : (pack-string) ( n list -- ) @@ -235,7 +236,7 @@ M: string ' ( string -- pointer ) align-here r> ; : emit-vector ( vector -- pointer ) - dup vector>list emit-array swap vector-length + dup >list emit-array swap vector-length object-tag here-as >r vector-type >header emit emit-fixnum ( length ) @@ -309,7 +310,7 @@ M: hashtable ' ( hashtable -- pointer ) ] ifte ; : write-image ( image file -- ) - [ [ write-word ] vector-each ] with-stream ; + [ [ write-word ] seq-each ] with-stream ; : with-minimal-image ( quot -- image ) [ @@ -323,7 +324,7 @@ M: hashtable ' ( hashtable -- pointer ) #! The quotation leaves a boot quotation on the stack. [ begin call end ] with-minimal-image ; -: test-image ( quot -- ) with-image vector>list . ; +: test-image ( quot -- ) with-image >list . ; : make-image ( name -- ) #! Make an image for the C interpreter. diff --git a/library/compiler/alien.factor b/library/compiler/alien.factor index 20c7851b01..efd708f4f5 100644 --- a/library/compiler/alien.factor +++ b/library/compiler/alien.factor @@ -2,8 +2,8 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: alien USING: assembler compiler errors generic hashtables inference -interpreter kernel lists math namespaces parser stdio strings -unparser words ; +interpreter kernel lists math namespaces parser sequences stdio +strings unparser words ; ! ! ! WARNING ! ! ! ! Reloading this file into a running Factor instance on Win32 diff --git a/library/compiler/generator.factor b/library/compiler/generator.factor index d560681256..c384dbe182 100644 --- a/library/compiler/generator.factor +++ b/library/compiler/generator.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: compiler -USING: assembler inference errors kernel lists math namespaces -strings words vectors ; +USING: assembler errors inference kernel lists math namespaces +sequences strings vectors words ; : generate-node ( [[ op params ]] -- ) #! Generate machine code for a node. @@ -22,7 +22,7 @@ strings words vectors ; : generate-reloc ( -- length ) relocation-table get - dup [ compile-cell ] vector-each + dup [ compile-cell ] seq-each vector-length cell * ; : (generate) ( word linear -- ) diff --git a/library/compiler/optimizer.factor b/library/compiler/optimizer.factor index 3e4e9bf7f6..f9727223db 100644 --- a/library/compiler/optimizer.factor +++ b/library/compiler/optimizer.factor @@ -1,39 +1,8 @@ -! :folding=indent:collapseFolds=1: - -! $Id$ -! -! Copyright (C) 2004 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: compiler -USE: lists -USE: namespaces -USE: kernel -USE: inference -USE: words -USE: prettyprint -USE: kernel-internals -USE: vectors +USING: inference kernel kernel-internals lists namespaces +sequences vectors words words ; ! The optimizer transforms dataflow IR to dataflow IR. Currently ! it removes literals that are eventually dropped, and never @@ -104,7 +73,7 @@ SYMBOL: branch-returns dup [ last [ node-consume-d get list>vector ] bind ] map - unify-stacks vector>list + unify-stacks >list branch-returns set [ dupd can-kill? ] all? nip ] with-scope diff --git a/library/compiler/x86/assembler.factor b/library/compiler/x86/assembler.factor index b722aaedd7..baeae5d748 100644 --- a/library/compiler/x86/assembler.factor +++ b/library/compiler/x86/assembler.factor @@ -34,6 +34,7 @@ USE: generic USE: lists USE: math USE: errors +USE: sequences ! A postfix assembler. ! diff --git a/library/generic/slots.factor b/library/generic/slots.factor index a438153335..a9dc7adc35 100644 --- a/library/generic/slots.factor +++ b/library/generic/slots.factor @@ -5,7 +5,7 @@ ! implement tuples, as well as builtin types. IN: generic USING: kernel kernel-internals lists math namespaces parser -strings words ; +sequences strings words ; : simple-generic ( class generic def -- ) #! Just like: diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor index 47a0327066..bfd322b244 100644 --- a/library/generic/tuple.factor +++ b/library/generic/tuple.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: kernel-internals USING: words parser kernel namespaces lists strings math -hashtables errors vectors ; +hashtables errors sequences vectors ; ! Tuples are really arrays in the runtime, but with a different ! type number. The layout is as follows: @@ -36,6 +36,15 @@ M: tuple delegate 3 slot ; M: object set-delegate 2drop ; M: tuple set-delegate 3 set-slot ; +: check-array ( n array -- ) + array-capacity 0 swap between? [ + "Array index out of bounds" throw + ] unless ; + +M: tuple length array-capacity ; +M: tuple nth 2dup check-array array-nth ; +M: tuple set-nth 2dup check-array set-array-nth ; + #! arrayed objects can be passed to array-capacity, #! array-nth, and set-array-nth. UNION: arrayed array tuple ; @@ -168,27 +177,13 @@ M: tuple clone ( tuple -- tuple ) #! Clone a tuple and its delegate. clone-tuple dup delegate clone over set-delegate ; -: tuple>list ( tuple -- list ) - dup array-capacity swap array>list ; - -M: tuple = ( obj tuple -- ? ) - over tuple? [ - over class-tuple over class-tuple eq? [ - swap tuple>list swap tuple>list = - ] [ - 2drop f - ] ifte - ] [ - 2drop f - ] ifte ; - M: tuple hashcode ( vec -- n ) #! If the capacity is two, then all we have is the class #! slot and delegate. - dup array-capacity 2 number= [ + dup length 2 number= [ drop 0 ] [ - 2 swap array-nth hashcode + 2 swap nth hashcode ] ifte ; tuple [ diff --git a/library/hashtables.factor b/library/hashtables.factor index 58cd4749c3..13c8481be0 100644 --- a/library/hashtables.factor +++ b/library/hashtables.factor @@ -7,7 +7,7 @@ DEFER: set-hash-array DEFER: set-hash-size IN: hashtables -USING: generic kernel lists math vectors ; +USING: generic kernel lists math sequences vectors ; ! We put hash-size in the hashtables vocabulary, and ! the other words in kernel-internals. @@ -117,7 +117,7 @@ IN: hashtables : buckets>list ( hash -- list ) #! Push a list of key/value pairs in a hashtable. - dup bucket-count swap hash-array array>list ; + hash-array >list ; : alist>hash ( alist -- hash ) dup length 1 max swap diff --git a/library/inference/branches.factor b/library/inference/branches.factor index 5e304b8ac8..23bac41253 100644 --- a/library/inference/branches.factor +++ b/library/inference/branches.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: inference USING: errors generic interpreter kernel lists math namespaces -strings vectors words hashtables prettyprint ; +sequences strings vectors words hashtables prettyprint ; : longest-vector ( list -- length ) [ vector-length ] map [ > ] top ; @@ -213,7 +213,7 @@ SYMBOL: cloned \ ifte [ infer-ifte ] "infer" set-word-prop : vtable>list ( value -- list ) - dup value-recursion swap literal-value vector>list + dup value-recursion swap literal-value >list [ over ] map nip ; : ( value -- value ) diff --git a/library/inference/dataflow.factor b/library/inference/dataflow.factor index 97ee7b6fd9..57b305d83f 100644 --- a/library/inference/dataflow.factor +++ b/library/inference/dataflow.factor @@ -33,6 +33,7 @@ USE: math USE: namespaces USE: words USE: vectors +USE: sequences ! We build a dataflow graph for the compiler. SYMBOL: dataflow-graph diff --git a/library/inference/inference.factor b/library/inference/inference.factor index 41934dc529..c6b69bf751 100644 --- a/library/inference/inference.factor +++ b/library/inference/inference.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: inference USING: errors generic interpreter kernel lists math namespaces -prettyprint strings unparser vectors words ; +prettyprint sequences strings unparser vectors words ; : max-recursion 0 ; @@ -114,7 +114,7 @@ M: computed literal-value ( value -- ) d-in [ vector-prepend ] change ; : (present-effect) ( vector -- list ) - vector>list [ value-class ] map ; + >list [ value-class ] map ; : present-effect ( [[ d-in meta-d ]] -- [ in-types out-types ] ) #! After inference is finished, collect information. @@ -184,7 +184,7 @@ M: object apply-object apply-literal ; : values-node ( op -- ) #! Add a #values or #return node to the graph. f swap dataflow, [ - meta-d get vector>list node-consume-d set + meta-d get >list node-consume-d set ] bind ; : (infer) ( quot -- ) diff --git a/library/inference/types.factor b/library/inference/types.factor index 3ee2530e27..75a7cd9395 100644 --- a/library/inference/types.factor +++ b/library/inference/types.factor @@ -2,7 +2,8 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: inference USING: errors generic interpreter kernel kernel-internals -lists math namespaces strings vectors words stdio prettyprint ; +lists math namespaces strings vectors words sequences +stdio prettyprint ; : fast-slot? ( -- ? ) #! If the slot number is literal and the object's type is diff --git a/library/inference/words.factor b/library/inference/words.factor index 643549093d..95b61a5a51 100644 --- a/library/inference/words.factor +++ b/library/inference/words.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: inference USING: errors generic interpreter kernel lists math namespaces -strings vectors words hashtables parser prettyprint ; +sequences strings vectors words hashtables parser prettyprint ; : with-dataflow ( param op [[ in# out# ]] quot -- ) #! Take input parameters, execute quotation, take output diff --git a/library/lists.factor b/library/lists.factor index 54e3e5083d..9d5157d042 100644 --- a/library/lists.factor +++ b/library/lists.factor @@ -1,6 +1,10 @@ ! Copyright (C) 2003, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. -IN: lists USING: generic kernel math ; +IN: lists USING: generic kernel math sequences ; + +! Sequence protocol +M: cons length 0 swap [ drop 1 + ] each ; +M: f length drop 0 ; : 2list ( a b -- [ a b ] ) unit cons ; @@ -83,9 +87,6 @@ IN: lists USING: generic kernel math ; #! Remove all occurrences of the object from the list. [ eq? not ] subset-with ; -: length ( list -- length ) - 0 swap [ drop 1 + ] each ; - : prune ( list -- list ) #! Remove duplicate elements. dup [ diff --git a/library/sbuf.factor b/library/sbuf.factor index b3ac658f61..c42c3e6a8d 100644 --- a/library/sbuf.factor +++ b/library/sbuf.factor @@ -1,6 +1,12 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. -IN: strings USING: kernel lists math namespaces strings ; +IN: strings +USING: kernel lists math namespaces sequences strings ; + +M: sbuf length sbuf-length ; +M: sbuf set-length set-sbuf-length ; +M: sbuf nth sbuf-nth ; +M: sbuf set-nth set-sbuf-nth ; : fill ( count char -- string ) #! Push a string that consists of the same character @@ -18,7 +24,7 @@ IN: strings USING: kernel lists math namespaces strings ; #! Apply a quotation to each character in the string, and #! push a new string constructed from return values. #! The quotation must have stack effect ( X -- X ). - >r string>list r> map cat ; inline + >r >list r> map cat ; inline : split-next ( index string split -- next ) 3dup index-of* dup -1 = [ @@ -55,3 +61,6 @@ IN: strings USING: kernel lists math namespaces strings ; : ch>string ( ch -- str ) 1 [ sbuf-append ] keep sbuf>string ; + +: string>sbuf ( str -- sbuf ) + dup string-length [ sbuf-append ] keep ; diff --git a/library/sequences-epilogue.factor b/library/sequences-epilogue.factor new file mode 100644 index 0000000000..e976a16bfd --- /dev/null +++ b/library/sequences-epilogue.factor @@ -0,0 +1,41 @@ +! Copyright (C) 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. +IN: sequences +USING: generic kernel kernel-internals lists math strings +vectors ; + +! This is loaded once everything else is available. +UNION: sequence array vector string sbuf tuple ; + +M: object (>list) ( n i seq -- list ) + pick pick <= [ + 3drop [ ] + ] [ + 2dup nth >r >r 1 + r> (>list) r> swons + ] ifte ; + +M: vector (>list) vector-array (>list) ; + +: seq-each ( seq quot -- ) + >r >list r> each ; inline + +: seq-each-with ( obj seq quot -- ) + swap [ with ] seq-each 2drop ; inline + +: length= ( seq seq -- ? ) + length swap length number= ; + +M: sequence = ( obj seq -- ? ) + 2dup eq? [ + 2drop t + ] [ + over sequence? [ + 2dup length= [ + swap >list swap >list = + ] [ + 2drop f + ] ifte + ] [ + 2drop f + ] ifte + ] ifte ; diff --git a/library/sequences.factor b/library/sequences.factor new file mode 100644 index 0000000000..59e65535ab --- /dev/null +++ b/library/sequences.factor @@ -0,0 +1,21 @@ +! Copyright (C) 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. +IN: sequences +USING: generic kernel kernel-internals math strings +vectors ; + +! This file is needed very early in bootstrap. + +! Sequences support the following protocol. Concrete examples +! are strings, string buffers, vectors, and arrays. Arrays are +! low level and not bounds-checked; they are in the +! kernel-internals vocabulary, so don't use them unless you have +! a good reason. + +GENERIC: length ( sequence -- n ) +GENERIC: set-length ( n sequence -- ) +GENERIC: nth ( n sequence -- obj ) +GENERIC: set-nth ( value n sequence -- obj ) + +GENERIC: (>list) ( n i seq -- list ) +: >list ( seq -- list ) dup length 0 rot (>list) ; diff --git a/library/strings.factor b/library/strings.factor index ae9eac816d..e6aebbba53 100644 --- a/library/strings.factor +++ b/library/strings.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2003, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. -IN: strings USING: generic kernel kernel-internals lists math ; +IN: strings USING: generic kernel kernel-internals lists math +sequences ; BUILTIN: string 12 [ 1 "string-length" f ] [ 2 hashcode f ] ; M: string = string= ; @@ -10,6 +11,9 @@ M: sbuf = sbuf= ; UNION: text string integer ; +M: string length string-length ; +M: string nth string-nth ; + : f-or-"" ( obj -- ? ) dup not swap "" = or ; @@ -99,21 +103,6 @@ UNION: text string integer ; rot string-head swap ] ifte ; -: (string>list) ( i str -- list ) - 2dup string-length >= [ - 2drop [ ] - ] [ - 2dup string-nth >r >r 1 + r> (string>list) r> swons - ] ifte ; - -: string>list ( str -- list ) - 0 swap (string>list) ; - -: string-each ( str quot -- ) - #! Execute the quotation with each character of the string - #! pushed onto the stack. - >r string>list r> each ; inline - PREDICATE: integer blank " \t\n\r" string-contains? ; PREDICATE: integer letter CHAR: a CHAR: z between? ; PREDICATE: integer LETTER CHAR: A CHAR: Z between? ; diff --git a/library/syntax/parse-numbers.factor b/library/syntax/parse-numbers.factor index 3924ecf400..878b0ffc4d 100644 --- a/library/syntax/parse-numbers.factor +++ b/library/syntax/parse-numbers.factor @@ -1,40 +1,7 @@ -! :folding=indent:collapseFolds=1: - -! $Id$ -! -! Copyright (C) 2004 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: parser -USE: errors -USE: generic -USE: kernel -USE: lists -USE: math -USE: namespaces -USE: strings -USE: words -USE: unparser +USING: errors generic kernel math sequences strings ; ! Number parsing @@ -53,7 +20,7 @@ M: object digit> not-a-number ; dup string-length 0 = [ not-a-number ] [ - 0 swap [ digit> pick digit+ ] string-each nip + 0 swap [ digit> pick digit+ ] seq-each nip ] ifte ; : base> ( str base -- num ) diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor index ac820e90c9..3b4203984b 100644 --- a/library/syntax/parse-syntax.factor +++ b/library/syntax/parse-syntax.factor @@ -107,16 +107,22 @@ BUILTIN: f 9 ; : f f swons ; parsing : CHAR: ( -- ) 0 scan next-char drop swons ; parsing ! String literal -: parse-string ( n str -- n ) +: (parse-string) ( n str -- n ) 2dup string-nth CHAR: " = [ drop 1 + ] [ - [ next-char swap , ] keep parse-string + [ next-char swap , ] keep (parse-string) ] ifte ; +: parse-string [ "line" get (parse-string) ] make-string ; : " "col" [ - "line" get [ parse-string ] make-string swap + parse-string swap + ] change swons ; parsing + +: s" + "col" [ + "line" get skip-blank parse-string string>sbuf swap ] change swons ; parsing ! Comments diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index 16916900a5..d787f03875 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -2,7 +2,8 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: prettyprint USING: errors generic hashtables kernel lists math namespaces -parser presentation stdio streams strings unparser vectors words ; +parser presentation sequences stdio streams strings unparser +vectors words ; SYMBOL: prettyprint-limit SYMBOL: one-line @@ -117,7 +118,7 @@ M: cons prettyprint* ( indent cons -- indent ) M: vector prettyprint* ( indent vector -- indent ) [ - \ { swap vector>list \ } prettyprint-sequence + \ { swap >list \ } prettyprint-sequence ] check-recursion ; M: hashtable prettyprint* ( indent hashtable -- indent ) @@ -127,7 +128,7 @@ M: hashtable prettyprint* ( indent hashtable -- indent ) M: tuple prettyprint* ( indent tuple -- indent ) [ - \ << swap tuple>list \ >> prettyprint-sequence + \ << swap >list \ >> prettyprint-sequence ] check-recursion ; : prettyprint ( obj -- ) @@ -152,7 +153,7 @@ M: tuple prettyprint* ( indent tuple -- indent ) : {.} ( vector -- ) #! Unparse each element on its own line. - vector>list reverse [ . ] each ; + >list reverse [ . ] each ; : .s datastack {.} ; : .r callstack {.} ; diff --git a/library/syntax/unparser.factor b/library/syntax/unparser.factor index e45d3bd462..66126a2cc2 100644 --- a/library/syntax/unparser.factor +++ b/library/syntax/unparser.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: unparser -USING: generic kernel lists math namespaces parser stdio strings -words memory ; +USING: generic kernel lists math memory namespaces parser +sequences sequences stdio strings words ; GENERIC: unparse ( obj -- str ) @@ -88,13 +88,15 @@ M: complex unparse ( num -- str ) dup ch>ascii-escape [ ] [ ch>unicode-escape ] ?ifte ] unless ; -M: string unparse ( str -- str ) - [ - CHAR: " , [ unparse-ch , ] string-each CHAR: " , - ] make-string ; +: unparse-string [ unparse-ch , ] seq-each ; -M: word unparse ( obj -- str ) - word-name dup "#" ? ; +M: string unparse ( str -- str ) + [ CHAR: " , unparse-string CHAR: " , ] make-string ; + +M: sbuf unparse ( str -- str ) + [ "s\" " , unparse-string CHAR: " , ] make-string ; + +M: word unparse ( obj -- str ) word-name dup "#" ? ; M: t unparse drop "t" ; M: f unparse drop "f" ; diff --git a/library/test/sbuf.factor b/library/test/sbuf.factor index bf633ab7a6..236a166581 100644 --- a/library/test/sbuf.factor +++ b/library/test/sbuf.factor @@ -13,3 +13,5 @@ USE: test "World" "buf-clone" get sbuf-append "buf" get sbuf>string ] unit-test + +[ CHAR: h ] [ 0 s" hello world" sbuf-nth ] unit-test diff --git a/library/test/strings.factor b/library/test/strings.factor index 02bbb4e7de..ab7caa4eae 100644 --- a/library/test/strings.factor +++ b/library/test/strings.factor @@ -1,4 +1,6 @@ IN: temporary +USING: sequences ; + USE: errors USE: kernel USE: math @@ -80,7 +82,7 @@ unit-test [ 4 ] [ 0 "There are Four Upper Case characters" - [ LETTER? [ 1 + ] when ] string-each + [ LETTER? [ 1 + ] when ] seq-each ] unit-test [ "Replacing+spaces+with+plus" ] diff --git a/library/test/test.factor b/library/test/test.factor index 24459123b5..b9cea51379 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -2,7 +2,7 @@ IN: test USING: errors kernel lists math memory namespaces parser -prettyprint stdio strings words vectors unparser ; +prettyprint sequences stdio strings unparser vectors words ; : assert ( t -- ) [ "Assertion failed!" throw ] unless ; @@ -24,7 +24,7 @@ prettyprint stdio strings words vectors unparser ; [ [ 2dup print-test - swap >r >r clear r> call datastack vector>list r> + swap >r >r clear r> call datastack >list r> = assert ] keep-datastack 2drop ] time ; diff --git a/library/test/unparser.factor b/library/test/unparser.factor index 1a41bcce81..27dd1ca2c7 100644 --- a/library/test/unparser.factor +++ b/library/test/unparser.factor @@ -28,3 +28,5 @@ unit-test [ ] [ { 1 2 3 } unparse drop ] unit-test [ stdin unparse parse ] unit-test-fails + +[ "s\" hello world\"" ] [ s" hello world" unparse ] unit-test diff --git a/library/test/vectors.factor b/library/test/vectors.factor index 9726a57c50..b1b0d12c85 100644 --- a/library/test/vectors.factor +++ b/library/test/vectors.factor @@ -29,7 +29,7 @@ USE: kernel-internals [ t ] [ 100 empty-vector [ drop 0 100 random-int ] vector-map - dup vector>list list>vector = + dup >list list>vector = ] unit-test [ f ] [ { } { 1 2 3 } = ] unit-test @@ -40,7 +40,7 @@ USE: kernel-internals [ [ 1 4 9 16 ] ] [ [ 1 2 3 4 ] - list>vector [ dup * ] vector-map vector>list + list>vector [ dup * ] vector-map >list ] unit-test [ t ] [ { } hashcode { } hashcode = ] unit-test diff --git a/library/tools/memory.factor b/library/tools/memory.factor index 6d4f606bf2..cf9b79dcf6 100644 --- a/library/tools/memory.factor +++ b/library/tools/memory.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: memory -USING: kernel-internals errors generic kernel lists math -namespaces prettyprint stdio unparser vectors words ; +USING: errors generic kernel kernel-internals lists math +namespaces prettyprint sequences stdio unparser vectors words ; ! Printing an overview of heap usage. @@ -80,7 +80,7 @@ M: object (each-slot) ( quot obj -- ) #! Return a list of instance count/total size pairs. num-types zero-vector num-types zero-vector [ >r 2dup r> heap-stat-step ] each-object - swap vector>list swap vector>list zip ; + swap >list swap >list zip ; : heap-stat. ( type instances bytes -- ) dup 0 = [ diff --git a/library/ui/editors.factor b/library/ui/editors.factor index 658185b448..4bca192962 100644 --- a/library/ui/editors.factor +++ b/library/ui/editors.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: gadgets -USING: generic kernel lists math namespaces sdl line-editor -strings ; +USING: generic kernel line-editor lists math namespaces sdl +sequences strings ; ! An editor gadget wraps a line editor object and passes ! gestures to the line editor. @@ -28,7 +28,7 @@ TUPLE: editor line caret ; : run-char-widths ( str -- wlist ) #! List of x co-ordinates of each character. - 0 swap string>list + 0 swap >list [ ch>string shape-w [ + dup ] keep 2 /i - ] map nip ; : (x>offset) ( n x wlist -- offset ) diff --git a/library/ui/inspector.factor b/library/ui/inspector.factor index 5cb2f4eee4..98cefffc7b 100644 --- a/library/ui/inspector.factor +++ b/library/ui/inspector.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: gadgets USING: errors gadgets generic hashtables kernel kernel-internals -lists namespaces strings unparser vectors words ; +lists namespaces sequences strings unparser vectors words ; : label-box ( list -- gadget ) 0 0 0 swap [ over add-gadget ] each ; @@ -51,10 +51,10 @@ M: list custom-sheet ( list -- gadget ) [ length count ] keep zip alist>sheet "Elements:" ; M: array custom-sheet ( array -- gadget ) - [ array-capacity ] keep array>list custom-sheet ; + >list custom-sheet ; M: vector custom-sheet ( array -- gadget ) - vector>list custom-sheet ; + >list custom-sheet ; M: hashtable custom-sheet ( array -- gadget ) hash>alist sort-sheet alist>sheet "Entries:" ; diff --git a/library/ui/piles.factor b/library/ui/piles.factor index eb949c423a..6b2243b27a 100644 --- a/library/ui/piles.factor +++ b/library/ui/piles.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: gadgets USING: errors generic hashtables kernel lists math namespaces -sdl ; +sdl sequences ; ! A pile is a box that lays out its contents vertically. TUPLE: pile align gap fill ; diff --git a/library/ui/shelves.factor b/library/ui/shelves.factor index b2b0467a40..588ba9b3d1 100644 --- a/library/ui/shelves.factor +++ b/library/ui/shelves.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: gadgets USING: errors generic hashtables kernel lists math namespaces -sdl ; +sdl sequences ; ! A shelf is a box that lays out its contents horizontally. TUPLE: shelf gap align fill ; diff --git a/library/vectors.factor b/library/vectors.factor index fbb7b5e396..4897c8ad97 100644 --- a/library/vectors.factor +++ b/library/vectors.factor @@ -5,9 +5,12 @@ DEFER: (set-vector-length) DEFER: vector-array DEFER: set-vector-array +IN: sequences +DEFER: seq-each + IN: vectors -USING: generic kernel lists math kernel-internals errors -math-internals ; +USING: errors generic kernel kernel-internals lists math +math-internals sequences ; BUILTIN: vector 11 [ 1 "vector-length" (set-vector-length) ] @@ -60,6 +63,11 @@ IN: vectors >r >fixnum dup assert-positive r> 2dup grow-capacity (set-vector-length) ; +M: vector length vector-length ; +M: vector set-length set-vector-length ; +M: vector nth vector-nth ; +M: vector set-nth set-vector-nth ; + : empty-vector ( len -- vec ) #! Creates a vector with 'len' elements set to f. Unlike #! , which gives an empty vector with a certain @@ -82,16 +90,10 @@ IN: vectors : >pop> ( stack -- stack ) dup vector-pop drop ; -: vector>list ( vec -- list ) - dup vector-length swap vector-array array>list ; - : vector-each ( vector quotation -- ) #! Execute the quotation with each element of the vector #! pushed onto the stack. - >r vector>list r> each ; inline - -: vector-each-with ( obj vector quot -- ) - swap [ with ] vector-each 2drop ; inline + >r >list r> each ; inline : list>vector ( list -- vector ) dup length swap [ over vector-push ] each ; @@ -100,11 +102,11 @@ IN: vectors #! Applies code to each element of the vector, return a new #! vector with the results. The code must have stack effect #! ( obj -- obj ). - >r vector>list r> map list>vector ; inline + >r >list r> map list>vector ; inline : vector-nappend ( v1 v2 -- ) #! Destructively append v2 to v1. - [ over vector-push ] vector-each drop ; + [ over vector-push ] seq-each drop ; : vector-append ( v1 v2 -- vec ) over vector-length over vector-length + @@ -122,34 +124,6 @@ M: vector clone ( vector -- vector ) vector-array rot vector-array rot copy-array ] keep ; -: vector-length= ( vec vec -- ? ) - vector-length swap vector-length number= ; - -M: vector = ( obj vec -- ? ) - #! Check if two vectors are equal. Two vectors are - #! considered equal if they have the same length and contain - #! equal elements. - 2dup eq? [ - 2drop t - ] [ - over vector? [ - 2dup vector-length= [ - swap vector>list swap vector>list = - ] [ - 2drop f - ] ifte - ] [ - 2drop f - ] ifte - ] ifte ; - -M: vector hashcode ( vec -- n ) - dup vector-length 0 number= [ - drop 0 - ] [ - 0 swap vector-nth hashcode - ] ifte ; - : vector-tail ( n vector -- list ) #! Return a new list with all elements from the nth #! index upwards. @@ -163,6 +137,13 @@ M: vector hashcode ( vec -- n ) #! one element. [ vector-length swap - ] keep vector-tail ; +M: vector hashcode ( vec -- n ) + dup length 0 number= [ + drop 0 + ] [ + 0 swap nth hashcode + ] ifte ; + ! Find a better place for this IN: kernel diff --git a/library/vocabularies.factor b/library/vocabularies.factor index 7e351a9c14..8cc27c1b43 100644 --- a/library/vocabularies.factor +++ b/library/vocabularies.factor @@ -86,7 +86,7 @@ SYMBOL: vocabularies "compiler" "debugger" "errors" "files" "generic" "hashtables" "inference" "interpreter" "jedit" "kernel" "listener" "lists" "math" "memory" "namespaces" "parser" - "prettyprint" "processes" "profiler" "streams" "stdio" - "strings" "syntax" "test" "threads" "unparser" "vectors" - "words" "scratchpad" + "prettyprint" "processes" "profiler" "sequences" + "streams" "stdio" "strings" "syntax" "test" "threads" + "unparser" "vectors" "words" "scratchpad" ] "use" set ; diff --git a/library/words.factor b/library/words.factor index 7ce8ba00d8..be02890281 100644 --- a/library/words.factor +++ b/library/words.factor @@ -2,13 +2,13 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: words USING: generic hashtables kernel kernel-internals lists math -namespaces strings vectors ; +namespaces sequences strings vectors ; ! Utility GENERIC: (tree-each) ( quot obj -- ) inline M: object (tree-each) swap call ; M: cons (tree-each) [ car (tree-each) ] 2keep cdr (tree-each) ; -M: vector (tree-each) [ swap call ] vector-each-with ; +M: sequence (tree-each) [ swap call ] seq-each-with ; : tree-each swap (tree-each) ; inline : tree-each-with ( obj vector quot -- ) swap [ with ] tree-each 2drop ; inline diff --git a/native/sbuf.c b/native/sbuf.c index bd6e3b05f3..5bcf2ff435 100644 --- a/native/sbuf.c +++ b/native/sbuf.c @@ -47,7 +47,7 @@ void primitive_sbuf_nth(void) if(index < 0 || index >= sbuf->top) range_error(tag_object(sbuf),0,tag_fixnum(index),sbuf->top); - dpush(string_nth(untag_string(sbuf->string),index)); + dpush(tag_fixnum(string_nth(untag_string(sbuf->string),index))); } void sbuf_ensure_capacity(F_SBUF* sbuf, F_FIXNUM top)