retroforth/interface/ll.retro
crc 3eec5480ab make some small optimizations to some fll: words
FossilOrigin-Name: 767c0b08d5e9ddd854a15027d025aa1b89f5359c67718b0bf51e2a06c2996f71
2023-10-23 16:08:18 +00:00

171 lines
4.2 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 ;
}}
~~~
## Add Source Data
~~~
'interface/ll.retro s:keep
dup 'comma d:lookup d:source store
dup 'cdr d:lookup d:source store
dup 'cons d:lookup d:source store
dup 'car d:lookup d:source store
dup 'cdr d:lookup d:source store
dup 'car@ d:lookup d:source store
dup 'cdr@ d:lookup d:source store
dup 'car! d:lookup d:source store
dup 'cdr! d:lookup d:source store
dup 'END d:lookup d:source store
dup 'fll:put d:lookup d:source store
dup 'fll:inject d:lookup d:source store
dup 'fll:drop d:lookup d:source store
dup 'fll:length d:lookup d:source store
dup 'fll:for-each d:lookup d:source store
dup 'fll:del d:lookup d:source store
dup 'fll:to-index d:lookup d:source store
dup 'fll:append/value d:lookup d:source store
dup 'fll:to-end d:lookup d:source store
dup 'fll:create d:lookup d:source store
drop
~~~