From 6c11b788e04a37c08c41dca1e30a0901acbc94f2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 20 Apr 2005 00:28:01 +0000 Subject: [PATCH] minor cleanups here and there --- TODO.FACTOR.txt | 4 +- library/bootstrap/boot-stage1.factor | 6 +-- library/bootstrap/boot-stage2.factor | 2 +- library/bootstrap/boot-stage3.factor | 5 +- library/bootstrap/image.factor | 2 +- library/cli.factor | 6 +-- library/collections/lists.factor | 16 +----- library/collections/sbuf.factor | 35 +++++-------- library/collections/sequences-epilogue.factor | 8 ++- library/collections/sequences.factor | 4 -- library/collections/strings.factor | 43 +++++++--------- library/collections/vectors-epilogue.factor | 14 +---- library/httpd/browser-responder.factor | 4 +- library/httpd/cont-responder.factor | 9 +--- library/httpd/html.factor | 12 +++-- library/httpd/http-common.factor | 44 ++-------------- library/httpd/responder.factor | 43 ++-------------- library/httpd/url-encoding.factor | 51 +++++-------------- library/inference/branches.factor | 19 ++++--- library/inference/inference.factor | 9 ++-- library/io/stdio.factor | 4 +- library/io/stream.factor | 30 ++++------- library/math/matrices.factor | 8 --- library/syntax/parse-syntax.factor | 2 +- library/syntax/prettyprint.factor | 2 +- library/syntax/unparser.factor | 2 +- library/test/sbuf.factor | 4 +- library/test/strings.factor | 6 +-- library/test/vectors.factor | 8 +-- library/tools/debugger.factor | 6 +-- library/tools/dump.factor | 32 ++++-------- library/ui/text.factor | 6 +-- library/unix/io.factor | 6 +-- 33 files changed, 137 insertions(+), 315 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index fdc7cb9688..7d5edba23b 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -26,7 +26,8 @@ + ffi: -- auto-generate box/unbox, and alien accessors +- if a boxer triggers GC, already-pushed addresses might become + invalid! - box/unbox_signed/unsigned_8 - ffi unicode strings: null char security hole - utf16 string boxing @@ -76,7 +77,6 @@ - unions containing tuples do not work properly - need G: combinations - method doc strings -- make-image: use a list not a vector - code walker & exceptions - string sub-primitives - clean up metaclasses diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 06085bb362..75d90d3ad3 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -19,13 +19,13 @@ hashtables ; "/library/collections/sequences.factor" "/library/collections/arrays.factor" "/library/kernel.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/collections/cons.factor" + "/library/collections/assoc.factor" "/library/collections/lists.factor" "/library/collections/vectors.factor" "/library/collections/strings.factor" @@ -33,9 +33,9 @@ hashtables ; "/library/collections/vectors-epilogue.factor" "/library/collections/hashtables.factor" "/library/collections/namespaces.factor" + "/library/collections/sbuf.factor" "/library/words.factor" "/library/vocabularies.factor" - "/library/collections/sbuf.factor" "/library/errors.factor" "/library/continuations.factor" "/library/threads.factor" diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index 03b32a658f..29dd809999 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -23,7 +23,7 @@ t [ ! This has to be loaded here because it overloads sequence ! generics, and we don't want to compile twice. - "/library/math/matrices.factor" +! "/library/math/matrices.factor" "/library/tools/debugger.factor" "/library/tools/gensym.factor" diff --git a/library/bootstrap/boot-stage3.factor b/library/bootstrap/boot-stage3.factor index 60a4a42b60..2a70d332ff 100644 --- a/library/bootstrap/boot-stage3.factor +++ b/library/bootstrap/boot-stage3.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. -USING: assembler compiler kernel lists namespaces parser stdio -unparser ; +USING: assembler compiler kernel lists namespaces parser +sequences stdio unparser ; "Bootstrap stage 3..." print @@ -9,6 +9,7 @@ unparser ; init-assembler \ car compile \ = compile + \ length compile \ unparse compile \ scan compile ] when diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index a813bb8287..ee461b378d 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -179,7 +179,7 @@ M: f ' ( obj -- ptr ) : fixup-words ( -- ) image get [ dup word? [ fixup-word ] when - ] vector-map image set ; + ] seq-map image set ; M: word ' ( word -- pointer ) transfer-word dup pooled-object dup [ nip ] [ drop ] ifte ; diff --git a/library/cli.factor b/library/cli.factor index bf6dc7e03c..a2264fbff9 100644 --- a/library/cli.factor +++ b/library/cli.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2003, 2004 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: command-line -USING: files kernel lists namespaces parser strings -kernel-internals ; +USING: files kernel kernel-internals lists namespaces parser +sequences strings ; ! This file is run as the last stage of boot.factor; it relies ! on all other words already being defined. @@ -37,7 +37,7 @@ kernel-internals ; #! Handle a command-line argument. If the argument was #! consumed, returns f. Otherwise returns the argument. #! Parameters that start with + are runtime parameters. - dup f-or-"" [ + dup empty? [ "-" ?string-head [ cli-param f ] when dup [ "+" ?string-head [ drop f ] when ] when ] unless ; diff --git a/library/collections/lists.factor b/library/collections/lists.factor index 1618ce0637..6d7303721f 100644 --- a/library/collections/lists.factor +++ b/library/collections/lists.factor @@ -103,21 +103,7 @@ M: cons nth ( n list -- element ) : all=? ( list -- ? ) #! Check if all elements of a list are equal. - dup [ uncons [ over = ] all? nip ] [ drop t ] ifte ; - -: maximize ( pred o1 o2 -- o1/o2 ) - #! Return o1 if pred returns true, o2 otherwise. - [ rot call ] 2keep ? ; inline - -: (top) ( list maximizer -- elt ) - #! Return the highest element in the list, where maximizer - #! has stack effect ( o1 o2 -- max(o1,o2) ). - >r uncons r> each ; inline - -: top ( list pred -- elt ) - #! Return the highest element in the list, where pred is a - #! partial order with stack effect ( o1 o2 -- ? ). - swap [ pick >r maximize r> swap ] (top) nip ; inline + [ uncons [ = ] all-with? ] [ t ] ifte* ; M: cons = ( obj cons -- ? ) 2dup eq? [ diff --git a/library/collections/sbuf.factor b/library/collections/sbuf.factor index d4e640c01c..f896e85c33 100644 --- a/library/collections/sbuf.factor +++ b/library/collections/sbuf.factor @@ -8,29 +8,24 @@ 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 - #! repeated. - [ swap [ dup , ] times drop ] make-string ; +: >sbuf ( seq -- sbuf ) 0 [ swap nappend ] keep ; + +: >string ( seq -- string ) >sbuf sbuf>string ; + +: fill ( count char -- string ) >string ; : pad ( string count char -- string ) - >r over string-length - dup 0 <= [ + >r over length - dup 0 <= [ r> 2drop ] [ - r> fill swap cat2 + r> fill swap seq-append ] ifte ; -: string-map ( str code -- str ) - #! 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 >list r> map cat ; inline - : split-next ( index string split -- next ) 3dup index-of* dup -1 = [ >r drop string-tail , r> ( end of string ) ] [ - swap string-length dupd + >r swap substring , r> + swap length dupd + >r swap substring , r> ] ifte ; : (split) ( index string split -- ) @@ -46,10 +41,10 @@ M: sbuf set-nth set-sbuf-nth ; [ 0 -rot (split) ] make-list ; : split-n-advance substring , >r tuck + swap r> ; -: split-n-finish nip dup string-length swap substring , ; +: split-n-finish nip dup length swap substring , ; : (split-n) ( start n str -- ) - 3dup >r dupd + r> 2dup string-length < [ + 3dup >r dupd + r> 2dup length < [ split-n-advance (split-n) ] [ split-n-finish 3drop @@ -59,13 +54,7 @@ M: sbuf set-nth set-sbuf-nth ; #! Split a string into n-character chunks. [ 0 -rot (split-n) ] make-list ; -: ch>string ( ch -- str ) - 1 [ sbuf-append ] keep sbuf>string ; +: ch>string ( ch -- str ) 1 [ push ] keep sbuf>string ; -: >sbuf ( list -- vector ) 0 swap seq-append ; - -: string>sbuf ( str -- sbuf ) - dup string-length [ sbuf-append ] keep ; - -M: string unfreeze string>sbuf ; +M: string unfreeze >sbuf ; M: string freeze drop sbuf>string ; diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index efec368dde..7c8d7af00a 100644 --- a/library/collections/sequences-epilogue.factor +++ b/library/collections/sequences-epilogue.factor @@ -10,6 +10,12 @@ vectors ; ! defined tuples that respond to the sequence protocol. UNION: sequence array string sbuf vector ; +M: object ensure-capacity 2drop ; +M: object unfreeze clone ; +M: object freeze drop ; + +: empty? ( seq -- ? ) length 0 = ; + : (>list) ( n i seq -- list ) pick pick <= [ 3drop [ ] @@ -173,7 +179,7 @@ M: sequence = ( obj seq -- ? ) ] ifte ; ! A repeated sequence is the same element n times. -TUPLE: repeated object length ; +TUPLE: repeated length object ; M: repeated length repeated-length ; M: repeated nth nip repeated-object ; diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor index 9001b9939e..8d450106fe 100644 --- a/library/collections/sequences.factor +++ b/library/collections/sequences.factor @@ -19,7 +19,3 @@ GENERIC: set-nth ( value n sequence -- obj ) GENERIC: >list ( seq -- list ) GENERIC: unfreeze ( seq -- mutable-seq ) GENERIC: freeze ( new orig -- new ) - -M: object ensure-capacity 2drop ; -M: object unfreeze ; -M: object freeze drop ; diff --git a/library/collections/strings.factor b/library/collections/strings.factor index 8fb519658f..02c5cb778e 100644 --- a/library/collections/strings.factor +++ b/library/collections/strings.factor @@ -3,7 +3,7 @@ IN: strings USING: generic kernel kernel-internals lists math sequences ; -BUILTIN: string 12 [ 1 "string-length" f ] [ 2 hashcode f ] ; +BUILTIN: string 12 [ 1 length f ] [ 2 hashcode f ] ; M: string = string= ; BUILTIN: sbuf 13 ; @@ -11,20 +11,11 @@ M: sbuf = sbuf= ; UNION: text string integer ; -M: string length string-length ; M: string nth string-nth ; -: f-or-"" ( obj -- ? ) - dup not swap "" = or ; - -: string-length< ( str str -- boolean ) - #! Compare string lengths. - swap string-length swap string-length < ; - -: cat ( [ "a" "b" "c" ] -- "abc" ) - ! If f appears in the list, it is not appended to the - ! string. - 80 swap [ [ over sbuf-append ] when* ] each sbuf>string ; +: length< ( seq seq -- ? ) + #! Compare sequence lengths. + swap length swap length < ; : cat2 ( "a" "b" -- "ab" ) swap @@ -42,6 +33,9 @@ M: string nth string-nth ; : index-of ( string substring -- index ) 0 -rot index-of* ; +: string-contains? ( substr str -- ? ) + swap index-of -1 = not ; + : string> ( str1 str2 -- ? ) ! Returns if the first string lexicographically follows str2 string-compare 0 > ; @@ -51,13 +45,10 @@ M: string nth string-nth ; #! until the given index. 0 -rot substring ; -: string-contains? ( substr str -- ? ) - swap index-of -1 = not ; - : string-tail ( index str -- str ) #! Returns a new string, from the given index until the end #! of the string. - [ string-length ] keep substring ; + [ length ] keep substring ; : string/ ( str index -- str str ) #! Returns 2 strings, that when concatenated yield the @@ -71,29 +62,29 @@ M: string nth string-nth ; [ swap string-head ] 2keep 1 + swap string-tail ; : string-head? ( str begin -- ? ) - 2dup string-length< [ + 2dup length< [ 2drop f ] [ - dup string-length rot string-head = + dup length rot string-head = ] ifte ; : ?string-head ( str begin -- str ? ) 2dup string-head? [ - string-length swap string-tail t + length swap string-tail t ] [ drop f ] ifte ; : string-tail? ( str end -- ? ) - 2dup string-length< [ + 2dup length< [ 2drop f ] [ - dup string-length pick string-length swap - rot string-tail = + dup length pick length swap - rot string-tail = ] ifte ; -: ?string-tail ( str end -- ? ) +: ?string-tail ( str end -- str ? ) 2dup string-tail? [ - string-length swap [ string-length swap - ] keep string-head t + length swap [ length swap - ] keep string-head t ] [ drop f ] ifte ; @@ -102,7 +93,7 @@ M: string nth string-nth ; 2dup index-of dup -1 = [ 2drop f ] [ - [ swap string-length + over string-tail ] keep + [ swap length + over string-tail ] keep rot string-head swap ] ifte ; @@ -124,3 +115,5 @@ PREDICATE: integer printable CHAR: \s CHAR: ~ between? ; over LETTER? or over digit? or swap "/_?." string-contains? or ; + +: string-length ( deprecated ) length ; diff --git a/library/collections/vectors-epilogue.factor b/library/collections/vectors-epilogue.factor index c07b93feb0..fb7dd5ba50 100644 --- a/library/collections/vectors-epilogue.factor +++ b/library/collections/vectors-epilogue.factor @@ -5,19 +5,7 @@ math-internals sequences ; IN: vectors -: >vector ( list -- vector ) - dup length swap [ over push ] seq-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 >vector ; inline - -: vector-append ( v1 v2 -- vec ) - over length over length + - [ rot nappend ] keep - [ swap nappend ] keep ; +: >vector ( list -- vector ) 0 [ swap nappend ] keep ; : vector-project ( n quot -- vector ) #! Execute the quotation n times, passing the loop counter diff --git a/library/httpd/browser-responder.factor b/library/httpd/browser-responder.factor index b8ec18324a..23c8441257 100644 --- a/library/httpd/browser-responder.factor +++ b/library/httpd/browser-responder.factor @@ -69,9 +69,9 @@ errors unparser logging listener url-encoding hashtables memory ; : write-editable-word-source ( vocab word -- ) #! Write the source in a manner allowing it to be edited.
"Accept" button ; diff --git a/library/httpd/cont-responder.factor b/library/httpd/cont-responder.factor index 66e7c0d433..5b87a06861 100644 --- a/library/httpd/cont-responder.factor +++ b/library/httpd/cont-responder.factor @@ -199,11 +199,6 @@ SYMBOL: callback-cc store-callback-cc ] callcc0 ; -: with-string-stream ( quot -- string ) - #! Call the quotation with standard output bound to a string output - #! stream. Return the string on exit. - 1024 dup >r swap with-stream r> stream>str ; - : forward-to-url ( url -- ) #! When executed inside a 'show' call, this will force a #! HTTP 302 to occur to instruct the browser to forward to @@ -242,7 +237,7 @@ SYMBOL: callback-cc store-callback-cc redirect-to-here [ expirable register-continuation id>url swap - \ serving-html swons with-string-stream call-exit-continuation + \ serving-html swons with-string call-exit-continuation ] callcc1 nip ; @@ -254,7 +249,7 @@ SYMBOL: callback-cc #! use is an optimisation to save having to generate and save a continuation #! in that special case. store-callback-cc redirect-to-here - \ serving-html swons with-string-stream call-exit-continuation ; + \ serving-html swons with-string call-exit-continuation ; #! Name of variable for holding initial continuation id that starts #! the responder. diff --git a/library/httpd/html.factor b/library/httpd/html.factor index 2922cbaf0c..1c9c73b467 100644 --- a/library/httpd/html.factor +++ b/library/httpd/html.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: html -USING: lists kernel namespaces stdio streams strings unparser -url-encoding presentation generic ; +USING: generic kernel lists namespaces presentation sequences +stdio streams strings unparser url-encoding ; : html-entities ( -- alist ) [ @@ -18,10 +18,14 @@ url-encoding presentation generic ; : chars>entities ( str -- str ) #! Convert <, >, &, ' and " to HTML entities. - [ dup html-entities assoc dup rot ? ] string-map ; + [ + [ + dup html-entities assoc [ % ] [ , ] ?ifte + ] seq-each + ] make-string ; : >hex-color ( triplet -- hex ) - [ CHAR: # , [ >hex 2 "0" pad % ] each ] make-string ; + [ CHAR: # , [ >hex 2 CHAR: 0 pad % ] each ] make-string ; : fg-css, ( color -- ) "color: " , >hex-color , "; " , ; diff --git a/library/httpd/http-common.factor b/library/httpd/http-common.factor index 3e1cd1d588..a1f9891150 100644 --- a/library/httpd/http-common.factor +++ b/library/httpd/http-common.factor @@ -1,43 +1,7 @@ -! :folding=indent:collapseFolds=1: - -! $Id$ -! -! Copyright (C) 2003, 2004 Slava Pestov. -! Copyright (C) 2004 Chris Double. -! -! 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) 2003, 2005 Slava Pestov, Chris Double IN: httpd -USE: kernel -USE: lists -USE: logging -USE: namespaces -USE: parser -USE: stdio -USE: streams -USE: strings -USE: unparser - -USE: url-encoding +USING: kernel lists logging namespaces parser sequences stdio +strings url-encoding ; : print-header ( alist -- ) [ unswons write ": " write url-encode print ] each ; @@ -87,7 +51,7 @@ USE: url-encoding : (read-header) ( alist -- alist ) read-line dup - f-or-"" [ drop ] [ header-line (read-header) ] ifte ; + empty? [ drop ] [ header-line (read-header) ] ifte ; : read-header ( -- alist ) [ ] (read-header) ; diff --git a/library/httpd/responder.factor b/library/httpd/responder.factor index 68b840b671..5863371959 100644 --- a/library/httpd/responder.factor +++ b/library/httpd/responder.factor @@ -1,41 +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: httpd-responder - -USE: hashtables -USE: httpd -USE: kernel -USE: lists -USE: logging -USE: namespaces -USE: stdio -USE: streams -USE: strings +USING: hashtables httpd kernel logging namespaces sequences +strings ; ! Responders are called in a new namespace with these ! variables: @@ -82,7 +49,7 @@ USE: strings get-responder "default" "httpd-responders" get set-hash ; : responder-argument ( argument -- argument ) - dup f-or-"" [ drop "default-argument" get ] when ; + dup empty? [ drop "default-argument" get ] when ; : call-responder ( method argument responder -- ) [ responder-argument swap get call ] bind ; diff --git a/library/httpd/url-encoding.factor b/library/httpd/url-encoding.factor index aedb2b143f..79ee1b466a 100644 --- a/library/httpd/url-encoding.factor +++ b/library/httpd/url-encoding.factor @@ -1,46 +1,19 @@ -! :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: url-encoding -USE: errors -USE: kernel -USE: lists -USE: math -USE: namespaces -USE: parser -USE: strings -USE: unparser +USING: errors kernel math namespaces parser sequences strings +unparser ; : url-encode ( str -- str ) [ - dup url-quotable? [ - "%" swap >hex 2 "0" pad cat2 - ] unless - ] string-map ; + [ + dup url-quotable? [ + , + ] [ + CHAR: % , >hex 2 CHAR: 0 pad % + ] ifte + ] seq-each + ] make-string ; : catch-hex> ( str -- n ) #! Push f if string is not a valid hex literal. diff --git a/library/inference/branches.factor b/library/inference/branches.factor index 97d661c12f..4796d92097 100644 --- a/library/inference/branches.factor +++ b/library/inference/branches.factor @@ -5,15 +5,14 @@ USING: errors generic interpreter kernel lists math namespaces sequences strings vectors words hashtables prettyprint ; : longest-vector ( list -- length ) - [ vector-length ] map [ > ] top ; + 0 swap [ length max ] each ; : computed-value-vector ( n -- vector ) [ drop object ] vector-project ; : add-inputs ( count stack -- stack ) #! Add this many inputs to the given stack. - [ vector-length - computed-value-vector ] keep - vector-append ; + [ length - computed-value-vector ] keep seq-append ; : unify-lengths ( list -- list ) #! Pad all vectors to the same length. If one vector is @@ -38,7 +37,7 @@ sequences strings vectors words hashtables prettyprint ; : unify-stacks ( list -- stack ) #! Replace differing literals in stacks with unknown #! results. - unify-lengths vector-transpose [ unify-results ] vector-map ; + unify-lengths vector-transpose [ unify-results ] seq-map ; : balanced? ( list -- ? ) #! Check if a list of [[ instack outstack ]] pairs is @@ -83,17 +82,17 @@ SYMBOL: cloned dup clone [ swap cloned [ acons ] change ] keep ] ?ifte ; -: deep-clone-vector ( vector -- vector ) - #! Clone a vector of vectors. - [ deep-clone ] vector-map ; +: deep-clone-seq ( seq -- seq ) + #! Clone a sequence and each object it contains. + [ deep-clone ] seq-map ; : copy-inference ( -- ) #! We avoid cloning the same object more than once in order #! to preserve identity structure. cloned off - meta-r [ deep-clone-vector ] change - meta-d [ deep-clone-vector ] change - d-in [ deep-clone-vector ] change + meta-r [ deep-clone-seq ] change + meta-d [ deep-clone-seq ] change + d-in [ deep-clone-seq ] change dataflow-graph off ; : infer-branch ( value -- namespace ) diff --git a/library/inference/inference.factor b/library/inference/inference.factor index d735c3b328..2a7d00c715 100644 --- a/library/inference/inference.factor +++ b/library/inference/inference.factor @@ -104,14 +104,11 @@ M: computed literal-value ( value -- ) 2drop f ] ifte ; -: vector-prepend ( values stack -- stack ) - >r >vector r> vector-append ; - : ensure-d ( typelist -- ) dup meta-d get ensure-types - meta-d get required-inputs dup - meta-d [ vector-prepend ] change - d-in [ vector-prepend ] change ; + meta-d get required-inputs >vector dup + meta-d [ seq-append ] change + d-in [ seq-append ] change ; : (present-effect) ( vector -- list ) >list [ value-class ] map ; diff --git a/library/io/stdio.factor b/library/io/stdio.factor index a8a4b4e000..e5ba123e6f 100644 --- a/library/io/stdio.factor +++ b/library/io/stdio.factor @@ -25,9 +25,7 @@ SYMBOL: stdio : with-string ( quot -- str ) #! Execute a quotation, and push a string containing all #! text printed by the quotation. - 1024 [ - call stdio get stream>str - ] with-stream ; + 1024 [ call stdio get sbuf>string ] with-stream ; TUPLE: stdio-stream ; C: stdio-stream ( stream -- stream ) [ set-delegate ] keep ; diff --git a/library/io/stream.factor b/library/io/stream.factor index 36e81e1954..95bd75490e 100644 --- a/library/io/stream.factor +++ b/library/io/stream.factor @@ -3,7 +3,8 @@ IN: stdio DEFER: stdio IN: streams -USING: errors generic kernel lists math namespaces strings ; +USING: errors generic kernel lists math namespaces sequences +strings ; ! Stream protocol. GENERIC: stream-flush ( stream -- ) @@ -15,7 +16,7 @@ GENERIC: stream-close ( stream -- ) : stream-read1 ( stream -- char/f ) 1 swap stream-read - dup f-or-"" [ drop f ] [ 0 swap string-nth ] ifte ; + dup empty? [ drop f ] [ 0 swap string-nth ] ifte ; : stream-write ( string stream -- ) f swap stream-write-attr ; @@ -34,24 +35,11 @@ M: null-stream stream-read 2drop f ; M: null-stream stream-write-attr 3drop ; M: null-stream stream-close drop ; -! A stream that builds a string of all text written to it. -TUPLE: string-output buf ; - -M: string-output stream-write-attr ( string style stream -- ) - nip string-output-buf sbuf-append ; - -M: string-output stream-close ( stream -- ) drop ; -M: string-output stream-flush ( stream -- ) drop ; -M: string-output stream-auto-flush ( stream -- ) drop ; - -: stream>str ( stream -- string ) - #! Returns the string written to the given string output - #! stream. - string-output-buf sbuf>string ; - -C: string-output ( size -- stream ) - #! Creates a new stream for writing to a string buffer. - [ >r r> set-string-output-buf ] keep ; +! String buffers support the stream output protocol. +M: sbuf stream-write-attr nip sbuf-append ; +M: sbuf stream-close drop ; +M: sbuf stream-flush drop ; +M: sbuf stream-auto-flush drop ; ! Sometimes, we want to have a delegating stream that uses stdio ! words. @@ -112,4 +100,4 @@ SYMBOL: parser-stream : ( path alist -- alist ) #! For each element of the alist, change the value to #! path " " value - [ uncons >r over " " r> cat3 cons ] map nip ; + [ uncons >r swap " " r> seq-append3 cons ] map-with ; diff --git a/library/math/matrices.factor b/library/math/matrices.factor index c4f2184d30..24b9fd3fde 100644 --- a/library/math/matrices.factor +++ b/library/math/matrices.factor @@ -81,10 +81,6 @@ TUPLE: row index matrix ; M: row length row-matrix matrix-cols ; M: row nth ( n row -- ) >row< matrix-get ; -! These will be removed after seq-2each is fixed and v. is redone -M: row set-nth ( value n row -- ) >row< matrix-set ; -M: row clone >vector ; - ! A sequence of rows. TUPLE: row-seq matrix ; M: row-seq length row-seq-matrix matrix-rows ; @@ -96,10 +92,6 @@ TUPLE: col index matrix ; M: col length col-matrix matrix-rows ; M: col nth ( n column -- ) >col< swapd matrix-get ; -! These will be removed after seq-2each is fixed and v. is redone -M: col set-nth ( value n column ) >col< matrix-set ; -M: col clone >vector ; - ! A sequence of columns. TUPLE: col-seq matrix ; M: col-seq length col-seq-matrix matrix-cols ; diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor index a5991f0c1e..dec20ea2c2 100644 --- a/library/syntax/parse-syntax.factor +++ b/library/syntax/parse-syntax.factor @@ -127,7 +127,7 @@ BUILTIN: f 9 ; : f f swons ; parsing : " parse-string swons ; parsing -: SBUF" skip-blank parse-string string>sbuf swons ; parsing +: SBUF" skip-blank parse-string >sbuf swons ; parsing ! Comments : ( diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index 59183875bb..39f77ec816 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -61,7 +61,7 @@ M: word prettyprint* ( indent word -- indent ) : indent ( indent -- ) #! Print the given number of spaces. - " " fill write ; + CHAR: \s fill write ; : prettyprint-newline ( indent -- ) "\n" write indent ; diff --git a/library/syntax/unparser.factor b/library/syntax/unparser.factor index e90fd4d736..4e98e6f15a 100644 --- a/library/syntax/unparser.factor +++ b/library/syntax/unparser.factor @@ -81,7 +81,7 @@ M: complex unparse ( num -- str ) ] assoc ; : ch>unicode-escape ( ch -- esc ) - >hex 4 "0" pad "\\u" swap cat2 ; + >hex 4 CHAR: 0 pad "\\u" swap cat2 ; : unparse-ch ( ch -- ch/str ) dup quotable? [ diff --git a/library/test/sbuf.factor b/library/test/sbuf.factor index 6ddb2ffdea..4a84345c4b 100644 --- a/library/test/sbuf.factor +++ b/library/test/sbuf.factor @@ -3,9 +3,9 @@ USING: kernel namespaces sequences strings test ; [ "Hello" ] [ 100 "buf" set - "Hello" "buf" get sbuf-append + "Hello" "buf" get nappend "buf" get sbuf-clone "buf-clone" set - "World" "buf-clone" get sbuf-append + "World" "buf-clone" get nappend "buf" get sbuf>string ] unit-test diff --git a/library/test/strings.factor b/library/test/strings.factor index f99b6f4750..53dde39d36 100644 --- a/library/test/strings.factor +++ b/library/test/strings.factor @@ -8,10 +8,6 @@ USE: namespaces USE: strings USE: test -[ f ] [ "A string." f-or-"" ] unit-test -[ t ] [ "" f-or-"" ] unit-test -[ t ] [ f f-or-"" ] unit-test - [ "abc" ] [ [ "a" "b" "c" ] cat ] unit-test [ "abc" ] [ "ab" "c" cat2 ] unit-test @@ -90,7 +86,7 @@ unit-test [ "Replacing+spaces+with+plus" ] [ "Replacing spaces with plus" - [ dup CHAR: \s = [ drop CHAR: + ] when ] string-map + [ dup CHAR: \s = [ drop CHAR: + ] when ] seq-map ] unit-test diff --git a/library/test/vectors.factor b/library/test/vectors.factor index 215966f621..e89ab51667 100644 --- a/library/test/vectors.factor +++ b/library/test/vectors.factor @@ -25,7 +25,7 @@ sequences strings test vectors ; [ { 1 2 } ] [ [ 1 2 ] >vector ] unit-test [ t ] [ - 100 empty-vector [ drop 0 100 random-int ] vector-map + 100 empty-vector [ drop 0 100 random-int ] seq-map dup >list >vector = ] unit-test @@ -37,7 +37,7 @@ sequences strings test vectors ; [ [ 1 4 9 16 ] ] [ [ 1 2 3 4 ] - >vector [ dup * ] vector-map >list + >vector [ dup * ] seq-map >list ] unit-test [ t ] [ { } hashcode { } hashcode = ] unit-test @@ -45,8 +45,8 @@ sequences strings test vectors ; [ t ] [ { 1 { 2 } 3 } hashcode { 1 { 2 } 3 } hashcode = ] unit-test [ t ] [ { } hashcode { } hashcode = ] unit-test -[ { 1 2 3 4 5 6 } ] -[ { 1 2 3 } { 4 5 6 } vector-append ] unit-test +[ { 1 2 3 } { 1 2 3 4 5 6 } ] +[ { 1 2 3 } dup { 4 5 6 } seq-append ] unit-test [ { "" "a" "aa" "aaa" } ] [ 4 [ CHAR: a fill ] vector-project ] diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index 29b6fafc60..be2ab307c5 100644 --- a/library/tools/debugger.factor +++ b/library/tools/debugger.factor @@ -95,14 +95,14 @@ M: no-method error. ( error -- ) : parse-dump ( error -- ) [ - "Parsing " , - dup parse-error-file [ "" ] unless* , ":" , + "Parsing " % + dup parse-error-file [ "" ] unless* % ":" % dup parse-error-line [ 1 ] unless* unparse , ] make-string print dup parse-error-text dup string? [ print ] [ drop ] ifte - [ parse-error-col " " fill , "^" , ] make-string print ; + [ parse-error-col CHAR: \s fill % "^" % ] make-string print ; M: parse-error error. ( error -- ) dup parse-dump delegate error. ; diff --git a/library/tools/dump.factor b/library/tools/dump.factor index c10735ebbd..b570914ebb 100644 --- a/library/tools/dump.factor +++ b/library/tools/dump.factor @@ -1,40 +1,30 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: dump -USING: alien assembler generic kernel kernel-internals math -memory sequences stdio strings unparser ; +USING: alien assembler generic kernel kernel-internals lists +math memory sequences stdio strings unparser ; : cell. >hex cell 2 * CHAR: 0 pad write ; -TUPLE: integer-slot-seq object ; - -M: integer-slot-seq length - integer-slot-seq-object size cell / ; - -M: integer-slot-seq nth - integer-slot-seq-object swap >fixnum integer-slot ; - : slot@ ( address n -- n ) cell * swap 7 bitnot bitand + ; : dump-line ( address n value -- ) >r slot@ cell. ": " write r> cell. terpri ; -: (dump) ( address sequence -- ) - 0 swap [ 2dup dump-line 1 + ] seq-each 2drop ; +: (dump) ( address list -- ) + 0 swap [ >r 2dup r> dump-line 1 + ] each 2drop ; -TUPLE: alien-seq alien length ; - -M: alien-seq length - alien-seq-length ; - -M: alien-seq nth - alien-seq-alien swap cell * alien-unsigned-4 ; +: integer-slots ( obj -- list ) + dup size cell / [ integer-slot ] project-with ; : dump ( obj -- ) #! Dump an object's memory. - dup address (dump) ; + dup address swap integer-slots (dump) ; + +: alien-slots ( address length -- list ) + cell / [ cell * alien-unsigned-4 ] project-with ; : dump* ( alien len -- ) #! Dump an alien's memory. dup string? [ c-size ] when - >r [ alien-address ] keep r> (dump) ; + >r [ alien-address ] keep r> alien-slots (dump) ; diff --git a/library/ui/text.factor b/library/ui/text.factor index f295fd333a..fa3254c0bf 100644 --- a/library/ui/text.factor +++ b/library/ui/text.factor @@ -1,8 +1,8 @@ ! Strings are shapes too. This is somewhat of a hack and strings ! do not have x/y co-ordinates. IN: gadgets -USING: alien hashtables kernel lists namespaces sdl streams -strings ; +USING: alien hashtables kernel lists namespaces sdl sequences +streams strings ; SYMBOL: fonts @@ -52,7 +52,7 @@ global [ : filter-nulls ( str -- str ) "\0" over string-contains? [ - [ dup CHAR: \0 = [ drop CHAR: \s ] when ] string-map + [ dup CHAR: \0 = [ drop CHAR: \s ] when ] seq-map ] when ; : size-string ( font text -- w h ) diff --git a/library/unix/io.factor b/library/unix/io.factor index 61a17e22e9..b99278ef8b 100644 --- a/library/unix/io.factor +++ b/library/unix/io.factor @@ -140,7 +140,7 @@ M: reader stream-close ( stream -- ) port-handle close ; dup buffer-pop dup CHAR: \n = [ 3drop t ] [ - pick sbuf-append read-line-loop + pick push read-line-loop ] ifte ] ifte ; @@ -205,9 +205,9 @@ M: reader stream-readln ( stream -- line ) : read-count-step ( count reader -- ? ) dup reader-line -rot >r over length - r> 2dup buffer-fill <= [ - buffer> swap sbuf-append t + buffer> swap nappend t ] [ - buffer>> nip swap sbuf-append f + buffer>> nip swap nappend f ] ifte ; : can-read-count? ( count reader -- ? )