latest changes

Makefile

@@ -1,5 +1,5 @@
 CC = gcc
-DEFAULT_CFLAGS = -Wall -Os -fomit-frame-pointer $(SITE_CFLAGS)
+DEFAULT_CFLAGS = -Wall -g $(SITE_CFLAGS)
 DEFAULT_LIBS = -lm
 
 STRIP = strip

examples/timesheet.factor

@@ -1,16 +1,8 @@
 ! Contractor timesheet example
 
 IN: timesheet
-USE: errors
+USING: errors kernel lists math namespaces sequences stdio
-USE: kernel
+strings unparser vectors ;
-USE: lists
-USE: math
-USE: namespaces
-USE: parser
-USE: stdio
-USE: strings
-USE: unparser
-USE: vectors
 
 ! Adding a new entry to the time sheet.
 
@@ -26,7 +18,7 @@ USE: vectors
     read ;
 
 : add-entry ( timesheet -- )
-    add-entry-prompt cons swap vector-push ;
+    add-entry-prompt cons swap push ;
 
 ! Printing the timesheet.
 
@@ -34,6 +26,9 @@ USE: vectors
 : mm ( duration -- str ) 60 mod unparse 2 "0" pad ;
 : hh:mm ( millis -- str ) [ dup hh , ":" , mm , ] make-string ;
 
+: pad-string ( len str -- str )
+    length - " " fill ;
+
 : print-entry ( duration description -- )
     dup write
     60 swap pad-string write
@@ -41,7 +36,7 @@ USE: vectors
 
 : print-timesheet ( timesheet -- )
     "TIMESHEET:" print
-    [ uncons print-entry ] vector-each ;
+    [ uncons print-entry ] seq-each ;
 
 ! Displaying a menu
 

library/arrays.factor

@@ -25,3 +25,8 @@ BUILTIN: array 8 [ 1 length f ] ;
 
 M: array nth array-nth ;
 M: array set-nth set-array-nth ;
+
+: dispatch ( n vtable -- )
+    #! This word is unsafe since n is not bounds-checked. Do not
+    #! call it directly.
+    2 slot array-nth call ;

library/bootstrap/boot-stage1.factor

@@ -30,6 +30,7 @@ hashtables ;
         "/library/vectors.factor"
         "/library/strings.factor"
         "/library/sequences-epilogue.factor"
+        "/library/vectors-epilogue.factor"
         "/library/hashtables.factor"
         "/library/namespaces.factor"
         "/library/words.factor"

library/bootstrap/image.factor

@@ -25,9 +25,9 @@ SYMBOL: image
 ! Boot quotation, set by boot.factor
 SYMBOL: boot-quot
 
-: emit ( cell -- ) image get vector-push ;
+: emit ( cell -- ) image get push ;
 
-: fixup ( value offset -- ) image get set-vector-nth ;
+: fixup ( value offset -- ) image get set-nth ;
 
 ( Object memory )
 

library/compiler/xt.factor

@@ -2,13 +2,13 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler
 USING: assembler errors generic kernel lists math namespaces
-prettyprint strings vectors words ;
+prettyprint sequences strings vectors words ;
 
 ! To support saving compiled code to disk, generator words
 ! append relocation instructions to this vector.
 SYMBOL: relocation-table
 
-: rel, ( n -- ) relocation-table get vector-push ;
+: rel, ( n -- ) relocation-table get push ;
 
 : relocating compiled-offset cell - rel, ;
 

library/continuations.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: kernel USING: errors lists namespaces vectors ;
+IN: kernel USING: errors lists namespaces sequences ;
 
 : reify ( quot -- )
     >r datastack >pop> callstack >pop> namestack catchstack

library/sequences-epilogue.factor

@@ -39,3 +39,27 @@ M: sequence = ( obj seq -- ? )
             2drop f
         ] ifte
     ] ifte ;
+
+: push ( element sequence -- )
+    #! Push a value on the end of a sequence.
+    dup length swap set-nth ;
+
+: seq-append ( s1 s2 -- )
+    #! Destructively append s2 to s1.
+    [ over push ] seq-each drop ;
+
+: peek ( sequence -- element )
+    #! Get value at end of sequence.
+    dup length 1 - swap nth ;
+
+: pop ( sequence -- element )
+    #! Get value at end of sequence and remove it.
+    dup peek >r dup length 1 - swap set-length r> ;
+
+: >pop> ( stack -- stack ) dup pop drop ;
+
+IN: kernel
+
+: depth ( -- n )
+    #! Push the number of elements on the datastack.
+    datastack length ;

library/test/crashes.factor

@@ -2,7 +2,7 @@ IN: temporary
 
 ! Various things that broke CFactor at various times.
 USING: errors kernel lists math memory namespaces parser
-prettyprint strings test vectors words ;
+prettyprint sequences strings test vectors words ;
 
 "20 <sbuf> \"foo\" set" eval
 "garbage-collection" eval
@@ -13,7 +13,6 @@ prettyprint strings test vectors words ;
 ] keep-datastack
 
 10 <vector> "x" set
-[ -2 "x" get set-vector-length ] [ drop ] catch
 [ "x" get clone drop ] [ drop ] catch
 
 10 [ [ -1000000 <vector> ] [ drop ] catch ] times
@@ -47,7 +46,7 @@ prettyprint strings test vectors words ;
 
 ! Forgot to tag out of bounds index
 [ 1 { } vector-nth ] [ garbage-collection drop ] catch
-[ -1 { } set-vector-length ] [ garbage-collection drop ] catch
+[ -1 { } set-length ] [ garbage-collection drop ] catch
 [ 1 "" string-nth ] [ garbage-collection drop ] catch
 
 ! ... and again

library/test/inference.factor

@@ -30,7 +30,7 @@ namespaces parser sequences test vectors ;
 [ [ call ] infer old-effect ] unit-test-fails
 
 [ [[ 2 4 ]] ] [ [ 2dup ] infer old-effect ] unit-test
-[ [[ 2 0 ]] ] [ [ vector-push ] infer old-effect ] unit-test
+[ [[ 2 0 ]] ] [ [ push ] infer old-effect ] unit-test
 
 [ [[ 1 0 ]] ] [ [ [ ] [ ] ifte ] infer old-effect ] unit-test
 [ [ ifte ] infer old-effect ] unit-test-fails
@@ -148,7 +148,7 @@ SYMBOL: sym-test
 [ [[ 0 1 ]] ] [ [ sym-test ] infer old-effect ] unit-test
 
 
-[ [[ 2 0 ]] ] [ [ set-vector-length ] infer old-effect ] unit-test
+[ [[ 2 0 ]] ] [ [ set-length ] infer old-effect ] unit-test
 [ [[ 2 1 ]] ] [ [ 2list ] infer old-effect ] unit-test
 [ [[ 3 1 ]] ] [ [ 3list ] infer old-effect ] unit-test
 [ [[ 2 1 ]] ] [ [ append ] infer old-effect ] unit-test

library/test/vectors.factor

@@ -1,27 +1,20 @@
-USING: sequences ;
+IN: temporary
-USE: lists
+USING: kernel kernel-internals math namespaces random sequences
-USE: kernel
+strings test vectors ;
-USE: math
-USE: random
-USE: test
-USE: vectors
-USE: strings
-USE: namespaces
-USE: kernel-internals
 
-[ [ t f t ] vector-length ] unit-test-fails
+[ 3 ] [ [ t f t ] length ] unit-test
-[ 3 ] [ { t f t } vector-length ] unit-test
+[ 3 ] [ { t f t } length ] unit-test
 
-[ -3 { } vector-nth ] unit-test-fails
+[ -3 { } nth ] unit-test-fails
-[ 3 { } vector-nth ] unit-test-fails
+[ 3 { } nth ] unit-test-fails
-[ 3 #{ 1 2 }# vector-nth ] unit-test-fails
+[ 3 #{ 1 2 }# nth ] unit-test-fails
 
-[ "hey" [ 1 2 ] set-vector-length ] unit-test-fails
+[ "hey" [ 1 2 ] set-length ] unit-test-fails
-[ "hey" { 1 2 } set-vector-length ] unit-test-fails
+[ "hey" { 1 2 } set-length ] unit-test-fails
 
-[ 3 ] [ 3 0 <vector> [ set-vector-length ] keep vector-length ] unit-test
+[ 3 ] [ 3 0 <vector> [ set-length ] keep length ] unit-test
 [ "yo" ] [
-    "yo" 4 1 <vector> [ set-vector-nth ] keep 4 swap vector-nth
+    "yo" 4 1 <vector> [ set-nth ] keep 4 swap nth
 ] unit-test
 
 [ 5 list>vector ] unit-test-fails
@@ -65,15 +58,15 @@ unit-test
 
 0 <vector> "funny-stack" set
 
-[ ] [ { 1 5 } "funny-stack" get vector-push ] unit-test
+[ ] [ { 1 5 } "funny-stack" get push ] unit-test
-[ ] [ { 2 3 } "funny-stack" get vector-push ] unit-test
+[ ] [ { 2 3 } "funny-stack" get push ] unit-test
-[ { 2 3 } ] [ "funny-stack" get vector-pop ] unit-test
+[ { 2 3 } ] [ "funny-stack" get pop ] unit-test
-[ { 1 5 } ] [ "funny-stack" get vector-peek ] unit-test
+[ { 1 5 } ] [ "funny-stack" get peek ] unit-test
-[ { 1 5 } ] [ "funny-stack" get vector-pop ] unit-test
+[ { 1 5 } ] [ "funny-stack" get pop ] unit-test
-[ "funny-stack" get vector-pop ] unit-test-fails
+[ "funny-stack" get pop ] unit-test-fails
-[ "funny-stack" get vector-pop ] unit-test-fails
+[ "funny-stack" get pop ] unit-test-fails
-[ ] [ "funky" "funny-stack" get vector-push ] unit-test
+[ ] [ "funky" "funny-stack" get push ] unit-test
-[ "funky" ] [ "funny-stack" get vector-pop ] unit-test
+[ "funky" ] [ "funny-stack" get pop ] unit-test
 
 [ t ] [
     { 1 2 3 4 } dup vector-array length

library/tools/annotations.factor

@@ -6,7 +6,7 @@ IN: words
 ! or single-stepping. Note that currently, words referring to
 ! annotated words cannot be compiled; and annotating a word has
 ! no effect of compiled calls to that word.
-USING: interpreter kernel lists stdio strings test ;
+USING: interpreter kernel lists prettyprint stdio strings test ;
 
 : annotate ( word quot -- ) #! Quotation: ( word def -- def )
     over >r >r dup word-def r> call r> swap (define-compound) ;
@@ -24,6 +24,10 @@ USING: interpreter kernel lists stdio strings test ;
     #! Cause the word to start the code walker when executed.
     [ nip [ walk ] cons ] annotate ;
 
+: dump ( word -- )
+    #! Cause the word to print the stack when executed.
+    [ nip [ .s ] swap append ] annotate ;
+
 : timer ( word -- )
     #! Print the time taken to execute the word when it's called.
     [ nip [ time ] cons ] annotate ;

library/tools/interpreter.factor

@@ -1,21 +1,21 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: interpreter
-USING: errors kernel lists math namespaces prettyprint stdio
+USING: errors kernel lists math namespaces prettyprint sequences
-strings vectors words ;
+stdio strings vectors words ;
 
 ! A Factor interpreter written in Factor. Used by compiler for
 ! partial evaluation, also by the walker.
 
 ! Meta-stacks
 SYMBOL: meta-r
-: push-r meta-r get vector-push ;
+: push-r meta-r get push ;
-: pop-r meta-r get vector-pop ;
+: pop-r meta-r get pop ;
 SYMBOL: meta-d
-: push-d meta-d get vector-push ;
+: push-d meta-d get push ;
-: pop-d meta-d get vector-pop ;
+: pop-d meta-d get pop ;
-: peek-d meta-d get vector-peek ;
+: peek-d meta-d get peek ;
-: peek-next-d meta-d get [ vector-length 2 - ] keep vector-nth ;
+: peek-next-d meta-d get [ length 2 - ] keep nth ;
 SYMBOL: meta-n
 SYMBOL: meta-c
 
@@ -51,7 +51,7 @@ SYMBOL: meta-executing
     #! swap in the old stacks. This is so messy.
     push-d datastack push-d
     meta-d get set-datastack
-    >r execute datastack r> tuck vector-push
+    >r execute datastack r> tuck push
     set-datastack meta-d set ;
 
 : meta-call ( quot -- )

library/vectors.factor

@@ -1,32 +1,36 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: kernel-internals
-DEFER: (set-vector-length)
-DEFER: vector-array
-DEFER: set-vector-array
-
-IN: sequences
-DEFER: seq-each
-
-IN: vectors
 USING: errors generic kernel kernel-internals lists math
 math-internals sequences ;
 
-BUILTIN: vector 11
-    [ 1 "vector-length" (set-vector-length) ]
-    [ 2 vector-array set-vector-array ] ;
-
 IN: kernel-internals
+DEFER: set-vector-length
+DEFER: vector-array
+DEFER: set-vector-array
 
 : assert-positive ( fx -- )
     0 fixnum<
     [ "Vector index must be positive" throw ] when ; inline
 
-: assert-bounds ( fx vec -- )
+: assert-bounds ( fx seq -- )
     over assert-positive
-    vector-length fixnum>=
+    length fixnum>=
     [ "Vector index out of bounds" throw ] when ; inline
 
+IN: vectors
+
+BUILTIN: vector 11
+    [ 1 length set-vector-length ]
+    [ 2 vector-array set-vector-array ] ;
+
+: empty-vector ( len -- vec )
+    #! Creates a vector with 'len' elements set to f. Unlike
+    #! <vector>, which gives an empty vector with a certain
+    #! capacity.
+    dup <vector> [ set-length ] keep ;
+
+IN: kernel-internals
+
 : grow-capacity ( len vec -- )
     #! If the vector cannot accomodate len elements, resize it
     #! to exactly len.
@@ -36,107 +40,16 @@ IN: kernel-internals
     #! If n is beyond the vector's length, increase the length,
     #! growing the array if necessary, with an optimistic
     #! doubling of its size.
-    2dup vector-length fixnum>= [
+    2dup length fixnum>= [
         >r 1 fixnum+ r>
         2dup vector-array length fixnum> [
             over 2 fixnum* over grow-capacity
         ] when
-        (set-vector-length)
+        set-vector-length
     ] [
         2drop
     ] ifte ;
 
-: copy-array ( to from n -- )
-    [ 3dup swap array-nth pick rot set-array-nth ] repeat 2drop ;
-
-IN: vectors
-
-: vector-nth ( n vec -- obj )
-    >r >fixnum r> 2dup assert-bounds vector-array array-nth ;
-
-: set-vector-nth ( obj n vec -- )
-    >r >fixnum dup assert-positive r>
-    2dup ensure-capacity vector-array
-    set-array-nth ;
-
-: set-vector-length ( len vec -- )
-    >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
-    #! capacity.
-    dup <vector> dup >r set-vector-length r> ;
-
-: vector-push ( obj vector -- )
-    #! Push a value on the end of a vector.
-    dup vector-length swap set-vector-nth ;
-
-: vector-peek ( vector -- obj )
-    #! Get value at end of vector.
-    dup vector-length 1 - swap vector-nth ;
-
-: vector-pop ( vector -- obj )
-    #! Get value at end of vector and remove it.
-    dup vector-length 1 - ( vector top )
-    2dup swap vector-nth >r swap set-vector-length r> ;
-
-: >pop> ( stack -- stack )
-    dup vector-pop drop ;
-
-: vector-each ( vector quotation -- )
-    #! Execute the quotation with each element of the vector
-    #! pushed onto the stack.
-    >r >list r> each ; inline
-
-: list>vector ( list -- vector )
-    dup length <vector> swap [ over vector-push ] each ;
-
-: vector-map ( vector code -- vector )
-    #! Applies code to each element of the vector, return a new
-    #! vector with the results. The code must have stack effect
-    #! ( obj -- obj ).
-    >r >list r> map list>vector ; inline
-
-: vector-nappend ( v1 v2 -- )
-    #! Destructively append v2 to v1.
-    [ over vector-push ] seq-each drop ;
-
-: vector-append ( v1 v2 -- vec )
-    over vector-length over vector-length + <vector>
-    [ rot vector-nappend ] keep
-    [ swap vector-nappend ] keep ;
-
-: vector-project ( n quot -- vector )
-    #! Execute the quotation n times, passing the loop counter
-    #! the quotation as it ranges from 0..n-1. Collect results
-    #! in a new vector.
-    project list>vector ; inline
-
-M: vector clone ( vector -- vector )
-    dup vector-length dup empty-vector [
-        vector-array rot vector-array rot copy-array
-    ] keep ;
-
-: vector-tail ( n vector -- list )
-    #! Return a new list with all elements from the nth
-    #! index upwards.
-    2dup vector-length swap - [
-        pick + over vector-nth
-    ] project 2nip ;
-
-: vector-tail* ( n vector -- list )
-    #! Unlike vector-tail, n is an index from the end of the
-    #! vector. For example, if n=1, this returns a vector of
-    #! one element.
-    [ vector-length swap - ] keep vector-tail ;
-
 M: vector hashcode ( vec -- n )
     dup length 0 number= [
         drop 0
@@ -144,16 +57,28 @@ M: vector hashcode ( vec -- n )
         0 swap nth hashcode
     ] ifte ;
 
-! Find a better place for this
+M: vector set-length ( len vec -- )
-IN: kernel
+    >r >fixnum dup assert-positive r>
+    2dup grow-capacity set-vector-length ;
 
-: depth ( -- n )
+M: vector nth ( n vec -- obj )
-    #! Push the number of elements on the datastack.
+    >r >fixnum r> 2dup assert-bounds vector-array array-nth ;
-    datastack vector-length ;
 
-IN: kernel-internals
+M: vector set-nth ( obj n vec -- )
+    >r >fixnum dup assert-positive r>
+    2dup ensure-capacity vector-array
+    set-array-nth ;
 
-: dispatch ( n vtable -- )
+: copy-array ( to from n -- )
-    #! This word is unsafe since n is not bounds-checked. Do not
+    [ 3dup swap array-nth pick rot set-array-nth ] repeat 2drop ;
-    #! call it directly.
+
-    2 slot array-nth call ;
+M: vector clone ( vector -- vector )
+    dup length dup empty-vector [
+        vector-array rot vector-array rot copy-array
+    ] keep ;
+
+IN: vectors
+
+: vector-length ( deprecated ) length ;
+: vector-nth ( deprecated ) nth ;
+: set-vector-nth ( deprecated ) set-nth ;