( Title: Double-Ended, Double-Linked Lists File: ddlist.fs Version: 1.2.4 Author: David N. Williams License: LGPL Last revision: August 28, 2021 ) \ Copyright (C) 2000-2002, 2021 David N. Williams ( This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or at your option any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. Please see the file POLITENESS included with this distribution. Forth 200x compatible except for: - Case sensitivity. - Assumption that zero does not occur as an address. Uses REQUIRED from the optional File-Access word set. Uses LOCALS| from the optional Locals word set. Please see the file NOTATION. The only words from the following files that are actually used here are mentioned in the accompanying comments. The rest complete the glossary so that only this file need be loaded for double-ended, double-linked list applications. ) s" nodespace.fs" REQUIRED \ for UNUSE-NODE s" dendlist.fs" REQUIRED \ for CURRENT-LIST s" dnode.fs" REQUIRED \ but not used here \ *** WORDS ( DDAPPEND DDINSERT-AFTER DDINSERT-BEFORE DDPREPEND DDUNLINK DDUNLINK-FIRST DDUNLINK-LAST DDUNUSE DDUNUSE-FIRST DDUNUSE-LAST ) \ *** DOUBLE-ENDED, DOUBLE-LINKED LIST OPERATIONS ( These words assume that the current list is double-ended and double-linked, and that all nodes have headers for double linking and belong to the current node space. ) : ddinsert-before ( node node.after -- ) ( Assume that node.after is in the current list, and that node is unlinked. Insert node into the list just before node.after. Note: This code is identical to that for SDINSERT-BEFORE. ) ( after) dup cell+ ( prev) @ LOCALS| before after node | before node cell+ ( prev) ! \ node <- before after node ( nx) ! \ node -> after node after cell+ ( prev) ! \ after <- node node before IF ( node) before ( nx) ! \ before -> node ELSE ( node) current-list ( head) ! \ node is new first THEN ; : ddinsert-after ( node node.before -- ) ( Assume that node.before is in the current list, and that node is unlinked. Insert node into the list just after node.before. ) ( before) dup ( nx) @ LOCALS| after before node | before node cell+ ( prev) ! \ node <- before after node ( nx) ! \ node -> after node before ( nx) ! \ before -> node node after IF \ node is not last ( node) after cell+ ( prev) ! \ after <- node ELSE ( node) current-list cell+ ( tail) ! \ node is new last THEN ; : ddprepend ( node -- ) ( Assume that node is unlinked. Prepend it to the beginning of the current list. Note: This code is identical to that for SDPREPEND except for the ELSE clause. ) current-list ( head) @ LOCALS| first node | first node ( nx) ! \ node -> first 0 node cell+ ( prev) ! \ node <- zero node current-list ( head) ! \ node is new first first IF \ list was not empty node first cell+ ( prev) ! \ first <- node ELSE \ list was empty node current-list cell+ ( tail) ! \ node is last THEN ; \ current-list ( head) @ \ ( first) dup IF \ list was not empty \ ( node first) 2dup cell+ ( prev) ! \ first <- node \ ELSE \ list was empty \ ( node first) over current-list cell+ ( tail) ! \ node is last \ THEN \ ( node first) over ( nx) ! \ node -> first \ ( node) 0 over cell+ ( prev) ! \ node <- zero \ ( node) current-list ( head) ! ; \ node is new first : ddappend ( node -- ) ( Assume that node is unlinked. Append it to the end of the current list. ) current-list cell+ ( tail) @ LOCALS| last node | last node cell+ ( prev) ! \ node <- last 0 node ( nx) ! \ node -> zero node current-list cell+ ( tail) ! \ node is new last last IF \ list was nonempty node last ( nx) ! \ last -> node ELSE \ list was empty node current-list ( head) ! \ node is first THEN ; \ current-list cell+ ( tail) @ \ ( last) dup IF \ list was not empty \ ( node last) 2dup ( nx) ! \ last -> node \ ELSE \ list was empty \ ( node last) over current-list ( head) ! \ node is first \ THEN \ ( node last) over cell+ ( prev) ! \ node <- last \ ( node) 0 over ( nx) ! \ node -> zero \ ( node) current-list cell+ ( tail) ! ; \ node is new last \ NOTE: If the application only builds lists but never removes \ anything from them, all words beyond this point can be omitted. : ddunlink ( node -- ) ( Assume that node is in the current list. Unlink it. Note: This code is identical to that for SDUNLINK up to the last ELSE clause. ) ( node) dup cell+ ( prev) @ ( node before) over ( nx) @ LOCALS| after before node | before IF \ node is not first after before ( nx) ! \ before -> after ELSE after current-list ( head) ! \ after is new first THEN after IF \ node is not last before after cell+ ( prev) ! \ after <- before ELSE before current-list cell+ ( tail) ! \ before is new last THEN ; : ddunuse ( node -- ) ( Assume that node is in the current list. Unlink it and link it into the unused chain in the current node space. ) ( node) dup ddunlink ( node) unuse-node ; \ *** STACK AND QUEUE OPERATIONS ( Together with DDPREPEND, the two words DDUNLINK-FIRST and DDUNUSE-FIRST below implement the basic push, pop, and drop operations for a stack, i.e., a LIFO list. Together with DDAPPEND, they implement the basic append, pop-first, and drop-first operations for a queue, i.e, a FIFO list. In addition, the words DDUNLINK-LAST and DDUNUSE-LAST below are natural for double-ended, double-linked lists. ) : ddunlink-first ( -- node|0 ) ( If the current list is not empty, unlink and leave its first node. Otherwise leave zero. Note: Except for the ELSE clause, this code is almost identical to that for SDUNLINK-FIRST. ) 0 current-list ( head) @ LOCALS| first second | first ( nonempty?) IF first @ to second second current-list ( head) ! \ second is new first 0 second IF \ new list nonempty ( 0) second cell+ ( prev) ! \ second <- zero ELSE \ new list empty ( 0) current-list cell+ ( tail) ! THEN THEN first ; \ current-list ( head) @ ( first) dup \ ( nonempty?) IF \ ( first) dup @ ( second) dup \ current-list ( head) ! \ second is new head \ ( second) dup IF \ new list nonempty \ 0 swap ( 0 second) cell+ ( prev) ! \ second <- zero \ ELSE \ new list empty \ ( second) drop 0 current-list cell+ ( tail) ! \ THEN ( first) \ THEN ( first) ; : ddunuse-first ( -- ) ( If the current list is not empty, unlink its first node, and link it into the unused chain in the current node space. Otherwise do nothing. ) ddunlink-first ( node|0) unuse-node ; : ddunlink-last ( -- dnode|0 ) ( If the current list is not empty, unlink and leave its last node. Otherwise leave zero. ) 0 current-list cell+ ( tail) @ LOCALS| last nxlast | last ( nonempty?) IF last cell+ ( prev) @ to nxlast nxlast current-list cell+ ( tail) ! \ nxlast is new tail 0 nxlast IF \ new list nonempty ( 0) nxlast ( nx) ! \ nxlast <- zero ELSE \ new list empty ( 0) current-list ( head) ! THEN THEN last ; \ current-list cell+ ( tail) @ ( last) dup \ ( nonempty?) IF \ ( last) dup cell+ ( prev) @ ( nxlast) dup \ current-list cell+ ( tail) ! \ nxlast is new tail \ ( nxlast) dup IF \ new list nonempty \ 0 swap ( 0 nxlast) ( nx) ! \ nxlast <- zero \ ELSE \ new list empty \ ( nxlast) drop 0 current-list ( head) ! \ THEN ( last) \ THEN ( last) ; : ddunuse-last ( -- ) ( If the current list is not empty, unlink its last node, and link it into the unused chain in the current node space. Otherwise do nothing. ) ddunlink-last ( node|0) unuse-node ;