mirror of
https://git.sr.ht/~crc_/retroforth
synced 2024-11-16 19:48:56 +01:00
15b8169ce4
FossilOrigin-Name: 700ca74a200346f7542002663d11261aa4889be1778b4c2ea1f398b18d4e6bc1
143 lines
3.4 KiB
Forth
143 lines
3.4 KiB
Forth
# Forward Linked Lists
|
|
|
|
(c) Arland Childers
|
|
|
|
~~~
|
|
:comma , ;
|
|
~~~
|
|
|
|
The basic building block of our lists is a *cons cell*. This is
|
|
a tuple with two values. The first of these is the *car*, and
|
|
the second is the *cdr*. (Naming of these comes from LISP, and
|
|
some very old computer processors)
|
|
|
|
In memory a cons cell with two values (1, 2) would look like:
|
|
|
|
+---+-----+
|
|
| 1 | car |
|
|
+---+-----+
|
|
| 2 | cdr |
|
|
+---+-----+
|
|
|
|
We provide `cons` to make a cons cell, `car` to get a pointer to
|
|
the first element, and `cdr` to get a pointer to the second.
|
|
|
|
We also provide `car@` and `car!` to read or modify the car
|
|
value, and `cdr@` and `cdr!` for doing the same to the cdr.
|
|
|
|
~~~
|
|
:cons (car,cdr-ptr) here [ swap comma comma ] dip ;
|
|
:car (cons-ptr) ;
|
|
:cdr (cons-ptr) n:inc ;
|
|
|
|
:car@ (cons-value) car fetch ;
|
|
:car! (value,cons-) car store ;
|
|
:cdr@ (cons-value) cdr fetch ;
|
|
:cdr! (value,cons-) cdr store ;
|
|
~~~
|
|
|
|
With this out of the way, we turn to lists. A list, in this
|
|
model, is a series of cons cells. We are working with forward
|
|
linked lists, so each cons cell points to the next one in the
|
|
chain. (Back linked lists, or doubly linked lists, are not
|
|
implemented at this time). A list of values 1, 2, and 3 would
|
|
look like:
|
|
|
|
|
|
+---+---+ +---+---+ +---+---+
|
|
| 1 | =====> | 2 | =====> | 3 | =====> END
|
|
+---+---+ +---+---+ +---+---+
|
|
|
|
`END` is an empty word that we use to denote the end of a list.
|
|
We'll compare the contents of the CDR field to this to determine
|
|
if we've reached the end. This could equally well be zero, but
|
|
we decided it was better for readability to have a named element.
|
|
|
|
~~~
|
|
:END (-) ;
|
|
~~~
|
|
|
|
Creation of a list begins with `fll:create`. This takes in a
|
|
value, and creates a cons cell with the value, and a pointer
|
|
to END in the cdr.
|
|
|
|
~~~
|
|
:fll:create (v-p) &END cons ;
|
|
~~~
|
|
|
|
Many operations will need to access the end of the list. We have
|
|
`fll:to-end` to seek this. It'll walk through the list, returning
|
|
a pointer to the final cons cell.
|
|
|
|
~~~
|
|
{{
|
|
'r var
|
|
---reveal---
|
|
:fll:to-end (p-p)
|
|
dup !r [ cdr@ dup &END -eq? dup
|
|
[ over !r ] [ nip ] choose ] while @r ;
|
|
}}
|
|
~~~
|
|
|
|
Appening a value is simple. Create a new cons with the value in
|
|
the car and a pointer to END in the cdr. Find the end of the
|
|
list, and update the cdr to point to the new cons.
|
|
|
|
~~~
|
|
:fll:append/value (pv-) &END cons swap fll:to-end cdr! ;
|
|
~~~
|
|
|
|
Given a specific node in the list, follow the cdr chain until
|
|
the node number is reached. Starts at zero.
|
|
|
|
An issue with this: it does not currently check the length to
|
|
make sure that the index is valid.
|
|
|
|
~~~
|
|
:fll:to-index (pn-p) [ cdr@ ] times ;
|
|
~~~
|
|
|
|
|
|
~~~
|
|
:fll:del
|
|
dup-pair n:dec fll:to-index [ n:inc fll:to-index ] dip cdr! ;
|
|
~~~
|
|
|
|
The `fll:for-each` runs a quote once for each value in a list.
|
|
|
|
~~~
|
|
{{
|
|
'Action var
|
|
---reveal---
|
|
:fll:for-each (aq-)
|
|
!Action [ [ car@ @Action call ] sip cdr@ dup &END -eq? ]
|
|
while drop ;
|
|
}}
|
|
~~~
|
|
|
|
To obtain the length of a list (in number of cons) use
|
|
`fll:length`.
|
|
|
|
~~~
|
|
:fll:length (p-n) #0 swap [ drop n:inc ] fll:for-each n:dec ;
|
|
~~~
|
|
|
|
`fll:drop` removes the a specified cons from a list.
|
|
|
|
~~~
|
|
:fll:drop dup fll:length n:dec fll:to-index &END swap cdr! ;
|
|
~~~
|
|
|
|
`fll:inject` adds a new cons to a list, inserting at a specified
|
|
point.
|
|
|
|
~~~
|
|
{{
|
|
'i var
|
|
---reveal---
|
|
:fll:inject (piv-)
|
|
fll:create !i dup-pair n:dec fll:to-index
|
|
&fll:to-index dip @i swap cdr! @i cdr! ;
|
|
:fll:put (a-) [ n:put sp ] fll:for-each ;
|
|
}}
|
|
~~~
|