Coroutining by continuations

[humptydumpty]

Hi!

Have some fun with co-routines! :)

Output first :)

gforth coroutines.fs -e 'cr .s cr bye'
a00a10a20a01a11a21a12<0>

Hello Hi
World! There!
Hello Hi
World! There!
Hello Hi
World! There!
Hello Hi
World! There!
Hello Hi
World! There!
Hello Hi
World! There! <0>

012 :
345 :
678 :
9.
<0>

2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97
<0>


Now, sources :)


\ coroutine.fs Coroutines by continuations.
\ Author: humptydumpty.
\ Free to everyone, just preserve freedom.

\ --- HELPER words:
VARIABLE Head VARIABLE Tail
\ Continuations Queue: make it big enough.
CREATE CQ 16384 cells ALLOT HERE CONSTANT CQ-END
: inspect-cq
CQ CQ-END over - dump
;
: advance ( a -- )
1 cells over +!
dup @ CQ-END =
IF
CQ swap !
ELSE drop THEN
;
: >co ( n -- )
Head @ dup
@ ABORT" Queue overflow." \ safe-guard
!
Head advance
;
: co> ( -- n )
Tail @ @
0 Tail @ ! \ for debuging or safe-guarding
Tail advance
;
: co-start co> >R ;

\ --- USER words:
\ Init queue
: CO-INIT ( -- )
CQ CQ-END over - 0 fill \ for debuging or safe-guarding
CQ Head ! CQ Tail !
;
\ Put continuation into queue-head; exit current word.
: CO: ( -- ) R> >co ;
\ Put current continuation into queue-head; continue with queue-tail.
: CO ( -- ) R> >co co> >R ;
\ Run continuations coroutining.
: GO ( -- ) BEGIN Head @ Tail @ <> WHILE co-start REPEAT ;

\ TEST:

1 [IF]
: a0 co: ." a00" co ." a01" co ;
: a1 co: ." a10" co ." a11" co ." a12" co ;
: a2 co: ." a20" co ." a21" co ;
co-init a0 a1 a2 GO .s \ inspect-cq


VARIABLE QUIT? QUIT? OFF
VARIABLE Cnt
: timer ( -- )
QUIT? OFF 0 Cnt !
CO:
BEGIN
500 ms CR
1 Cnt +!
CO
Cnt @ 12 =
UNTIL
QUIT? ON
;
: hello ( -- )
CO:
BEGIN
." Hello "
CO
." World! "
CO
QUIT? @
UNTIL
;
: hi ( -- )
CO:
BEGIN
." Hi "
CO
." There! "
CO
QUIT? @
UNTIL
;
cr co-init timer hello hi GO .s cr


warnings off
CHAR . CONSTANT '.'
CHAR : CONSTANT ':'
CHAR 0 CONSTANT '0'
warnings on
VARIABLE mychar

: printer ( -- )
CO:
BEGIN
CR
mychar @ '.' <> WHILE mychar @ EMIT CO
mychar @ '.' <> WHILE mychar @ EMIT CO
mychar @ '.' <> WHILE mychar @ EMIT CO
2 SPACES ':' EMIT
REPEAT THEN THEN
mychar @ EMIT
;
: generator ( -- )
CO:
10 0 DO
'0' I + mychar !
CO
LOOP
'.' mychar !
;
co-init generator printer GO cr .s cr


VARIABLE X VARIABLE PRIME?

: div? mod 0= 0= ;

: 2to100
QUIT? OFF
CO:
101 2
DO
PRIME? ON
I X !
CO
LOOP
QUIT? ON
;
: primes
CO:
BEGIN
PRIME? @
IF
X ?
:noname
]]
CO:
BEGIN
X @ [[ X @ ]] LITERAL div?
PRIME? @ AND PRIME? !
CO
QUIT? @ UNTIL
; [[ execute
THEN
CO
QUIT? @ UNTIL
;
cr co-init 2to100 primes GO

[THEN]


--
Have a nice day,
humptydumpty

[humptydumpty]

A little more polished:

\ co.fs Coroutines by continuations.

\ *
\ * Circular Queue
\ *

VARIABLE HEAD VARIABLE TAIL
128 CELLS CONSTANT CQ#

\ align by capacity
HERE
DUP CQ# 1- INVERT AND CQ# +
SWAP - ALLOT

HERE CQ# ALLOT CONSTANT START

: ADJUST [ CQ# 1- ]L AND START + ;
: PUT TAIL @ TUCK ! CELL+ ADJUST TAIL ! ;
: TAKE HEAD @ DUP @ SWAP CELL+ ADJUST HEAD ! ;
: 0CQ START DUP HEAD ! TAIL ! ; 0CQ
: NOEMPTY? HEAD @ TAIL @ <> ;


\ *
\ * COROUTINES LEXEME
\ *

\ -- Serve first. --
: ;CO TAKE >R ;

\ -- Register continuation as coroutine.
\ Exit current definition. --
: CO: R> PUT ;

\ -- Coroute. --
: CO R> PUT TAKE >R ;

\ -- Put into action registered coroutines. --
: GO BEGIN NOEMPTY? WHILE ;CO REPEAT ;

and a little test:

\ test-co.fs

include co.fs

warnings off
CHAR . CONSTANT '.'
CHAR : CONSTANT ':'
CHAR 0 CONSTANT '0'
warnings on
VARIABLE mychar

: printer ( -- )
CO:
BEGIN
CR
mychar @ '.' <> WHILE mychar @ EMIT CO
mychar @ '.' <> WHILE mychar @ EMIT CO
mychar @ '.' <> WHILE mychar @ EMIT CO
2 SPACES ':' EMIT
REPEAT THEN THEN
mychar @ EMIT
;
: generator ( -- )
CO:
10 0 DO
'0' I + mychar !
CO
LOOP
'.' mychar !
;

generator printer GO cr

VARIABLE QUIT? VARIABLE X

: div? mod 0= 0= ;
: gte2 ( u -- ; generate numbers from 2 to 'U' )
-1 QUIT? OFF
CO:
SWAP 1+ 2 ( prime? u 2 )
DO
DROP -1 ( prime? )

I X !
CO
LOOP
QUIT? ON
;

: co:prime ( -- ; compile and register a new PRIME coroutine )
:noname
]]
CO:
BEGIN
X @ [[ X @ ]] LITERAL div? AND

CO
QUIT? @ UNTIL
; [[ execute

;
: primes ( prime? -- )
CO:
BEGIN
DUP
IF
X ?
co:prime

THEN
CO
QUIT? @ UNTIL

DROP
;
80 gte2 primes GO

cr .s cr BYE


and output:

~/src$ gforth test-co.fs

012 :
345 :
678 :
9.

2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79

<0>

[humptydumpty]

More fun with files & coroutines! (under Gforth 0.7.3)

\ futils.fs Experiment of coroutines on files.
include co.fs

VARIABLE FD0
VARIABLE FD1
VARIABLE READ#
VARIABLE QUIT?

4096 CONSTANT LBUF#
CREATE LBUF LBUF# ALLOT
CREATE CRLF 1 C, 10 C, ALIGN

: READ ( ca u -- )
R/O OPEN-FILE THROW FD0 !
CO: BEGIN
QUIT? @ 0=
WHILE
LBUF [ LBUF# CRLF C@ - ]L
FD0 @ READ-LINE THROW
WHILE
READ# ! CO
REPEAT DROP THEN
FD0 @ CLOSE-FILE THROW
QUIT? ON
;
: WRITE ( ca u -- )
W/O OPEN-FILE THROW FD1 !
CO: BEGIN
QUIT? @ 0=
WHILE
CRLF COUNT LBUF READ# @ + SWAP MOVE
LBUF READ# @ [ CRLF C@ ]L +
FD1 @ WRITE-FILE THROW
CO
REPEAT
FD1 @ CLOSE-FILE THROW
;
: DISPLAY ( -- )
CO: BEGIN
QUIT? @ 0=
WHILE
LBUF READ# @ TYPE CRLF COUNT TYPE
CO
REPEAT
;
VARIABLE CONTOR
: FIRST ( u -- )
CONTOR !
CO: BEGIN
QUIT? @ 0=
WHILE
CONTOR @
WHILE
-1 CONTOR +!
CO
REPEAT THEN
QUIT? ON
;
: KB ( "CHAR" -- )
CO: BEGIN
QUIT? @ 0=
WHILE
KEY DUP [CHAR] q <> SWAP [CHAR] Q <> AND
WHILE
CO
REPEAT THEN
QUIT? ON
;


Now some tests :)

~/src$ echo -n > temp.txt
~/src$ gforth futils.fs -e 's" ct.help" read 10 first display s" temp.txt" write GO .s cr bye'
USAGE:

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ COROUTINES

VARIABLE QUIT? QUIT? OFF
VARIABLE Cnt
: timer

QUIT? OFF 0 Cnt !
CO:
BEGIN

<0>
~/src$ cat temp.txt
USAGE:

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ COROUTINES

VARIABLE QUIT? QUIT? OFF
VARIABLE Cnt
: timer

QUIT? OFF 0 Cnt !
CO:
BEGIN

~/src$ echo -n > temp.txt
~/src$ gforth futils.fs -e 's" ct.help" read 10 first display s" temp.txt" write kb GO .s cr bye'
USAGE:

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ COROUTINES

VARIABLE QUIT? QUIT? OFF
<0>
~/src$ cat temp.txt
USAGE:

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ COROUTINES

VARIABLE QUIT? QUIT? OFF
bo@bo-lap:~/src$


second time, at sixth line pushed 'q' to exit :)

[humptydumpty]

A little more robust version, 'yesno' added.

\ futils.fs Experiment of coroutines on files.
include co.fs

VARIABLE FD0
VARIABLE FD1
VARIABLE READ#

VARIABLE QUIT? QUIT? OFF

4096 CONSTANT LBUF#
CREATE LBUF LBUF# ALLOT
CREATE CRLF 1 C, 10 C, ALIGN

: READ ( ca u -- )

QUIT? OFF

R/O OPEN-FILE THROW FD0 !
CO: BEGIN
QUIT? @ 0=
WHILE
LBUF [ LBUF# CRLF C@ - ]L
FD0 @ READ-LINE

DUP IF
QUIT? ON
CO
FD0 @ CLOSE-FILE THROW
THEN

THROW
WHILE
READ# ! CO
REPEAT DROP THEN
FD0 @ CLOSE-FILE THROW
QUIT? ON
;
: WRITE ( ca u -- )
W/O OPEN-FILE THROW FD1 !
CO: BEGIN
QUIT? @ 0=
WHILE
CRLF COUNT LBUF READ# @ + SWAP MOVE
LBUF READ# @ [ CRLF C@ ]L +
FD1 @ WRITE-FILE

DUP IF
QUIT? ON
CO
FD1 @ CLOSE-FILE THROW
THEN

: SKIP-CO
R> PUT TAKE PUT TAKE >R
;
: YESNO

CO: BEGIN
QUIT? @ 0=
WHILE

KEY DUP [CHAR] n = SWAP [CHAR] N = OR
IF SKIP-CO ELSE CO THEN
REPEAT
;

Enjoy! :)

[hughag...@gmail.com]

On Tuesday, October 4, 2016 at 3:05:20 AM UTC-7, humptydumpty wrote:
> Enjoy! :)
>
> --
> Have a nice day,
> humptydumpty

I'm looking into it. Thanks for your work --- you are one of only a tiny number of people on comp.lang.forth who are doing any creative thinking --- most of the comp.lang.forth crowd spend all of their time braying about how ANS-Forth and now Forth-200x set the Standard for the entire Forth community, and how all Forthers must bow down before them, but they are doing little or no thinking.

Your rquotations idea was very good! :-) Because of this, I'm interested in any ideas that you may come up with --- a lot of your ideas are pretty obscure though, and it is difficult for me to figure out what practical use they might have.

[polymorph self]

can you replace apache spark and hadoop and hypertable ?

[polymorph self]

have you obsoleted oracle ?

[humptydumpty]

Hi!

Maybe not direct use for some of them, but help me understand better
and then directly use aquired knowledge (if I can do).
If you express directly what is obscure, I'll try my best to explain.

So, now I know that for sequential actions, stack is a mean to help
resolving trade space vs. time problem.

In other way, in our current reality, systems have to deal with
concurrent actions.
A possible mean to deal with, is using a queue (practically, a circular one).

An interesting and entertaining speach is
Rob Pike "Concurrency is not Parallelism":
https://vimeo.com/49718712

Last half part involves some knowledge of Go programming language,
so if that it does not interests you, quit at that point.

[polymorph self]

On Saturday, September 17, 2016 at 5:17:49 AM UTC-4, humptydumpty wrote:

can you gt rid of postgresql and use this instead

[polymorph self]

oh google is cancer and obama supporters I wish it would disappear taking baseball