From 26dd297e62d07b106d41a09f48d6c6e179b9e77d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 11 Nov 2004 20:15:43 +0000 Subject: [PATCH] make-string and make-list replace <> and [, ,] --- examples/factoroids.factor | 4 -- examples/infix.factor | 2 +- examples/mandel.factor | 4 +- examples/timesheet.factor | 2 +- library/ansi.factor | 8 +-- library/compiler/alien-types.factor | 2 +- library/compiler/compile-all.factor | 4 +- library/httpd/file-responder.factor | 4 +- library/httpd/html-tags.factor | 12 +++-- library/httpd/html.factor | 44 ++++++++-------- library/httpd/http-common.factor | 9 ++-- library/httpd/url-encoding.factor | 7 +-- library/init.factor | 2 +- library/jedit/jedit-remote.factor | 29 +++++------ library/list-namespaces.factor | 17 ++++--- library/platform/jvm/sbuf.factor | 4 +- library/platform/native/parse-syntax.factor | 7 +-- library/platform/native/prettyprint.factor | 2 +- library/platform/native/profiler.factor | 4 +- library/platform/native/unparser.factor | 56 +++++++++++++-------- library/prettyprint.factor | 14 +++--- library/random.factor | 4 +- library/sbuf.factor | 37 +++++--------- library/test/benchmark/sort.factor | 2 +- library/test/benchmark/strings.factor | 3 +- library/test/crashes.factor | 4 -- library/test/lists/namespaces.factor | 4 +- library/test/sbuf.factor | 9 ---- library/tools/debugger.factor | 11 ++-- library/tools/image.factor | 12 ++--- library/tools/listener.factor | 8 ++- library/vocabularies.factor | 8 ++- 32 files changed, 172 insertions(+), 167 deletions(-) diff --git a/examples/factoroids.factor b/examples/factoroids.factor index b2ca0ee43d..38d8c720cb 100644 --- a/examples/factoroids.factor +++ b/examples/factoroids.factor @@ -113,10 +113,6 @@ SYMBOL: enemy-shots ! The player's ship -! Flags that can be set to move the ship -SYMBOL: left -SYMBOL: right - TRAITS: ship M: ship draw ( actor -- ) [ diff --git a/examples/infix.factor b/examples/infix.factor index f3d71f3cad..3d955174ed 100644 --- a/examples/infix.factor +++ b/examples/infix.factor @@ -21,7 +21,7 @@ DEFER: infix : infix ( list -- quot ) #! Convert an infix expression (passed in as a list) to #! postfix. - [, 10 exprs set (infix) end ,] ; + [ 10 exprs set (infix) end ] make-list ; [ [ ] ] [ [ ] infix ] unit-test [ [ 1 ] ] [ [ 1 ] infix ] unit-test diff --git a/examples/mandel.factor b/examples/mandel.factor index 3bb2d5731f..3f19b7aa86 100644 --- a/examples/mandel.factor +++ b/examples/mandel.factor @@ -39,12 +39,12 @@ USE: test : val 0.85 ; : ( nb-cols -- map ) - [, + [ dup [ 360 * over succ / 360 / sat val hsv>rgb 1.0 scale-rgba , ] times* - ,] list>vector nip ; + ] make-list list>vector nip ; : absq >rect swap sq swap sq + ; diff --git a/examples/timesheet.factor b/examples/timesheet.factor index e3803a70c1..a27d835f0a 100644 --- a/examples/timesheet.factor +++ b/examples/timesheet.factor @@ -34,7 +34,7 @@ USE: vectors : hh ( duration -- str ) 60 /i ; : mm ( duration -- str ) 60 mod unparse 2 digits ; -: hh:mm ( millis -- str ) <% dup hh % ":" % mm % %> ; +: hh:mm ( millis -- str ) [ dup hh , ":" , mm , ] make-list ; : print-entry ( duration description -- ) dup write diff --git a/library/ansi.factor b/library/ansi.factor index 4032bb6d9e..4b47426d77 100644 --- a/library/ansi.factor +++ b/library/ansi.factor @@ -68,13 +68,13 @@ USE: strings "\e[4" swap "m" cat3 ; inline : ansi-attrs ( style -- ) - "bold" over assoc [ bold % ] when - "ansi-fg" over assoc [ fg % ] when* - "ansi-bg" over assoc [ bg % ] when* + "bold" over assoc [ bold , ] when + "ansi-fg" over assoc [ fg , ] when* + "ansi-bg" over assoc [ bg , ] when* drop ; : ansi-attr-string ( string style -- string ) - <% ansi-attrs % reset % %> ; + [ ansi-attrs , reset , ] make-string ; : ( stream -- stream ) #! Wraps the given stream in an ANSI stream. ANSI streams diff --git a/library/compiler/alien-types.factor b/library/compiler/alien-types.factor index dadf09dc60..37a3ceb34d 100644 --- a/library/compiler/alien-types.factor +++ b/library/compiler/alien-types.factor @@ -93,7 +93,7 @@ USE: words #! allocates a Factor heap-local instance of this structure. #! Used for C functions that expect you to pass in a struct. [ ] cons - <% "<" % "struct-name" get % ">" % %> + [ "<" , "struct-name" get , ">" , ] make-string "in" get create swap define-compound ; diff --git a/library/compiler/compile-all.factor b/library/compiler/compile-all.factor index e397683b9c..ea8feefbd9 100644 --- a/library/compiler/compile-all.factor +++ b/library/compiler/compile-all.factor @@ -111,7 +111,9 @@ SYMBOL: compilable-word-list : compilable-words ( -- list ) #! Make a list of all words that can be compiled. reset-can-compile - [, [ dup can-compile? [ , ] [ drop ] ifte ] each-word ,] + [ + [ dup can-compile? [ , ] [ drop ] ifte ] each-word + ] make-list reset-can-compile ; : cannot-compile ( word -- ) diff --git a/library/httpd/file-responder.factor b/library/httpd/file-responder.factor index 03f5883d0b..640e2d8f0b 100644 --- a/library/httpd/file-responder.factor +++ b/library/httpd/file-responder.factor @@ -47,10 +47,10 @@ USE: unparser f>"" "doc-root" get swap cat2 ; : file-response ( mime-type length -- ) - [, + [ unparse "Content-Length" swons , "Content-Type" swons , - ,] "200 OK" response terpri ; + ] make-list "200 OK" response terpri ; : serve-static ( filename mime-type -- ) over file-length file-response "method" get "head" = [ diff --git a/library/httpd/html-tags.factor b/library/httpd/html-tags.factor index f9f28e2ebd..1df7cfe991 100644 --- a/library/httpd/html-tags.factor +++ b/library/httpd/html-tags.factor @@ -69,7 +69,7 @@ USE: logic ! "click" write ! ! (url -- ) -! a> "click" write +! "click" write ! ! Tags that have no 'closing' equivalent have a trailing tag/> form: ! @@ -78,7 +78,9 @@ USE: logic : attrs>string ( alist -- string ) #! Convert the attrs alist to a string #! suitable for embedding in an html tag. - reverse <% [ dup car % "='" % cdr % "'" % ] each %> ; + reverse [ + [ dup car , "='" , cdr , "'" , ] each + ] make-string ; : write-attributes ( n: namespace -- ) #! With the attribute namespace on the stack, get the attributes @@ -163,13 +165,13 @@ USE: logic : def-for-html-word- ( name -- name quot ) #! Return the name and code for the patterned #! word. - <% "" % %> dup [ write ] cons ; + [ "" , ] make-string dup [ write ] cons ; : def-for-html-word- ( name -- name quot ) #! Return the name and code for the patterned #! word. - <% "<" % dup % "/>" % %> swap - <% "<" % % ">" % %> + [ "<" , dup , "/>" , ] make-string swap + [ "<" , , ">" , ] make-string [ write ] cons ; : def-for-html-word-foo/> ( name -- name quot ) diff --git a/library/httpd/html.factor b/library/httpd/html.factor index 530ba06084..353ab06d42 100644 --- a/library/httpd/html.factor +++ b/library/httpd/html.factor @@ -58,33 +58,35 @@ USE: url-encoding : >hex-color ( triplet -- hex ) [ >hex 2 digits ] map "#" swons cat ; -: fg-css% ( color -- ) - "color: " % >hex-color % "; " % ; +: fg-css, ( color -- ) + "color: " , >hex-color , "; " , ; -: bold-css% ( flag -- ) - [ "font-weight: bold; " % ] when ; +: bold-css, ( flag -- ) + [ "font-weight: bold; " , ] when ; -: italics-css% ( flag -- ) - [ "font-style: italic; " % ] when ; +: italics-css, ( flag -- ) + [ "font-style: italic; " , ] when ; -: underline-css% ( flag -- ) - [ "text-decoration: underline; " % ] when ; +: underline-css, ( flag -- ) + [ "text-decoration: underline; " , ] when ; -: size-css% ( size -- ) - "font-size: " % unparse % "; " % ; +: size-css, ( size -- ) + "font-size: " , unparse , "; " , ; -: font-css% ( font -- ) - "font-family: " % % "; " % ; +: font-css, ( font -- ) + "font-family: " , , "; " , ; : css-style ( style -- ) - <% [ - [ "fg" fg-css% ] - [ "bold" bold-css% ] - [ "italics" italics-css% ] - [ "underline" underline-css% ] - [ "size" size-css% ] - [ "font" font-css% ] - ] assoc-apply %> ; + [ + [ + [ "fg" fg-css, ] + [ "bold" bold-css, ] + [ "italics" italics-css, ] + [ "underline" underline-css, ] + [ "size" size-css, ] + [ "font" font-css, ] + ] assoc-apply + ] make-string ; : span-tag ( style quot -- ) over css-style dup "" = [ @@ -101,7 +103,7 @@ USE: url-encoding ] when* "/" ?str-tail drop ; : file-link-href ( path -- href ) - <% "/" % resolve-file-link url-encode % %> ; + [ "/" , resolve-file-link url-encode , ] make-string ; : file-link-tag ( style quot -- ) over "file-link" swap assoc [ diff --git a/library/httpd/http-common.factor b/library/httpd/http-common.factor index 699a1af4b3..91a1c1a166 100644 --- a/library/httpd/http-common.factor +++ b/library/httpd/http-common.factor @@ -80,9 +80,10 @@ USE: url-encoding "301 Moved Permanently" response terpri ; : directory-no/ ( -- ) - <% "request" get % CHAR: / % - "raw-query" get [ CHAR: ? % % ] when* - %> redirect ; + [ + "request" get , CHAR: / , + "raw-query" get [ CHAR: ? , , ] when* + ] make-string redirect ; : header-line ( alist line -- alist ) ": " split1 dup [ transp acons ] [ 2drop ] ifte ; @@ -111,7 +112,7 @@ USE: url-encoding : log-user-agent ( alist -- ) "User-Agent" swap assoc* [ - unswons <% % ": " % % %> log + unswons [ , ": " , , ] make-string log ] when* ; : prepare-url ( url -- url ) diff --git a/library/httpd/url-encoding.factor b/library/httpd/url-encoding.factor index 4845f56c7b..0958c201c2 100644 --- a/library/httpd/url-encoding.factor +++ b/library/httpd/url-encoding.factor @@ -29,6 +29,7 @@ IN: url-encoding USE: combinators USE: errors USE: kernel +USE: lists USE: logic USE: format USE: math @@ -51,14 +52,14 @@ USE: unparser 2drop ] [ >r succ dup 2 + r> substring - catch-hex> [ >char % ] when* + catch-hex> [ >char , ] when* ] ifte ; : url-decode-% ( index str -- index str ) 2dup url-decode-hex >r 3 + r> ; : url-decode-+-or-other ( index str ch -- index str ) - CHAR: + CHAR: \s replace % >r succ r> ; + CHAR: + CHAR: \s replace , >r succ r> ; : url-decode-iter ( index str -- ) 2dup str-length >= [ @@ -72,4 +73,4 @@ USE: unparser ] ifte ; : url-decode ( str -- str ) - <% 0 swap url-decode-iter %> ; + [ 0 swap url-decode-iter ] make-string ; diff --git a/library/init.factor b/library/init.factor index e3759028de..03eda3e8d8 100644 --- a/library/init.factor +++ b/library/init.factor @@ -53,7 +53,7 @@ USE: words : run-user-init ( -- ) #! Run user init file if it exists "user-init" get [ - <% "~" get % "/" get % ".factor-" % "rc" % %> + [ "~" get , "/" get , ".factor-" , "rc" , ] make-string ?run-file ] when ; diff --git a/library/jedit/jedit-remote.factor b/library/jedit/jedit-remote.factor index 4cc0022c3b..feacc3006b 100644 --- a/library/jedit/jedit-remote.factor +++ b/library/jedit/jedit-remote.factor @@ -48,24 +48,25 @@ USE: unparser read parse-number ] with-stream ; -: bool% ( ? -- str ) - "true" "false" ? % ; +: bool, ( ? -- str ) + "true" "false" ? , ; -: list>bsh-array% ( list -- code ) - "new String[] {" % - [ unparse % "," % ] each - "null}" % ; +: list>bsh-array, ( list -- code ) + "new String[] {" , + [ unparse , "," , ] each + "null}" , ; : make-jedit-request ( files dir params -- code ) [ - <% - "EditServer.handleClient(" % - "restore" get bool% "," % - "newView" get bool% "," % - "newPlainView" get bool% "," % - ( If the dir is not set, we don't want to send f ) - dup [ unparse ] [ drop "null" ] ifte % "," % - list>bsh-array% ");\n" % %> + [ + "EditServer.handleClient(" , + "restore" get bool, "," , + "newView" get bool, "," , + "newPlainView" get bool, "," , + ( If the dir is not set, we don't want to send f ) + dup [ unparse ] [ drop "null" ] ifte , "," , + list>bsh-array, ");\n" , + ] make-string ] bind ; : send-jedit-request ( request -- ) diff --git a/library/list-namespaces.factor b/library/list-namespaces.factor index c8b1bd371a..3cd6fb8833 100644 --- a/library/list-namespaces.factor +++ b/library/list-namespaces.factor @@ -54,9 +54,16 @@ USE: stack #! variable if it is not already contained in the list. tuck get unique put ; -: [, ( -- ) - #! Begin constructing a list. - >n f "list-buffer" set ; +: 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 ; + +: make-list ( quot -- list ) + #! Return a list whose entries are in the same order that , + #! was called. + make-rlist reverse ; : , ( obj -- ) #! Append an object to the currently constructing list. @@ -66,7 +73,3 @@ USE: stack #! Append an object to the currently constructing list, only #! if the object does not already occur in the list. "list-buffer" unique@ ; - -: ,] ( -- list ) - #! Finish constructing a list and push it on the stack. - "list-buffer" get reverse n> drop ; diff --git a/library/platform/jvm/sbuf.factor b/library/platform/jvm/sbuf.factor index e82c0e9acc..d4151a2378 100644 --- a/library/platform/jvm/sbuf.factor +++ b/library/platform/jvm/sbuf.factor @@ -59,6 +59,8 @@ USE: stack #! Destructively reverse a string buffer. [ ] "java.lang.StringBuffer" "reverse" jinvoke drop ; -DEFER: str>sbuf +: str>sbuf ( str -- sbuf ) + dup str-length tuck sbuf-append ; + : str-reverse ( str -- str ) str>sbuf dup sbuf-reverse sbuf>str ; diff --git a/library/platform/native/parse-syntax.factor b/library/platform/native/parse-syntax.factor index 9351a32196..9f0c1c7fa1 100644 --- a/library/platform/native/parse-syntax.factor +++ b/library/platform/native/parse-syntax.factor @@ -169,13 +169,14 @@ IN: syntax next-ch dup CHAR: " = [ drop ] [ - parse-ch % parse-string + parse-ch , parse-string ] ifte ; : " #! Note the ugly hack to carry the new value of 'pos' from - #! the <% %> scope up to the original scope. - <% parse-string "col" get %> swap "col" set parsed ; parsing + #! the make-string scope up to the original scope. + [ parse-string "col" get ] make-string + swap "col" set parsed ; parsing ! Complex literal : #{ diff --git a/library/platform/native/prettyprint.factor b/library/platform/native/prettyprint.factor index cfa2e56f50..02cf0d573e 100644 --- a/library/platform/native/prettyprint.factor +++ b/library/platform/native/prettyprint.factor @@ -39,7 +39,7 @@ USE: words : stack-effect. ( word -- ) stack-effect [ " " write - <% CHAR: ( % % CHAR: ) % %> prettyprint-comment + [ CHAR: ( , , CHAR: ) , ] make-string prettyprint-comment ] when* ; : documentation. ( indent word -- indent ) diff --git a/library/platform/native/profiler.factor b/library/platform/native/profiler.factor index 33c6a59765..d996448f54 100644 --- a/library/platform/native/profiler.factor +++ b/library/platform/native/profiler.factor @@ -55,7 +55,7 @@ SYMBOL: only-top : call-counts. ( -- ) #! Print word/call count pairs. - [, [ call-count, ] each-word ,] counts. ; + [ [ call-count, ] each-word ] make-list counts. ; : profile-depth ( -- n ) only-top get [ -1 ] [ callstack vector-length ] ifte ; @@ -76,7 +76,7 @@ SYMBOL: only-top : allot-counts. ( -- alist ) #! Print word/allot count pairs. - [, [ allot-count, ] each-word ,] counts. ; + [ [ allot-count, ] each-word ] make-list counts. ; : allot-profile ( quot -- ) #! Execute a quotation with the memory profiler enabled. diff --git a/library/platform/native/unparser.factor b/library/platform/native/unparser.factor index 8c72481113..9a38452b61 100644 --- a/library/platform/native/unparser.factor +++ b/library/platform/native/unparser.factor @@ -42,23 +42,22 @@ USE: words : >digit ( n -- ch ) dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] ifte ; -: integer% ( num radix -- ) - tuck /mod >digit % dup 0 > [ - swap integer% +: integer, ( num radix -- ) + tuck /mod >digit , dup 0 > [ + swap integer, ] [ 2drop ] ifte ; -: integer- ( num -- num ) - dup 0 < [ "-" % neg ] when ; - : >base ( num radix -- string ) #! Convert a number to a string in a certain base. - <% over 0 < [ - swap neg swap integer% CHAR: - % - ] [ - integer% - ] ifte reverse%> ; + [ + over 0 < [ + swap neg swap integer, CHAR: - , + ] [ + integer, + ] ifte + ] make-rstring ; : >dec ( num -- string ) 10 >base ; : >bin ( num -- string ) 2 >base ; @@ -68,13 +67,22 @@ USE: words DEFER: unparse : unparse-ratio ( num -- str ) - <% dup - numerator unparse % - CHAR: / % - denominator unparse % %> ; + [ + dup + numerator unparse , + CHAR: / , + denominator unparse , + ] make-string ; : unparse-complex ( num -- str ) - >rect <% "#{ " % swap unparse % " " % unparse % " }" % %> ; + [ + "#{ " , + dup + real unparse , + " " , + imaginary unparse , + " }" , + ] make-string ; : ch>ascii-escape ( ch -- esc ) [ @@ -100,7 +108,9 @@ DEFER: unparse ] unless ; : unparse-str ( str -- str ) - <% CHAR: " % [ unparse-ch % ] str-each CHAR: " % %> ; + [ + CHAR: " , [ unparse-ch , ] str-each CHAR: " , + ] make-string ; : unparse-word ( word -- str ) word-name dup "#" ? ; @@ -113,11 +123,13 @@ DEFER: unparse : unparse-float ( float -- str ) (unparse-float) fix-float ; : unparse-unknown ( obj -- str ) - <% "#<" % - dup type type-name % - " @ " % - address unparse % - ">" % %> ; + [ + "#<" , + dup type type-name , + " @ " , + address unparse , + ">" , + ] make-string ; : unparse-t drop "t" ; : unparse-f drop "f" ; diff --git a/library/prettyprint.factor b/library/prettyprint.factor index b5aba002da..370aa2d179 100644 --- a/library/prettyprint.factor +++ b/library/prettyprint.factor @@ -144,12 +144,12 @@ DEFER: prettyprint* trim-newline "comments" style write-attr ; : word-link ( word -- link ) - <% - "vocabularies'" % - dup word-vocabulary % - "'" % - word-name % - %> ; + [ + "vocabularies'" , + dup word-vocabulary , + "'" , + word-name , + ] make-string ; : word-actions ( -- list ) [ @@ -194,7 +194,7 @@ DEFER: prettyprint* 0 swap prettyprint* drop terpri ; : vocab-link ( vocab -- link ) - <% "vocabularies'" % % %> ; + "vocabularies'" swap cat2 ; : vocab-attrs ( word -- attrs ) vocab-link "object-link" default-style acons ; diff --git a/library/random.factor b/library/random.factor index 1e0c28ec17..c762b15b4b 100644 --- a/library/random.factor +++ b/library/random.factor @@ -84,7 +84,7 @@ USE: stack #! Returns a random subset of the given list of comma pairs. #! The car of each pair is a probability, the cdr is the #! item itself. Only the cdr of the comma pair is returned. - [, + [ [ car+ ] keep ( probabilitySum list ) [ >r 1 over random-int r> ( probabilitySum probability elem ) @@ -93,4 +93,4 @@ USE: stack > ( probabilitySum elemd boolean ) [ drop ] [ , ] ifte ] each drop - ,] ; + ] make-list ; diff --git a/library/sbuf.factor b/library/sbuf.factor index 809558ce49..f0181f89da 100644 --- a/library/sbuf.factor +++ b/library/sbuf.factor @@ -34,34 +34,21 @@ USE: namespaces USE: strings USE: stack -: str>sbuf ( str -- sbuf ) - dup str-length tuck sbuf-append ; +: 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 ; -: string-buffer-size 80 ; - -: <% ( -- ) - #! Begins constructing a string. - >n string-buffer-size - "string-buffer" set ; - -: % ( str -- ) - #! Append a string to the construction buffer. - "string-buffer" get sbuf-append ; - -: %> ( -- str ) - #! Ends construction and pushes the constructed text on the - #! stack. - "string-buffer" get sbuf>str n> drop ; - -: reverse%> ( -- str ) - #! Ends construction and pushes the *reversed*, constructed - #! text on the stack. - "string-buffer" get dup sbuf-reverse sbuf>str n> drop ; +: make-rstring ( quot -- string ) + #! Return a string whose entries are in the same order that , + #! was called. + make-rlist cat ; : fill ( count char -- string ) #! Push a string that consists of the same character #! repeated. - <% swap [ dup % ] times drop %> ; + [ swap [ dup , ] times drop ] make-string ; : str-map ( str code -- str ) #! Apply a quotation to each character in the string, and @@ -88,7 +75,7 @@ USE: stack : split ( string split -- list ) #! Split the string at each occurrence of split, and push a #! list of the pieces. - [, 0 -rot (split) ,] ; + [ 0 -rot (split) ] make-list ; : split-n-advance substring , >r tuck + swap r> ; : split-n-finish nip dup str-length swap substring , ; @@ -102,4 +89,4 @@ USE: stack : split-n ( n str -- list ) #! Split a string into n-character chunks. - [, 0 -rot (split-n) ,] ; + [ 0 -rot (split-n) ] make-list ; diff --git a/library/test/benchmark/sort.factor b/library/test/benchmark/sort.factor index e5464bad9b..327b1ce5d8 100644 --- a/library/test/benchmark/sort.factor +++ b/library/test/benchmark/sort.factor @@ -5,4 +5,4 @@ USE: random USE: stack USE: test -[ ] [ [, 100000 [ 0 10000 random-int , ] times ,] num-sort drop ] unit-test +[ ] [ [ 100000 [ 0 10000 random-int , ] times ] make-list num-sort drop ] unit-test diff --git a/library/test/benchmark/strings.factor b/library/test/benchmark/strings.factor index 5dd7df6c30..67a1001b5c 100644 --- a/library/test/benchmark/strings.factor +++ b/library/test/benchmark/strings.factor @@ -3,12 +3,13 @@ USE: strings USE: math USE: combinators USE: test +USE: lists ! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html : string-step ( n str -- ) 2dup str-length > [ - dup <% "123" % % "456" % % "789" % %> + dup [ "123" , , "456" , , "789" , ] make-string dup dup str-length 2 /i 0 transp substring swap dup str-length 2 /i succ 1 transp substring cat2 string-step diff --git a/library/test/crashes.factor b/library/test/crashes.factor index b03abf4667..cf1d918046 100644 --- a/library/test/crashes.factor +++ b/library/test/crashes.factor @@ -22,10 +22,6 @@ USE: lists [ drop ] [ drop ] catch ] keep-datastack -"hello" str>sbuf "x" set -[ -5 "x" get set-sbuf-length ] [ drop ] catch -[ "x" get sbuf>str drop ] [ drop ] catch - 10 "x" set [ -2 "x" get set-vector-length ] [ drop ] catch [ "x" get vector-clone drop ] [ drop ] catch diff --git a/library/test/lists/namespaces.factor b/library/test/lists/namespaces.factor index 2bca360fa5..fdeaf07dbb 100644 --- a/library/test/lists/namespaces.factor +++ b/library/test/lists/namespaces.factor @@ -33,8 +33,8 @@ USE: test ] unit-test [ [ "xyz" #{ 3 2 } 1/5 [ { } ] ] ] [ - [, "xyz" , "xyz" unique, + [ "xyz" , "xyz" unique, #{ 3 2 } , #{ 3 2 } unique, 1/5 , 1/5 unique, - [, { } unique, ,] , ,] + [ { } unique, ] make-list , ] make-list ] unit-test diff --git a/library/test/sbuf.factor b/library/test/sbuf.factor index 58c7ff3a15..6b4e1ac4e0 100644 --- a/library/test/sbuf.factor +++ b/library/test/sbuf.factor @@ -9,10 +9,6 @@ USE: stack USE: strings USE: test -[ t ] [ "Foo" str>sbuf "Foo" str>sbuf = ] unit-test -[ f ] [ "Foo" str>sbuf "Foob" str>sbuf = ] unit-test -[ f ] [ 34 "Foo" str>sbuf = ] unit-test - [ "Hello" ] [ 100 "buf" set "Hello" "buf" get sbuf-append @@ -20,8 +16,3 @@ USE: test "World" "buf-clone" get sbuf-append "buf" get sbuf>str ] unit-test - -[ t ] [ - "Hello world" str>sbuf hashcode - "Hello world" hashcode = -] unit-test diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index 5f339c78cd..3b5eda2a92 100644 --- a/library/tools/debugger.factor +++ b/library/tools/debugger.factor @@ -29,6 +29,7 @@ IN: errors USE: combinators USE: continuations USE: kernel +USE: lists USE: logic USE: namespaces USE: prettyprint @@ -41,15 +42,15 @@ USE: unparser "ERROR: " write error. ; : parse-dump ( error -- ) - <% - "error-file" get [ "" ] unless* % ":" % - "error-line-number" get [ 1 ] unless* unparse % ": " % - %> write + [ + "error-file" get [ "" ] unless* , ":" , + "error-line-number" get [ 1 ] unless* unparse , ": " , + ] make-string write error. "error-line" get print - <% "error-col" get " " fill % "^" % %> print ; + [ "error-col" get " " fill , "^" , ] make-string print ; : in-parser? ( -- ? ) "error-line" get "error-col" get and ; diff --git a/library/tools/image.factor b/library/tools/image.factor index beaa71c354..e361002b38 100644 --- a/library/tools/image.factor +++ b/library/tools/image.factor @@ -274,13 +274,11 @@ DEFER: ' (vocabulary) set-hash ; : 'plist ( word -- plist ) - [, - - dup word-name "name" swons , - dup word-vocabulary "vocabulary" swons , - "parsing" word-property [ t "parsing" swons , ] when - - ,] ' ; + [ + dup word-name "name" swons , + dup word-vocabulary "vocabulary" swons , + "parsing" word-property [ t "parsing" swons , ] when + ] make-list ' ; : (worddef,) ( word primitive parameter -- ) ' >r >r dup (word+) dup 'plist >r diff --git a/library/tools/listener.factor b/library/tools/listener.factor index 51dacad74b..93b7feb920 100644 --- a/library/tools/listener.factor +++ b/library/tools/listener.factor @@ -44,8 +44,12 @@ USE: unparser USE: vectors : print-banner ( -- ) - <% "This is " % java? [ "JVM " % ] when - native? [ "native " % ] when "Factor " % version % %> print + [ + "This is " , + java? [ "JVM " , ] when + native? [ "native " , ] when + "Factor " , version , + ] make-string print "Copyright (C) 2003, 2004 Slava Pestov" print "Copyright (C) 2004 Chris Double" print "Type ``exit'' to exit, ``help'' for help." print ; diff --git a/library/vocabularies.factor b/library/vocabularies.factor index 81f431e888..d71ff0e2c7 100644 --- a/library/vocabularies.factor +++ b/library/vocabularies.factor @@ -35,16 +35,20 @@ USE: strings : vocabs ( -- list ) #! Push a list of vocabularies. - global [ "vocabularies" get [ vars ] bind ] bind ; + global [ "vocabularies" get [ vars str-sort ] bind ] bind ; : vocab ( name -- vocab ) #! Get a vocabulary. global [ "vocabularies" get get* ] bind ; +: word-sort ( list -- list ) + #! Sort a list of words by name. + [ swap word-name swap word-name str-lexi> ] sort ; + : words ( vocab -- list ) #! Push a list of all words in a vocabulary. #! Filter empty slots. - vocab [ values ] bind [ ] subset ; + vocab [ values ] bind [ ] subset word-sort ; : init-search-path ( -- ) ! For files