retroforth/example/queue.retro

# FIFO Queue

This implements a FIFO queue. It was based on the code in
a comp.lang.forth post titled "A queue without move", but
has been refactored and expanded slightly. See
https://narkive.com/khcCauFY for the original posting.

# Limits

The queue size needs to be a power of 2.

# Code

~~~
:q:new    (n-a) here [ #0 , #0 , dup , allot ] dip ;
:q:named  (ns-) [ q:new ] dip const ;
:q:head   (q-a) ; immediate
:q:tail   (q-a) n:inc ;
:q:size   (q-n) #2 + fetch ;
:q:list   (q-a) #3 + ;
:q:mask   (q-n) q:size n:dec ;
:q:length (q-n) [ q:head fetch ] [ q:tail fetch ] bi - ;
:q:free   (q-n) &q:size sip q:length - ;
:q:clear  (q-)  [ q:head v:off ] [ q:tail v:off ] bi ;
:q:masked (aq-n) q:mask swap fetch and ;
:q:empty? (q-f)  q:length n:zero? ;
:q:full?  (q-f)  &q:length &q:size bi eq? ;
:q:reset0 (q-)   dup q:empty? &q:clear &drop choose ;

{{
  'R var

  (for_adding_values)
  :append-value swap @R q:list @R q:head @R q:masked + store
                @R q:head v:inc ;
 
  (for_fetching_values)
  :peek-value   @R q:list  @R q:tail @R q:masked + fetch ;
  :fetch-value  peek-value @R q:tail v:inc swap @R q:reset0 ;
---reveal---
  :q:add (nq-f)
    [ !R ] [ q:free n:strictly-positive? dup ] bi
    [ append-value ] if; nip ;

  :q:get (q-nf)
    [ !R ] [ q:length n:strictly-positive? dup ] bi
    [ fetch-value ] if; #0 swap ;

  :q:peek (q-nf)
    [ !R ] [ q:length n:strictly-positive? dup ] bi
    [ peek-value swap ] if; #0 swap ;
}}
~~~

I am separating out the display code as it's fairly large
and some may want to leave it out. (When compiled, this
increases the size by more than 50%. While useful, the size
hit may make it undesirable on systems with tight memory
constraints)

~~~
{{
  'R var

  (for_display)
  :head?    @R q:tail @R q:masked eq? ;
  :tail?    @R q:head fetch n:dec @R q:mask and eq? ;
  :display  nl I dup n:put sp dup @R q:list + fetch n:put sp ;
  :indicators dup head? [ '<--_tail s:put ] if
                  tail? [ '<--_head s:put ] if ;
---reveal---
  :q:put (q-)
    [ !R ] [ q:free ] [ q:length ] tri
    '\nin_que:_%n,_free:_%n s:format s:put
    @R q:length n:strictly-positive?
    [ @R q:size [ display indicators ] times<with-index> ]
    [ 'queue_is_empty s:put nl ] choose ;
}}
~~~

# Usage

The original didn't include any documentation, so here are a few
brief notes on this.

Creating a new queue:

    q:new
    q:named

Examples:

    #16 q:new        (returns_a_pointer_to_the_queue)
    #16 'Q q:named   (create_a_queue_and_create_a_constant)
                     (pointing_to_it)

See the Limits section for a note on the sizing.

Adding Values:

    #1 Q q:add
    #2 Q q:add

The `q:add` returns a flag indicating success or fail. Check or
discard this as necessary for your application.

Retreive Values:

    Q q:get
    Q q:get

Like `q:add`, this returns a flag indicating success or failure.
This also returns the value, or a value of 0 on failure.

Empty the Queue:

    Q q:clear

Queue Queries:

    Q q:size
    Q q:length

# A Test

```
#16 'Q q:named
Q q:empty? n:put nl
#100 Q q:add drop
Q q:empty? n:put nl
Q q:get drop-pair
Q q:empty? n:put nl nl

Q q:full? n:put nl
#16 [ #100 Q q:add drop ] times
Q q:full? n:put nl
Q q:size [ Q q:get drop-pair ] times
Q q:full? n:put nl nl

#100 Q q:add
#200 Q q:add
#300 Q q:add
#400 Q q:add
#500 Q q:add dump-stack nl reset
Q q:put
nl 'values:_ s:put
Q q:get drop n:put sp
Q q:get drop n:put sp
Q q:peek drop n:put sp
Q q:peek drop n:put sp
Q q:peek drop n:put sp
Q q:get drop n:put sp
Q q:get drop n:put nl nl
Q q:put
```