Queue in Forth on Rosetta Code

[foxaudio...@gmail.com]

I added another "tutorial" type entry in Rosetta.

http://rosettacode.org/wiki/Queue/Usage#Forth

Is this kind of approach I am using detrimental or supporting Forth?

I know I am not a gift to the Forth world, but I felt that my simplistic approaches may allow those with little to no familiarity with the language to grasp some of the power of Forth.

Happy to desist if the consensus is negative.

BF

[Julian Fondren]

On Thursday, February 4, 2016 at 8:29:09 PM UTC-6, foxaudio...@gmail.com wrote:
> I added another "tutorial" type entry in Rosetta.

Great! I hope that you continue. I like seeing Forth, and I support
your goals, and I can't imagine how much more apologetic you can get
with these posts before you start threatening self-harm if you aren't
expressively forgiven for making them.

>
> http://rosettacode.org/wiki/Queue/Usage#Forth
>
> Is this kind of approach I am using detrimental or supporting Forth?
>

Here are some questions I think someone would ask, reading this:

1. why is it in hex?

2. why does it begin with FORTH DEFINITIONS ?

3. is DOES> necessary, where it appears to CQUEUE: ?

4. why must the queue size be a power of 2?

5. why does Qempty return a flag?

6. some of the words seem to be randomly in lowercase. Is that
stylistic? What style is being followed? Should that be imitated?

7. is this the normal or usual way to do data structures?

8. if this is purposely verbose, what would a more idiomatic or
purposely terse version look like? Although RosettaCode probably
has use to language learners, the goal I believe is to see the
languages as they're actually used, so these disclaimers detract
rather than add to an entry.


In some of the RC tasks you'll see a lot of variations of entry from
the same language, done in different ways (like the Go entries on this
page). This task in particular seems like it'd benefit from that from
Forth, whereas I expect most other languages are just going to show you
how a particular builtin data structure can be used as a queue.


-- Julian

[Anton Ertl]

foxaudio...@gmail.com writes:
>I added another "tutorial" type entry in Rosetta.
>
>http://rosettacode.org/wiki/Queue/Usage#Forth
>
>Is this kind of approach I am using detrimental or supporting Forth?

Probably more supportive than detrimental.

You did not ask for a critique, but still:

DOES> is pointless here, because the action is just the same as
without DOES>.

I would not use a defining word for creating the queue anyway; it
reduces the generality. A word that just creates the structure in
memory and returns the address can be used more flexibly.

For ->HEAD etc. you could use the Forth-2012 field words, i.e.:

0
field: ->head
field: ->tail
...
constant queue-size

- anton
--
M. Anton Ertl http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
New standard: http://www.forth200x.org/forth200x.html
EuroForth 2015: http://www.rigwit.co.uk/EuroForth2015/

[jo...@planet.nl]

Hi,

Nice code.

In Win32Forth I would have ->HEAD defined as:

: ->HEAD ( q -- adr ) ; IMMEDIATE

Jos

[Albert van der Horst]

Nice entry.

I miss the sentence:
"In the context of Forth a circular buffer is more appropriate than a linked
list. It implies that the buffer can get full and size is restricted to
powers of 2."

(Most implementations would use a linked list that in the end may consume
all of the memory. Something like that would be possible in Forth, but your
entry is a typical Forth solution. The sentence conveys that is it not
a weakness but a different purpose.)

>BF
--
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

[WJ]

foxaudio...@gmail.com wrote:

> I added another "tutorial" type entry in Rosetta.
>
> http://rosettacode.org/wiki/Queue/Usage#Forth
>
> Is this kind of approach I am using detrimental or supporting Forth?

Ruby:

q = [] ;
# Odd numbers are appended; even numbers are prepended.
9.times{|i| q.send(i.odd? ? :push : :unshift, i)} ;
p q ;
print q.pop, " " until q.empty?

[8, 6, 4, 2, 0, 1, 3, 5, 7]
7 5 3 1 0 2 4 6 8 ==>nil

--
The report card by the American Society of Civil Engineers showed the national
infrastructure a single grade above failure, a step from declining to the point
where everyday things simply stop working the way people expect them to. ---
washingtonpost.com/local/trafficandcommuting/us-infrastructure-gets-d-in-annual-report/2013/03/19/c48cb010-900b-11e2-9cfd-36d6c9b5d7ad_story.html

[foxaudio...@gmail.com]

Excellent comments Julian. I will apply these thoughts.

LOL, I have not seen a shrink yet. I am somewhat self conscious since I have not worked in an Engineering department for over 25 years now. But I have a great enthusiasm for Forth as a way to expose rank and file programmers to the underlying elements of computing that so many today do not seem to understand.

I think being introduced to even a seminar of Forth in every CS and EE curriculum would have an impact on what we see in the computing world.

And thank you to all others who contributed. I will take these ideas and apply them to the RC post.

And a special thanks has to go to WJ for the Ruby tutorial.

BF

[Anton Ertl]

foxaudio...@gmail.com writes:
>I added another "tutorial" type entry in Rosetta.
>
>http://rosettacode.org/wiki/Queue/Usage#Forth

I think the implementation part of your queue is on the wrong page.
It should be there:

http://rosettacode.org/wiki/FIFO

This page already contains a circular buffer version, and I have now
added the linked-list version below. I thought I could demonstrate
the utility of being able to take the address of a field, which you
can do in Forth, but not in Java, but actually that does not buy
anything in this example: The Java version has a special case on
enqueue, this version has a special case on dequeue. This code was
pretty nasty to debug.

0
field: list-next
field: list-val
constant list-struct

: insert ( x list-addr -- )
list-struct allocate throw >r
swap r@ list-val !
dup @ r@ list-next !
r> swap ! ;

: remove ( list-addr -- x )
>r r@ @ ( list-node )
r@ @ dup list-val @ ( list-node x )
swap list-next @ r> !
swap free throw ;

0
field: queue-last \ points to the last entry (head of the list)
field: queue-nextaddr \ points to the pointer to the next-inserted entry
constant queue-struct

: init-queue ( queue -- )
>r 0 r@ queue-last !
r@ queue-last r> queue-nextaddr ! ;

: make-queue ( -- queue )
queue-struct allocate throw dup init-queue ;

: empty? ( queue -- f )
queue-last @ 0= ;

: enqueue ( x queue -- )
dup >r queue-nextaddr @ insert
r@ queue-nextaddr @ @ list-next r> queue-nextaddr ! ;

: dequeue ( queue -- x )
dup empty? abort" dequeue applied to an empty queue"
dup queue-last remove ( queue x )
over empty? if
over init-queue then
nip ;

[Raimond Dragomir]

The following is possible in my forth
( ) words are quotations or anonymous definitions, not comments.
This is inspired from Ron's 8th. :)
I used a wordlist to make the fields names and some other internal
words "local".


\ ================================================== raimond....@gmail.com
\ Fifos (Queues)
\ v1.23 12jan2016
\ =============================================================================
\ usage:
\ 64 cfifo:new G G is a 64 byte fifo
\ 64 hfifo:new G G is a 64 x 16bit fifo (128 bytes buffer)
\ 64 fifo:new G G is a 64 cells fifo (256 bytes buffer for 32bit cell)
\ then we have the following words:
\ G -- a address of the whole fifo structure (good for dump)
\ G:reset -- reset the G fifo
\ G:empty? -- f is the G fifo empty?
\ G:full? -- f is the G fifo full?
\ G:put x -- f put x on G fifo, return T if succes, F if fifo full
\ G:get -- x f get x from G fifo, return T if succes, F if fifo empty
\ G:len -- x the number of elements in the G fifo
\ G:avail -- x the number of empty (available) slots in the G fifo

wordlist fifoW \ wordlist for internal fifo words
fifoW also \ make it available in search order
current@ \ save current on the data stack
fifoW current! \ set fifoW current

\ General fifo structure
0 w field .in \ in pointer
w field .out \ out pointer
w field .start \ start of the fifo buffer
w field .end \ end of the fifo buffer
constant fifo

\ The entire fifo data structure will consists of the above header followed
\ by the actual data buffer.

: ff:mod \ oldx ff -- newx
>r dup r@ .end @ = if drop r@ .start @ then r>drop ;

: ff:empty? \ ff -- f
dup .out @ swap .in @ = ;

: ff:full? \ ff -- f
dup .in @ over .out @ 1+ rot ff:mod = ;

: ff:reset \ ff --
dup>r .start @ dup r@ .in ! r> .out ! ;

: ff:init \ a u ff -- , u is in bytes
>r over + r@ .end ! r@ .start ! r> ff:reset ;

\ ---------------------- 8bit fifo ----------------------------
: ff:c! \ c ff -- f
dup>r .in @ dup 1+ r@ ff:mod
dup r@ .out @ = if \ full
2nip r> 2drop false exit
then
r> .in !
c! true ; \ store byte in fifo, return true

: ff:c@ \ ff -- c f
dup>r .out @ dup r@ .in @ = if r>drop false exit then \ empty
dup c@ \ fetch byte from fifo
swap 1+ r@ ff:mod r> .out ! true ;

: ff:c# \ ff -- n, used space in bytes
dup>r .in @ r@ .out @ - dup 0< if
r@ .end @ + r@ .start @ -
then
r>drop ;

: ff:c? \ ff -- n, available space in bytes
dup>r .end @ r@ .start @ - r> ff:c# - 1- ;

\ --------------------- 16bit fifo ----------------------------
: ff:h! \ h ff -- f
dup>r .in @ dup 2 + r@ ff:mod
dup r@ .out @ = if \ full
2nip r> 2drop false exit
then
r> .in !
h! true ; \ store h in fifo, return true

: ff:h@ \ ff -- h f
dup>r .out @ dup r@ .in @ = if r>drop false exit then \ empty
dup h@ \ fetch h from fifo
swap 2 + r@ ff:mod r> .out ! true ;

: ff:h# \ ff -- n, used space in bytes
dup>r .in @ r@ .out @ - dup 0< if
r@ .end @ + r@ .start @ -
then 2/
r>drop ;

: ff:h? \ ff -- n, available space in bytes
dup>r .end @ r@ .start @ - 2/ r> ff:h# - 1- ;

\ --------------------- 32bit fifo ----------------------------
: ff:! \ x ff -- f
dup>r .in @ dup cell+ r@ ff:mod
dup r@ .out @ = if \ full
2nip r> 2drop false exit
then
r> .in !
! true ; \ store in fifo, return true

: ff:@ \ ff -- x f
dup>r .out @ dup r@ .in @ = if r>drop false exit then \ empty
dup @ \ fetch from fifo
swap cell+ r@ ff:mod r> .out ! true ;

: ff:# \ ff -- n, used space in bytes
dup>r .in @ r@ .out @ - dup 0< if
r@ .end @ + r@ .start @ -
then 2/ 2/
r>drop ;

: ff:? \ ff -- n, available space in bytes
dup>r .end @ r@ .start @ - 2/ 2/ r> ff:# - 1- ;

\ ---------- defining words -----------------------------------

: fifonew \ size n <name> -- str len ptr
here @ >r \ n size R: ptr ptr points to our memory area (fifo ptr)
>r \ size R: ptr n n is cell size of the fifo
bl parse \ size str len
2dup (data) \ <name> is just as any other var
rot 1+ \ str len size+1 buffer size is one more item
r> * \ str len size R: ptr size is in bytes now
dup fifo + allot \ allocate the fifo structure + buffer
r@ fifo + \ str len size adr adr is the fifo buffer address
swap \ str len adr size size is the fifo buffer size
r@ ff:init \ str len R: ptr init the fifo
2dup s" :clear" strcat ( @ ff:reset ) (build) r@ ,
2dup s" :empty?" strcat ( @ ff:empty? ) (build) r@ ,
2dup s" :full?" strcat ( @ ff:full? ) (build) r@ ,
r> ; \ str len ptr


current! \ restore current to compile the public words

: cfifo:new \ len <name> --
c fifonew >r
2dup s" :put" strcat ( @ ff:c! ) (build) r@ ,
2dup s" :get" strcat ( @ ff:c@ ) (build) r@ ,
2dup s" :len" strcat ( @ ff:c# ) (build) r@ ,
s" :avail" strcat ( @ ff:c? ) (build) r> ,
;

: hfifo:new \ len <name> --
h fifonew >r
2dup s" :put" strcat ( @ ff:h! ) (build) r@ ,
2dup s" :get" strcat ( @ ff:h@ ) (build) r@ ,
2dup s" :len" strcat ( @ ff:h# ) (build) r@ ,
s" :avail" strcat ( @ ff:h? ) (build) r> ,
;

: fifo:new \ len <name> --
w fifonew >r
2dup s" :put" strcat ( @ ff:! ) (build) r@ ,
2dup s" :get" strcat ( @ ff:@ ) (build) r@ ,
2dup s" :len" strcat ( @ ff:# ) (build) r@ ,
s" :avail" strcat ( @ ff:? ) (build) r> ,
;

previous \ take out the fifoW from search order

[WJ]

foxaudio...@gmail.com wrote:

> I added another "tutorial" type entry in Rosetta.
>
> http://rosettacode.org/wiki/Queue/Usage#Forth
>

Oforth:

: foo3 |q|
ListBuffer new -> q
4 #[ q add ] seqEach
q println
while(q notEmpty) [ q removeFirst . ]
;

>foo3
[1, 2, 3, 4]
1 2 3 4 ok



--

[franck....@gmail.com]

This code shows a bug (introduced by the last version) on #seqEach with
the changes on the parameters order.

All HOF have the same form : ( aWord aCollection -- ...).
A HOF will take aWord as parameter and perform something on aCollection
(the receiver)

#seqEach had the same interaction with the stack :
seqEach ( aWord n -- ... )

But with the change of order for parameters, interaction has changed.
Call to seqEach should be :
#[ q add ] 4 seqEach

I will correct this as soon as possible and make seqEach a method of
Integer class instead of a word... Thank you for reporting this bug.

Franck