make-string and make-list replace <> and [, ,]

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

examples/infix.factor

@@ -21,7 +21,7 @@ DEFER: infix
 : infix ( list -- quot )
     #! Convert an infix expression (passed in as a list) to
     #! postfix.
-    [, 10 <vector> exprs set (infix) end ,] ;
+    [ 10 <vector> exprs set (infix) end ] make-list ;
 
 [ [ ] ] [ [ ] infix ] unit-test
 [ [ 1 ] ] [ [ 1 ] infix ] unit-test

examples/mandel.factor

@@ -39,12 +39,12 @@ USE: test
 : val 0.85 ;
 
 : <color-map> ( 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 + ;
 

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

library/ansi.factor

@@ -68,13 +68,13 @@ USE: strings
     "\e[4" swap "m" cat3 ; inline
 
 : ansi-attrs ( style -- )
-    "bold"    over assoc [ bold % ] when
+    "bold"    over assoc [ bold , ] when
-    "ansi-fg" over assoc [ fg % ] when*
+    "ansi-fg" over assoc [ fg , ] when*
-    "ansi-bg" over assoc [ bg % ] when*
+    "ansi-bg" over assoc [ bg , ] when*
     drop ;
 
 : ansi-attr-string ( string style -- string )
-    <% ansi-attrs % reset % %> ;
+    [ ansi-attrs , reset , ] make-string ;
 
 : <ansi-stream> ( stream -- stream )
     #! Wraps the given stream in an ANSI stream. ANSI streams

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.
     [ <local-alien> ] cons
-    <% "<" % "struct-name" get % ">" % %>
+    [ "<" , "struct-name" get , ">" , ] make-string
     "in" get create swap
     define-compound ;
 

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

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

library/httpd/html-tags.factor

@@ -69,7 +69,7 @@ USE: logic
 ! <a href= "http://" swap cat2 a> "click" write </a>
 !
 ! (url -- )
-! <a href= <% "http://" % % %> a> "click" write </a>
+! <a href= [ "http://" , , ] make-string a> "click" write </a>
 !
 ! 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-</foo> ( name -- name quot )
     #! Return the name and code for the </foo> patterned
     #! word.    
-    <% "</" % % ">" % %> dup [ write ] cons ;
+    [ "</" , , ">" , ] make-string dup [ write ] cons ;
 
 : def-for-html-word-<foo/> ( name -- name quot )
     #! Return the name and code for the <foo/> patterned
     #! word.
-    <% "<" % dup % "/>" % %> swap
+    [ "<" , dup , "/>" , ] make-string swap
-    <% "<" % % ">" % %>
+    [ "<" , , ">" , ] make-string
     [ write ] cons ;
 
 : def-for-html-word-foo/> ( name -- name quot )

library/httpd/html.factor

@@ -58,33 +58,35 @@ USE: url-encoding
 : >hex-color ( triplet -- hex )
     [ >hex 2 digits ] map "#" swons cat ;
 
-: fg-css% ( color -- )
+: fg-css, ( color -- )
-    "color: " % >hex-color % "; " % ;
+    "color: " , >hex-color , "; " , ;
 
-: bold-css% ( flag -- )
+: bold-css, ( flag -- )
-    [ "font-weight: bold; " % ] when ;
+    [ "font-weight: bold; " , ] when ;
 
-: italics-css% ( flag -- )
+: italics-css, ( flag -- )
-    [ "font-style: italic; " % ] when ;
+    [ "font-style: italic; " , ] when ;
 
-: underline-css% ( flag -- )
+: underline-css, ( flag -- )
-    [ "text-decoration: underline; " % ] when ;
+    [ "text-decoration: underline; " , ] when ;
 
-: size-css% ( size -- )
+: size-css, ( size -- )
-    "font-size: " % unparse % "; " % ;
+    "font-size: " , unparse , "; " , ;
 
-: font-css% ( font -- )
+: font-css, ( font -- )
-    "font-family: " % % "; " % ;
+    "font-family: " , , "; " , ;
 
 : css-style ( style -- )
-    <% [
+    [
-        [ "fg"        fg-css% ]
+        [
-        [ "bold"      bold-css% ]
+            [ "fg"        fg-css, ]
-        [ "italics"   italics-css% ]
+            [ "bold"      bold-css, ]
-        [ "underline" underline-css% ]
+            [ "italics"   italics-css, ]
-        [ "size"      size-css% ]
+            [ "underline" underline-css, ]
-        [ "font"      font-css% ]
+            [ "size"      size-css, ]
-    ] assoc-apply %> ;
+            [ "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 [

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*
+        "request" get , CHAR: / ,
-    %> redirect ;
+        "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 )

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 ;

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 ;
 

library/jedit/jedit-remote.factor

@@ -48,24 +48,25 @@ USE: unparser
         read parse-number
     ] with-stream ;
 
-: bool% ( ? -- str )
+: bool, ( ? -- str )
-    "true" "false" ? % ;
+    "true" "false" ? , ;
 
-: list>bsh-array% ( list -- code )
+: list>bsh-array, ( list -- code )
-    "new String[] {" %
+    "new String[] {" ,
-    [ unparse % "," % ] each
+    [ unparse , "," , ] each
-    "null}" % ;
+    "null}" , ;
 
 : make-jedit-request ( files dir params -- code )
     [
-        <%
+        [
-        "EditServer.handleClient(" %
+            "EditServer.handleClient(" ,
-        "restore" get bool% "," %
+            "restore" get bool, "," ,
-        "newView" get bool% "," %
+            "newView" get bool, "," ,
-        "newPlainView" get bool% "," %
+            "newPlainView" get bool, "," ,
-        ( If the dir is not set, we don't want to send f )
+            ( If the dir is not set, we don't want to send f )
-        dup [ unparse ] [ drop "null" ] ifte % "," %
+            dup [ unparse ] [ drop "null" ] ifte , "," ,
-        list>bsh-array% ");\n" % %>
+            list>bsh-array, ");\n" ,
+        ] make-string
     ] bind ;
 
 : send-jedit-request ( request -- )

library/list-namespaces.factor

@@ -54,9 +54,16 @@ USE: stack
     #! variable if it is not already contained in the list.
     tuck get unique put ;
 
-: [, ( -- )
+: make-rlist ( quot -- list )
-    #! Begin constructing a list.
+    #! Call a quotation. The quotation can call , to prepend
-    <namespace> >n f "list-buffer" set ;
+    #! 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 ;

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 <sbuf> tuck sbuf-append ;
+
 : str-reverse ( str -- str )
     str>sbuf dup sbuf-reverse sbuf>str ;

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.
+    #! the make-string scope up to the original scope.
-    <% parse-string "col" get %> swap "col" set parsed ; parsing
+    [ parse-string "col" get ] make-string
+    swap "col" set parsed ; parsing
 
 ! Complex literal
 : #{

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 )

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.

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 -- )
+: integer, ( num radix -- )
-    tuck /mod >digit % dup 0 > [
+    tuck /mod >digit , dup 0 > [
-        swap integer%
+        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: - %
+        over 0 < [
-    ] [
+            swap neg swap integer, CHAR: - ,
-        integer%
+        ] [
-    ] ifte reverse%> ;
+            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 %
+        dup
-    CHAR: / %
+        numerator unparse ,
-    denominator 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 "#<unnamed>" ? ;
@@ -113,11 +123,13 @@ DEFER: unparse
 : unparse-float ( float -- str ) (unparse-float) fix-float ;
 
 : unparse-unknown ( obj -- str )
-    <% "#<" %
+    [
-    dup type type-name %
+        "#<" ,
-    " @ " % 
+        dup type type-name ,
-    address unparse %
+        " @ " , 
-    ">" % %> ;
+        address unparse ,
+        ">" ,
+    ] make-string ;
 
 : unparse-t drop "t" ;
 : unparse-f drop "f" ;

library/prettyprint.factor

@@ -144,12 +144,12 @@ DEFER: prettyprint*
     trim-newline "comments" style write-attr ;
 
 : word-link ( word -- link )
-    <%
+    [
-    "vocabularies'" %
+        "vocabularies'" ,
-    dup word-vocabulary %
+        dup word-vocabulary ,
-    "'" %
+        "'" ,
-    word-name %
+        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 ;

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 ;

library/sbuf.factor

@@ -34,34 +34,21 @@ USE: namespaces
 USE: strings
 USE: stack
 
-: str>sbuf ( str -- sbuf )
+: make-string ( quot -- string )
-    dup str-length <sbuf> tuck sbuf-append ;
+    #! 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 ;
+: make-rstring ( quot -- string )
-
+    #! Return a string whose entries are in the same order that ,
-: <% ( -- )
+    #! was called.
-    #! Begins constructing a string.
+    make-rlist cat ;
-    <namespace> >n string-buffer-size <sbuf>
-    "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 ;
 
 : 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 ;

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

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

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 <vector> "x" set
 [ -2 "x" get set-vector-length ] [ drop ] catch
 [ "x" get vector-clone drop ] [ drop ] catch

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

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

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 [ "<interactive>" ] unless* % ":" %
+        "error-file" get [ "<interactive>" ] unless* , ":" ,
-    "error-line-number" get [ 1 ] unless* unparse % ": " %
+        "error-line-number" get [ 1 ] unless* unparse , ": " ,
-    %> write
+    ] 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 ;

library/tools/image.factor

@@ -274,13 +274,11 @@ DEFER: '
     (vocabulary) set-hash ;
 
 : 'plist ( word -- plist )
-    [,
+    [
-
+        dup word-name "name" swons ,
-    dup word-name "name" swons ,
+        dup word-vocabulary "vocabulary" swons ,
-    dup word-vocabulary "vocabulary" swons ,
+        "parsing" word-property [ t "parsing" swons , ] when
-    "parsing" word-property [ t "parsing" swons , ] when
+    ] make-list ' ;
-
-    ,] ' ;
 
 : (worddef,) ( word primitive parameter -- )
     ' >r >r dup (word+) dup 'plist >r

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 ;

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