steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

sequence protocol

cvs
Slava Pestov 2005-04-02 07:39:33 +00:00
parent d57b44b4eb
commit f39394d25e
38 changed files with 206 additions and 221 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
library/arrays.factor
View File

@ -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 ;

2
library/bootstrap/boot-stage1.factor
View File

@ -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"

11
library/bootstrap/image.factor
View File

@ -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 -- )
<file-writer> [ [ write-word ] vector-each ] with-stream ;
<file-writer> [ [ 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.

4
library/compiler/alien.factor
View File

@ -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

6
library/compiler/generator.factor
View File

@ -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 -- )

41
library/compiler/optimizer.factor
View File

@ -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

1
library/compiler/x86/assembler.factor
View File

@ -34,6 +34,7 @@ USE: generic
USE: lists
USE: math
USE: errors
USE: sequences
! A postfix assembler.
!

2
library/generic/slots.factor
View File

@ -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:

29
library/generic/tuple.factor
View File

@ -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 [

4
library/hashtables.factor
View File

@ -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 <hashtable> swap

4
library/inference/branches.factor
View File

@ -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 <literal> ] map nip ;
: <dispatch-index> ( value -- value )

1
library/inference/dataflow.factor
View File

@ -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

6
library/inference/inference.factor
View File

@ -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 -- )

3
library/inference/types.factor
View File

@ -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

2
library/inference/words.factor
View File

@ -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

9
library/lists.factor
View File

@ -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 [

13
library/sbuf.factor
View File

@ -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> [ sbuf-append ] keep sbuf>string ;
: string>sbuf ( str -- sbuf )
dup string-length <sbuf> [ sbuf-append ] keep ;

41
library/sequences-epilogue.factor Normal file
View File

@ -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 ;

21
library/sequences.factor Normal file
View File

@ -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) ;

21
library/strings.factor
View File

@ -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? ;

41
library/syntax/parse-numbers.factor
View File

@ -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 )

12
library/syntax/parse-syntax.factor
View File

@ -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

9
library/syntax/prettyprint.factor
View File

@ -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 {.} ;

18
library/syntax/unparser.factor
View File

@ -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 "#<unnamed>" ? ;
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 "#<unnamed>" ? ;
M: t unparse drop "t" ;
M: f unparse drop "f" ;

2
library/test/sbuf.factor
View File

@ -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

4
library/test/strings.factor
View File

@ -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" ]

4
library/test/test.factor
View File

@ -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 ;

2
library/test/unparser.factor
View File

@ -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

4
library/test/vectors.factor
View File

@ -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

6
library/tools/memory.factor
View File

@ -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 = [

6
library/ui/editors.factor
View File

@ -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 )

6
library/ui/inspector.factor
View File

@ -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 <pile> swap [ <presentation> over add-gadget ] each ;
@ -51,10 +51,10 @@ M: list custom-sheet ( list -- gadget )
[ length count ] keep zip alist>sheet "Elements:" <titled> ;
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:" <titled> ;

2
library/ui/piles.factor
View File

@ -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 ;

2
library/ui/shelves.factor
View File

@ -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 ;

59
library/vectors.factor
View File

@ -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
#! <vector>, 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 <vector> 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 + <vector>
@ -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

6
library/vocabularies.factor
View File

@ -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 ;

4
library/words.factor
View File

@ -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

2
native/sbuf.c
View File

@ -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)