documentation updates, set-nth remove-nth head words

TODO.FACTOR.txt

@@ -1,25 +1,19 @@
 0.62:
 
+- stdout hangs
 - read-line: handle \r\n
 - flush output buffer before reading line
 - print: only flush in stdio stream
 - ignore errors from flush
 - can-read-line?
-- client connections broken
+- EOF in client connections
-- vocabulary section: what is the dictionary?
-- document swons, uncons, unswons
-- vector-push/pop examples
 - vector-each/map examples
-- string construction examples
-- string construction ackward
 - sbuf-hashcode
 - vector-hashcode
-- test substitute, set-nth, remove-nth
 - listener backspace overzealous
 - SIGBUS handler
 - handle division by zero
 - log-client: fix for native
-- telnetd: needs own history
 - multitasking
 
 [error] AWT-EventQueue-0: java.lang.NullPointerException

doc/devel-guide.tex

@@ -325,9 +325,9 @@ More combinators will be introduced in later sections.
 
 \subsection{Vocabularies}
 
-The dictionary of words is not a flat list -- rather, it is separated
+When an expression is parsed, each token in turn is looked up in the dictionary. If there is no dictionary entry, the token is parsed as a number instead.
-into a number of \emph{vocabularies}. Each vocabulary is a named list
+The dictionary of words is structured as a set of named \emph{vocabularies}. Each vocabulary is a list
-of words that have something in common -- for example, the {}``lists''
+of related words -- for example, the {}``lists''
 vocabulary contains words for working with linked lists.
 
 When a word is read by the parser, the \emph{vocabulary search path}
@@ -774,6 +774,26 @@ is a proper list:
 \emph{t}
 \end{alltt}
 
+It is worth mentioning a few words closely related to and defined in terms of \texttt{cons}, \texttt{car} and \texttt{cdr}.
+
+\texttt{swons ( cdr car -{}- cons )} constructs a cons cell, with the argument order reversed. Usually, it is considered bad practice to define two words that only differ by parameter order, however cons cells are constructed about equally frequently with both orders. Of course, \texttt{swons} is defined as follows:
+
+\begin{alltt}
+: swons swap cons ;
+\end{alltt}
+
+\texttt{uncons ( cons -{}- car cdr )} pushes both constituents of a cons cell. It is defined as thus:
+
+\begin{alltt}
+: uncons dup car swap cdr ;
+\end{alltt}
+
+\texttt{unswons ( cons -{}- cdr car)} is just a swapped version of \texttt{uncons}. It is defined as thus:
+
+\begin{alltt}
+: unswons dup cdr swap car ;
+\end{alltt}
+
 \subsection{Working with lists}
 
 Unless otherwise documented, list manipulation words expect proper
@@ -1030,8 +1050,7 @@ For example, the implementation of \texttt{assoc?} uses \texttt{all?}:
 
 \subsection{\label{sub:List-constructors}List constructors}
 
-The list construction words minimize stack noise with a clever trick.
+The list construction words provide an alternative way to build up a list. Instead of passing a partial list around on the stack as it is built, they store the partial list in a variable. This reduces the number
-They store a partial list in a variable, thus reducing the number
 of stack elements that have to be juggled.
 
 The word \texttt{{[}, ( -{}- )} begins list construction.
@@ -1229,6 +1248,22 @@ of the vector. This increments the vector's length by one.
 end of the vector and pushes it. This decrements the vector's length
 by one.
 
+The \texttt{vector-push} and \texttt{vector-pop} words can be used to implement additional stacks. For example:
+
+\begin{alltt}
+20 <vector> "state-stack" set
+: push-state ( obj -- ) "state-stack" get vector-push ;
+: pop-state ( -- obj ) "state-stack" get vector-pop ;
+12 push-state
+4 push-state
+pop-state .
+\emph{4}
+0 push-state
+pop-state .
+\emph{0}
+pop-state .
+\emph{12}
+\end{alltt}
 
 \subsection{Vector combinators}
 
@@ -1453,17 +1488,8 @@ new character positions are automatically filled with zeroes.
 
 \subsection{String constructors}
 
-Passing a string buffer on the stack can lead to unnecessary stack
+The string construction words provide an alternative way to build up a string. Instead of passing a string buffer around on the stack, they store the string buffer in a variable. This reduces the number
-noise, and overly-complicated stack effects. Often it is better to
+of stack elements that have to be juggled.
-use the string construction words, which operate on a similar principle
-to the list construction words.
-
-As seen in \ref{sub:List-constructors}, the \texttt{{[},} word begins
-list construction; the \texttt{,} word appends elements to the list
-that will be returned by the \texttt{,{]}} word. Similarly, the \texttt{<\%}
-word begins string construction; the \texttt{\%} word appends the
-top of the stack to the string that will be returned by the \texttt{\%>}
-word.
 
 The word \texttt{<\% ( -{}- )} begins string construction. The word
 definition creates a string buffer. Instead of leaving the string
@@ -1478,6 +1504,16 @@ The word \texttt{\%> ( -{}- str )} pushes the complete list. The word
 definition pops the name stack and calls \texttt{sbuf>str} on the
 appropriate string buffer.
 
+Compare the following two examples -- both define a word that concatenates together all elements of a list of strings. The first one uses a string buffer stored on the stack, the second uses string construction words:
+
+\begin{alltt}
+: cat ( list -- str )
+    100 <sbuf> swap [ over sbuf-append ] each sbuf>str ;
+
+: cat ( list -- str )
+    <\% [ \% ] each \%> ;
+\end{alltt}
+
 \subsection{String combinators}
 
 A pair of combinators for iterating over strings are provided in the \texttt{strings} vocabulary. The first is the \texttt{str-each} word that does nothing other than applying a quotation to each character. The second is the \texttt{str-map} word that also collects the return values of the quotation into a new string.

library/init.factor

@@ -148,6 +148,8 @@ USE: vocabularies
     ] ifte ;
 
 : init-interpreter ( -- )
+    init-history
+
     print-banner
     word-of-the-day
     room.

library/interpreter.factor

@@ -49,7 +49,7 @@ USE: vectors
     "Type ``exit'' to exit, ``help'' for help." print ;
 
 : init-history ( -- )
-    "history" get [ 64 <vector> "history" set ] unless ;
+    64 <vector> "history" set ;
 
 : history+ ( cmd -- )
     "history" get vector-push ;
@@ -98,7 +98,6 @@ USE: vectors
     ] ifte ;
 
 : interpreter-loop ( -- )
-    init-history
     [ "quit-flag" get not ] [ interpret ] while
     "quit-flag" off ;
 

library/lists.factor

@@ -45,11 +45,25 @@ USE: vectors
     #! Construct a proper list of 2 elements in reverse stack order.
     swap unit cons ;
 
+: copy-cons ( accum cons -- accum cdr )
+    uncons >r unit dup rot set-cdr r> ;
+
+: (clone-list) ( accum list -- last )
+    dup cons? [ copy-cons (clone-list) ] [ over set-cdr ] ifte ;
+
+: clone-list* ( list -- list last )
+    #! Push the cloned list, and the last cons cell of the
+    #! cloned list.
+    uncons >r unit dup r> (clone-list) ;
+
+: clone-list ( list -- list )
+    #! Push a shallow copy of a list.
+    dup [ clone-list* drop ] when ;
+
 : append ( [ list1 ] [ list2 ] -- [ list1 list2 ] )
-    #! Append two lists. The first list must be proper. A new
+    #! Append two lists. A new list is constructed by copying
-    #! list is constructed by copying the first list and setting
+    #! the first list and setting its tail to the second.
-    #! its tail to the second.
+    over [ >r clone-list* r> swap set-cdr ] [ nip ] ifte ;
-    over [ >r uncons r> append cons ] [ nip ] ifte ;
 
 : add ( [ list1 ] elem -- [ list1 elem ] )
     #! Push a new proper list with an element added to the end.
@@ -67,20 +81,6 @@ USE: vectors
 : cddr ( list -- cddr )
     cdr cdr ; inline
 
-: clone-list-iter ( result list -- last [ ] )
-    #! DESTRUCTIVE. Helper word for 'clone-list'.
-    [
-        dup cons?
-    ] [
-        uncons >r unit tuck >r set-cdr r> r>
-    ] while ;
-
-: clone-list ( list -- list )
-    #! Push a shallow copy of a list.
-    dup [
-        uncons >r unit dup r> clone-list-iter swap set-cdr
-    ] when ;
-
 : contains ( element list -- remainder )
     #! If the proper list contains the element, push the
     #! remainder of the list, starting from the cell whose car
@@ -298,10 +298,26 @@ DEFER: tree-contains?
     inline interpret-only
 
 : substitute ( new old list -- list )
-    [ 2dup = [ drop over ] when ] inject ;
+    [ 2dup = [ drop over ] when ] inject nip nip ;
+
+: (head) ( accum list n -- last list )
+    dup 1 = [ drop ] [ pred >r copy-cons r> (head) ] ifte ;
+
+: head* ( n list -- head last rest )
+    #! Push the head of the list, the last cons cell of the
+    #! head, and the rest of the list.
+    uncons >r unit tuck r> rot (head) ;
+
+: head ( n list -- head )
+    #! Push a new list containing the first n elements.
+    over 0 = [ 2drop f ] [ head* 2drop ] ifte ;
 
 : set-nth ( value index list -- list )
-    over 0 = [ nip cdr cons ] [ >r pred r> set-nth ] ifte ;
+    over 0 = [
+        nip cdr cons
+    ] [
+        rot >r head* cdr r> swons swap set-cdr
+    ] ifte ;
 
 : subset-add ( car pred accum -- accum )
     >r over >r call r> r> rot [ cons ] [ nip ] ifte ;
@@ -327,8 +343,9 @@ DEFER: tree-contains?
     #! Remove all occurrences of the object from the list.
     [ dupd = not ] subset nip ;
 
-: remove-nth ( index list -- list )
+: remove-nth ( n list -- list )
-    over 0 = [ nip cdr ] [ >r pred r> cdr remove-nth ] ifte ;
+    #! Push a new list with the nth element removed.
+    over 0 = [ nip cdr ] [ head* cdr swap set-cdr ] ifte ;
 
 : length ( list -- length )
     #! Pushes the length of the given proper list.

library/telnetd.factor

@@ -41,6 +41,7 @@ USE: streams
     dup [
         "client" set
         log-client
+        init-history
         interpreter-loop
     ] with-stream ;
 

library/test/lists/lists.factor

@@ -75,3 +75,13 @@ USE: test
 [ [ 0 1 2 3 ] ] [ 4   count ] unit-test
 
 [ [ 1 2 3 ] ] [ [ 1 4 2 5 3 6 ] [ 4 < ] subset ] unit-test
+
+[ [ t f t f ] ] [ f 1 [ t 1 t 1 ] substitute ] unit-test
+
+[ [ 0 1 2 4 5 6 7 8 9 ] ] [ 3 10 count remove-nth ] unit-test
+[ [ 1 2 3 4 5 6 7 8 9 ] ] [ 0 10 count remove-nth ] unit-test
+[ [ 0 1 2 3 4 5 6 7 8 ] ] [ 9 10 count remove-nth ] unit-test
+
+[ [ 1 2 3 ] ] [ 2 1 [ 1 3 3 ] set-nth ] unit-test
+[ [ 1 2 3 ] ] [ 1 0 [ 2 2 3 ] set-nth ] unit-test
+[ [ 1 2 3 ] ] [ 3 2 [ 1 2 2 ] set-nth ] unit-test