From 94c1a8bcd76daafc85f65817f84c7d21ba9fba98 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 16 Apr 2005 04:23:27 +0000 Subject: [PATCH] sequence cleanups --- TODO.FACTOR.txt | 10 +- library/alien/aliens.factor | 2 +- library/alien/structs.factor | 5 +- library/bootstrap/boot-stage1.factor | 26 ++--- library/bootstrap/init.factor | 38 +------ library/cli.factor | 2 +- library/{ => collections}/arrays.factor | 0 library/{ => collections}/assoc.factor | 0 library/{ => collections}/cons.factor | 0 library/{ => collections}/hashtables.factor | 0 library/{ => collections}/lists.factor | 0 library/{ => collections}/namespaces.factor | 101 +++++++----------- library/{ => collections}/sbuf.factor | 0 .../sequences-epilogue.factor | 11 +- library/{ => collections}/sequences.factor | 0 library/{ => collections}/strings.factor | 0 .../{ => collections}/vectors-epilogue.factor | 0 library/{ => collections}/vectors.factor | 0 library/compiler/xt.factor | 19 ++-- library/generic/predicate.factor | 4 +- library/generic/union.factor | 2 +- library/httpd/browser-responder.factor | 8 +- library/httpd/html-tags.factor | 2 +- library/inference/branches.factor | 2 +- library/inference/dataflow.factor | 2 +- library/inference/words.factor | 4 +- library/math/matrices.factor | 2 +- library/syntax/parse-syntax.factor | 6 +- library/syntax/see.factor | 2 +- library/test/lists/namespaces.factor | 3 + library/test/test.factor | 16 ++- library/test/vectors.factor | 10 +- library/vocabularies.factor | 2 +- 33 files changed, 124 insertions(+), 155 deletions(-) rename library/{ => collections}/arrays.factor (100%) rename library/{ => collections}/assoc.factor (100%) rename library/{ => collections}/cons.factor (100%) rename library/{ => collections}/hashtables.factor (100%) rename library/{ => collections}/lists.factor (100%) rename library/{ => collections}/namespaces.factor (64%) rename library/{ => collections}/sbuf.factor (100%) rename library/{ => collections}/sequences-epilogue.factor (93%) rename library/{ => collections}/sequences.factor (100%) rename library/{ => collections}/strings.factor (100%) rename library/{ => collections}/vectors-epilogue.factor (100%) rename library/{ => collections}/vectors.factor (100%) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 6226f2d1f6..620a10af6c 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -6,7 +6,6 @@ - add a socket timeout - unix ffi i/o - powerpc has weird callstack residue -- make-vector and make-string should not need a reverse step - console with presentations + plugin: @@ -35,7 +34,8 @@ - out parameters - bitfields in C structs - SDL_Rect** type -- struct membres that are not * +- setting struct members that are not * +- char[14], etc members -- generalize char255 - FFI float types + compiler: @@ -57,22 +57,22 @@ + sequences +- generic ensure-capacity - dipping seq-2nmap, seq-2each - remove seq- prefixes -- seq-append --> nappend - generic each some? all? member? memq? all=? top index? subseq? - index and index* are very slow with lists - list map, subset, project, append: not tail recursive -- : , sequence get push ; : % sequence get nappend ; - phase out sbuf-append - decide what to do with index-of - GENERIC: map - list impl same as now - sequence impl: clone sequence and call nmap - string impl: string>sbuf nmap sbuf>string -- GENERIC: append +- GENERIC: append, append3, append* - list>vector --> >vector +- move >list to lists + kernel: diff --git a/library/alien/aliens.factor b/library/alien/aliens.factor index e21f4cb8e4..bbb29b2f0f 100644 --- a/library/alien/aliens.factor +++ b/library/alien/aliens.factor @@ -49,7 +49,7 @@ M: alien = ( obj obj -- ? ) [ "abi" set "name" set - ] extend put + ] extend swap set ] bind ; : library-abi ( library -- abi ) diff --git a/library/alien/structs.factor b/library/alien/structs.factor index a34d373903..64f4354af4 100644 --- a/library/alien/structs.factor +++ b/library/alien/structs.factor @@ -54,7 +54,10 @@ math namespaces parser strings words ; dup struct-constructor dup array-constructor dup define-nth - [ "width" set ] "struct-name" get define-c-type + [ + "width" set + [ swap ] "getter" set + ] "struct-name" get define-c-type "void*" c-type "struct-name" get "*" cat2 c-types get set-hash ; diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 7676f34944..06085bb362 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -8,7 +8,7 @@ hashtables ; "/library/bootstrap/primitives.factor" run-resource -: pull-in ( list -- ) [ dup print parse-resource append, ] each ; +: pull-in ( list -- ) [ dup print parse-resource % ] each ; ! The make-list form creates a boot quotation [ @@ -16,26 +16,26 @@ hashtables ; "/version.factor" "/library/stack.factor" "/library/combinators.factor" - "/library/sequences.factor" - "/library/arrays.factor" + "/library/collections/sequences.factor" + "/library/collections/arrays.factor" "/library/kernel.factor" - "/library/cons.factor" - "/library/assoc.factor" + "/library/collections/cons.factor" + "/library/collections/assoc.factor" "/library/math/math.factor" "/library/math/integer.factor" "/library/math/ratio.factor" "/library/math/float.factor" "/library/math/complex.factor" - "/library/lists.factor" - "/library/vectors.factor" - "/library/strings.factor" - "/library/sequences-epilogue.factor" - "/library/vectors-epilogue.factor" - "/library/hashtables.factor" - "/library/namespaces.factor" + "/library/collections/lists.factor" + "/library/collections/vectors.factor" + "/library/collections/strings.factor" + "/library/collections/sequences-epilogue.factor" + "/library/collections/vectors-epilogue.factor" + "/library/collections/hashtables.factor" + "/library/collections/namespaces.factor" "/library/words.factor" "/library/vocabularies.factor" - "/library/sbuf.factor" + "/library/collections/sbuf.factor" "/library/errors.factor" "/library/continuations.factor" "/library/threads.factor" diff --git a/library/bootstrap/init.factor b/library/bootstrap/init.factor index bc0854d8aa..6fb130aed9 100644 --- a/library/bootstrap/init.factor +++ b/library/bootstrap/init.factor @@ -1,41 +1,11 @@ -! :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: kernel -USE: namespaces -USE: parser -USE: stdio -USE: streams -USE: threads -USE: words +USING: namespaces parser stdio streams threads words ; : boot ( -- ) #! Initialize an interpreter with the basic services. - init-namespaces + global >n init-threads init-stdio "HOME" os-env [ "." ] unless* "~" set diff --git a/library/cli.factor b/library/cli.factor index 6e25c609f7..bf6dc7e03c 100644 --- a/library/cli.factor +++ b/library/cli.factor @@ -22,7 +22,7 @@ kernel-internals ; : cli-var-param ( name value -- ) swap ":" split set-path ; -: cli-bool-param ( name -- ) "no-" ?string-head not put ; +: cli-bool-param ( name -- ) "no-" ?string-head not swap set ; : cli-param ( param -- ) #! Handle a command-line argument starting with '-' by diff --git a/library/arrays.factor b/library/collections/arrays.factor similarity index 100% rename from library/arrays.factor rename to library/collections/arrays.factor diff --git a/library/assoc.factor b/library/collections/assoc.factor similarity index 100% rename from library/assoc.factor rename to library/collections/assoc.factor diff --git a/library/cons.factor b/library/collections/cons.factor similarity index 100% rename from library/cons.factor rename to library/collections/cons.factor diff --git a/library/hashtables.factor b/library/collections/hashtables.factor similarity index 100% rename from library/hashtables.factor rename to library/collections/hashtables.factor diff --git a/library/lists.factor b/library/collections/lists.factor similarity index 100% rename from library/lists.factor rename to library/collections/lists.factor diff --git a/library/namespaces.factor b/library/collections/namespaces.factor similarity index 64% rename from library/namespaces.factor rename to library/collections/namespaces.factor index 03f0fea4dc..66559b63d1 100644 --- a/library/namespaces.factor +++ b/library/collections/namespaces.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2003, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: namespaces -USING: hashtables kernel kernel-internals lists math +USING: hashtables kernel kernel-internals lists math sequences strings vectors ; ! Other languages have classes, objects, variables, etc. @@ -26,6 +26,7 @@ strings vectors ; ! namespace pushed on the namespace stack. : namestack ( -- ns ) 3 getenv ; inline + : set-namestack ( ns -- ) 3 setenv ; inline : namespace ( -- namespace ) @@ -33,18 +34,14 @@ strings vectors ; namestack car ; : >n ( namespace -- n:namespace ) - #! Push a namespace on the namespace stack. + #! Push a namespace on the name stack. namestack cons set-namestack ; inline : n> ( n:namespace -- namespace ) - #! Pop the top of the namespace stack. + #! Pop the top of the name stack. namestack uncons set-namestack ; inline : global ( -- g ) 4 getenv ; -: set-global ( g -- ) 4 setenv ; - -: init-namespaces ( -- ) - global >n ; : ( -- n ) #! Create a new namespace. @@ -68,7 +65,10 @@ strings vectors ; namestack (get) ; : set ( value variable -- ) namespace set-hash ; -: put ( variable value -- ) swap set ; + +: on ( var -- ) t swap set ; + +: off ( var -- ) f swap set ; : nest ( variable -- hash ) #! If the variable is set in the current namespace, return @@ -90,7 +90,7 @@ strings vectors ; #! namestack. >n call n> drop ; inline -: extend ( object code -- object ) +: extend ( namespace code -- namespace ) #! Used in code like this: #! : #! [ @@ -98,67 +98,46 @@ strings vectors ; #! ] extend ; over >r bind r> ; inline -: on ( var -- ) t put ; -: off ( var -- ) f put ; -: inc ( var -- ) [ 1 + ] change ; -: dec ( var -- ) [ 1 - ] change ; +! Building sequences +SYMBOL: sequence -: cons@ ( x var -- ) - #! Prepend x to the list stored in var. - [ cons ] change ; - -: unique@ ( elem var -- ) - #! Prepend an element to the proper list stored in a - #! variable if it is not already contained in the list. - [ unique ] change ; - -SYMBOL: list-buffer - -: make-rlist ( quot -- list ) - #! Call a quotation. The quotation can call , to prepend - #! objects to the list that is returned when the quotation - #! is done. - [ list-buffer off call list-buffer get ] with-scope ; - inline - -: make-list ( quot -- list ) - #! Return a list whose entries are in the same order that , - #! was called. - make-rlist reverse ; inline - -: make-string ( quot -- string ) - #! Call a quotation. The quotation can call , to prepend - #! objects to the list that is returned when the quotation - #! is done. - make-list cat ; inline - -: make-rstring ( quot -- string ) - #! Return a string whose entries are in the same order that , - #! was called. - make-rlist cat ; inline - -: make-vector ( quot -- list ) - #! Return a vector whose entries are in the same order that - #! , was called. - make-list list>vector ; inline +: make-seq ( quot sequence -- sequence ) + #! Call , and % from the quotation to append to a sequence. + [ sequence set call sequence get ] with-scope ; inline : , ( obj -- ) - #! Append an object to the currently constructing list. - list-buffer cons@ ; - -: unique, ( obj -- ) - #! Append an object to the currently constructing list, only - #! if the object does not already occur in the list. - list-buffer unique@ ; - -: append, ( list -- ) - [ , ] each ; + #! Add to the sequence being built with make-seq. + sequence get dup sbuf? [ sbuf-append ] [ push ] ifte ; : literal, ( word -- ) #! Append some code that pushes the word on the stack. Used #! when building quotations. unit , \ car , ; +: unique, ( obj -- ) + #! Add the object to the sequence being built with make-seq + #! unless an equal object has already been added. + sequence get 2dup index -1 = [ push ] [ 2drop ] ifte ; + +: % ( seq -- ) + #! Append to the sequence being built with make-seq. + sequence get swap nappend ; + +: make-vector ( quot -- vector ) + 100 make-seq ; inline + +: make-list ( quot -- list ) + make-vector >list ; inline + +: make-sbuf ( quot -- sbuf ) + 100 make-seq ; inline + +: make-string ( quot -- string ) + make-sbuf sbuf>string ; inline + +: make-rstring ( quot -- string ) + make-sbuf dup nreverse sbuf>string ; inline + ! Building hashtables, and computing a transitive closure. SYMBOL: hash-buffer diff --git a/library/sbuf.factor b/library/collections/sbuf.factor similarity index 100% rename from library/sbuf.factor rename to library/collections/sbuf.factor diff --git a/library/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor similarity index 93% rename from library/sequences-epilogue.factor rename to library/collections/sequences-epilogue.factor index 4c9a83c4ee..11bea94fd3 100644 --- a/library/sequences-epilogue.factor +++ b/library/collections/sequences-epilogue.factor @@ -96,10 +96,17 @@ M: sequence (tree-each) [ swap call ] seq-each-with ; : >pop> ( stack -- stack ) dup pop drop ; +: (exchange) ( seq i j -- seq[i] j seq ) + pick >r >r swap nth r> r> ; + +: exchange ( seq i j -- ) + #! Exchange seq[i] and seq[j]. + 3dup >r >r >r (exchange) r> r> r> + swap (exchange) set-nth set-nth ; + : (nreverse) ( seq i -- ) #! Swap seq[i] with seq[length-i-1]. - - ; + over length over - 1 - exchange ; : nreverse ( seq -- ) #! Destructively reverse seq. diff --git a/library/sequences.factor b/library/collections/sequences.factor similarity index 100% rename from library/sequences.factor rename to library/collections/sequences.factor diff --git a/library/strings.factor b/library/collections/strings.factor similarity index 100% rename from library/strings.factor rename to library/collections/strings.factor diff --git a/library/vectors-epilogue.factor b/library/collections/vectors-epilogue.factor similarity index 100% rename from library/vectors-epilogue.factor rename to library/collections/vectors-epilogue.factor diff --git a/library/vectors.factor b/library/collections/vectors.factor similarity index 100% rename from library/vectors.factor rename to library/collections/vectors.factor diff --git a/library/compiler/xt.factor b/library/compiler/xt.factor index 96c4c13020..888884870d 100644 --- a/library/compiler/xt.factor +++ b/library/compiler/xt.factor @@ -87,7 +87,9 @@ C: relative ( word -- ) [ just-compiled swap set-relative-where ] keep [ compiled-offset swap set-relative-to ] keep ; -: relative ( word -- ) deferred-xts cons@ ; +: deferred-xt deferred-xts [ cons ] change ; + +: relative ( word -- ) deferred-xt ; : relative-fixup ( relative -- addr ) dup relative-word compiled-xt swap relative-to - ; @@ -102,7 +104,7 @@ C: absolute ( word -- ) [ just-compiled swap set-absolute-where ] keep ; : absolute ( word -- ) - dup f rel-word deferred-xts cons@ ; + dup f rel-word deferred-xt ; : >absolute dup absolute-word compiled-xt swap absolute-where ; @@ -120,11 +122,11 @@ C: relative-bitfld ( word mask -- ) : relative-24 ( word -- ) BIN: 11111111111111111111111100 - deferred-xts cons@ ; + deferred-xt ; : relative-14 ( word -- ) BIN: 1111111111111100 - deferred-xts cons@ ; + deferred-xt ; : or-compiled ( n off -- ) [ compiled-cell bitor ] keep set-compiled-cell ; @@ -146,8 +148,7 @@ C: absolute-16/16 ( word -- ) M: absolute-16/16 fixup ( absolute -- ) >absolute fixup-16/16 ; -: absolute-16/16 ( word -- ) - deferred-xts cons@ ; +: absolute-16/16 ( word -- ) deferred-xt ; : compiling? ( word -- ? ) #! A word that is compiling or already compiled will not be @@ -169,4 +170,8 @@ M: absolute-16/16 fixup ( absolute -- ) >absolute fixup-16/16 ; [ call fixup-xts commit-xts ] with-scope ; : postpone-word ( word -- ) - dup compiling? [ drop ] [ compile-words unique@ ] ifte ; + dup compiling? [ + drop + ] [ + compile-words [ unique ] change + ] ifte ; diff --git a/library/generic/predicate.factor b/library/generic/predicate.factor index 50f973e2af..9a1da36b07 100644 --- a/library/generic/predicate.factor +++ b/library/generic/predicate.factor @@ -9,7 +9,7 @@ SYMBOL: predicate : predicate-dispatch ( existing definition class -- dispatch ) [ - \ dup , "predicate" word-prop append, , , \ ifte , + \ dup , "predicate" word-prop % , , \ ifte , ] make-list ; : predicate-method ( vtable definition class type# -- ) @@ -44,7 +44,7 @@ predicate [ : define-predicate ( class predicate definition -- ) pick over "definition" set-word-prop pick "superclass" word-prop "predicate" word-prop - [ \ dup , append, , [ drop f ] , \ ifte , ] make-list + [ \ dup , % , [ drop f ] , \ ifte , ] make-list define-compound predicate "metaclass" set-word-prop ; diff --git a/library/generic/union.factor b/library/generic/union.factor index 4560861035..244523b832 100644 --- a/library/generic/union.factor +++ b/library/generic/union.factor @@ -26,7 +26,7 @@ union [ 2drop t ] "class<" set-word-prop [ [ \ dup , - unswons "predicate" word-prop append, + unswons "predicate" word-prop % [ drop t ] , union-predicate , \ ifte , diff --git a/library/httpd/browser-responder.factor b/library/httpd/browser-responder.factor index a8252fb67c..b8ec18324a 100644 --- a/library/httpd/browser-responder.factor +++ b/library/httpd/browser-responder.factor @@ -78,7 +78,7 @@ errors unparser logging listener url-encoding hashtables memory ; : write-word-source ( vocab word -- ) #! Write the source for the given word from the vocab as HTML. [ - "allow-edit?" get [ "Edit" [ "edit-state" t put ] quot-href
] when + "allow-edit?" get [ "Edit" [ "edit-state" on ] quot-href
] when "edit-state" get [ write-editable-word-source ] [ @@ -131,10 +131,10 @@ errors unparser logging listener url-encoding hashtables memory ; #! Return a list of vocabularies that all words in a vocabulary #! uses. [ - "result" f put + "result" off words [ word-uses [ - "result" unique@ + "result" [ unique ] change ] each ] each "result" get @@ -202,7 +202,7 @@ errors unparser logging listener url-encoding hashtables memory ; ] show [ "allow-edit?" get [ "eval" get [ - "eval" f put + "eval" off "Editing has been disabled." show-message-page ] when ] unless diff --git a/library/httpd/html-tags.factor b/library/httpd/html-tags.factor index c21a16fdc7..f812037272 100644 --- a/library/httpd/html-tags.factor +++ b/library/httpd/html-tags.factor @@ -91,7 +91,7 @@ USE: words #! and sets it's value to the current value on the stack. #! If there is no previous attribute, no value is expected #! on the stack. - "current-attribute" get [ swons "attrs" cons@ ] when* ; + "current-attribute" get [ swons "attrs" [ cons ] change ] when* ; ! HTML tag words ! diff --git a/library/inference/branches.factor b/library/inference/branches.factor index 23bac41253..97d661c12f 100644 --- a/library/inference/branches.factor +++ b/library/inference/branches.factor @@ -156,7 +156,7 @@ SYMBOL: cloned over [ >r dupd cons - recursive-state cons@ + recursive-state [ cons ] change r> call ] (with-block) ; diff --git a/library/inference/dataflow.factor b/library/inference/dataflow.factor index 57b305d83f..101efdf33a 100644 --- a/library/inference/dataflow.factor +++ b/library/inference/dataflow.factor @@ -99,7 +99,7 @@ SYMBOL: node-param : dataflow, ( param op -- node ) #! Add a node to the dataflow IR. - dup dataflow-graph cons@ ; + dup dataflow-graph [ cons ] change ; : dataflow-drop, ( -- ) #! Remove the top stack element and add a dataflow node diff --git a/library/inference/words.factor b/library/inference/words.factor index 95b61a5a51..67f56764a5 100644 --- a/library/inference/words.factor +++ b/library/inference/words.factor @@ -119,10 +119,10 @@ M: compound apply-word ( word -- ) : with-recursion ( quot -- ) [ - inferring-base-case inc + inferring-base-case [ 1 + ] change call ] [ - inferring-base-case dec + inferring-base-case [ 1 - ] change rethrow ] catch ; diff --git a/library/math/matrices.factor b/library/math/matrices.factor index 3b1bf6c4fd..eee29b53d3 100644 --- a/library/math/matrices.factor +++ b/library/math/matrices.factor @@ -145,7 +145,7 @@ M: matrix v. ( m1 m2 -- m ) : ]M reverse [ dup car length swap length ] keep - [ [ append, ] each ] make-vector swons ; parsing + [ [ % ] each ] make-vector swons ; parsing : row-list ( matrix -- list ) #! A list of lists, where each sublist is a row of the diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor index f2ca81d36d..50f563a736 100644 --- a/library/syntax/parse-syntax.factor +++ b/library/syntax/parse-syntax.factor @@ -95,17 +95,17 @@ BUILTIN: f 9 ; : f f swons ; parsing : USE: #! Add vocabulary to search path. - scan "use" cons@ ; parsing + scan use+ ; parsing : USING: #! A list of vocabularies terminated with ; string-mode on - [ string-mode off [ "use" cons@ ] each ] + [ string-mode off [ use+ ] each ] f ; parsing : IN: #! Set vocabulary for new definitions. - scan dup "use" cons@ "in" set ; parsing + scan dup use+ "in" set ; parsing ! Char literal : CHAR: ( -- ) 0 scan next-char drop swons ; parsing diff --git a/library/syntax/see.factor b/library/syntax/see.factor index a11f23baa4..e58056fb0a 100644 --- a/library/syntax/see.factor +++ b/library/syntax/see.factor @@ -8,7 +8,7 @@ presentation stdio streams strings unparser words ; : vocab-actions ( search -- list ) [ [[ "Words" "words ." ]] - [[ "Use" "\"use\" cons@" ]] + [[ "Use" "use+" ]] [[ "In" "\"in\" set" ]] ] ; diff --git a/library/test/lists/namespaces.factor b/library/test/lists/namespaces.factor index 5318dc33ec..7da0851049 100644 --- a/library/test/lists/namespaces.factor +++ b/library/test/lists/namespaces.factor @@ -3,6 +3,9 @@ USE: lists USE: namespaces USE: test +: cons@ [ cons ] change ; +: unique@ [ unique ] change ; + [ [ 1 ] ] [ 1 f "x" set "x" cons@ "x" get ] unit-test [ [[ 1 2 ]] ] [ 1 2 "x" set "x" cons@ "x" get ] unit-test [ [ 1 2 ] ] [ 1 [ 2 ] "x" set "x" cons@ "x" get ] unit-test diff --git a/library/test/test.factor b/library/test/test.factor index 94f85b77cf..4b1f659115 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -41,14 +41,10 @@ prettyprint sequences stdio strings unparser vectors words ; SYMBOL: failures +: failure failures [ cons ] change ; + : test-handler ( name quot -- ? ) - [ - [ - dup error. cons failures cons@ f - ] [ - t - ] ifte* - ] catch ; + [ [ dup error. cons failure f ] [ t ] ifte* ] catch ; : test-path ( name -- path ) "/library/test/" swap ".factor" cat3 ; @@ -80,7 +76,7 @@ SYMBOL: failures "inference" "dataflow" "interpreter" "alien" "line-editor" "gadgets" "memory" "redefine" "annotate" - ] append, + ] % os "win32" = [ "buffer" , @@ -93,7 +89,7 @@ SYMBOL: failures "compiler/stack" "compiler/ifte" "compiler/generic" "compiler/bail-out" "compiler/linearizer" - ] append, + ] % ] unless [ @@ -102,7 +98,7 @@ SYMBOL: failures "benchmark/continuations" "benchmark/ack" "benchmark/hashtables" "benchmark/strings" "benchmark/vectors" - ] append, + ] % ] make-list ; : passed. diff --git a/library/test/vectors.factor b/library/test/vectors.factor index 078e03a5bf..4679cce77b 100644 --- a/library/test/vectors.factor +++ b/library/test/vectors.factor @@ -1,6 +1,6 @@ IN: temporary -USING: kernel kernel-internals math namespaces random sequences -strings test vectors ; +USING: kernel kernel-internals lists math namespaces random +sequences strings test vectors ; [ 3 ] [ [ t f t ] length ] unit-test [ 3 ] [ { t f t } length ] unit-test @@ -91,3 +91,9 @@ unit-test [ -1 ] [ 5 { } index ] unit-test [ 4 ] [ 5 { 1 2 3 4 5 } index ] unit-test + +[ { "c" "b" "a" } ] [ { "a" "b" "c" } clone dup 0 2 exchange ] unit-test + +[ t ] [ + 100 count dup list>vector dup nreverse >list >r reverse r> = +] unit-test diff --git a/library/vocabularies.factor b/library/vocabularies.factor index 655f151763..f4dbecbda2 100644 --- a/library/vocabularies.factor +++ b/library/vocabularies.factor @@ -21,7 +21,7 @@ SYMBOL: vocabularies vocab dup [ hash-values [ ] subset word-sort ] when ; : all-words ( -- list ) - [ vocabs [ words append, ] each ] make-list ; + [ vocabs [ words % ] each ] make-list ; : each-word ( quot -- ) #! Apply a quotation to each word in the image.