From: François PERRAD <[EMAIL PROTECTED]>
   Date: Wed, 04 Oct 2006 08:55:34 +0200

   I've tried without success to implement coroutine in language Lua . . .
   Help is welcome.

   François.

I am not surprised that you have had difficulty.  I can't even get a
simple recursive coroutine to work in PIR.  See the first attachment for
an attempt.  I think this is a fundamental problem; I know nothing about
Lua, but I strongly suspect Parrot coroutines would have to be
redesigned to support what the Lua manual says about them [1].

   But that's not a show-stopper; continuations alone are powerful
enough to do most of what you need.  The second attachment is a demo
implementation based loosely on the Lua definitions of coroutine.create,
coroutine.resume, and coroutine.yield.  The first third of the code
defines PIR near-equivalents to these, and the rest includes several
demos.  The demo that runs by default (i.e. without editing the code) is
a solution to the "same fringe" problem [2] using a pair of recursive
coroutines to enumerate two trees simultaneously.

   However, the abstraction is poor.  This is partly because I was too
lazy to figure out whether an object-oriented solution would fail due to
the "continuation barrier" problem, and partly because I was too lazy to
make the "current coroutine" implicit, as it is in Lua [3].  Still, I
hope you find this useful.  Probably it ought to get turned into an
example . . .

   Also, the "[oops; got 4 and X]" lines in the output seem to suggest
that Parrot may be getting confused about parameters.  The "4" is really
the length of one of the coro structures, which must be getting passed
as the first arg.  Also, it fails with "too many args" if you don't
accept at least two values from the coroutine_yield.  I suspect Parrot
is reusing some old parameter information; I'll try to nail this down if
I get a chance.

                                        -- Bob Rogers
                                           http://rgrjr.dyndns.org/

[1]  http://www.lua.org/manual/5.1/manual.html#2.11

[2]  http://www.nsl.com/papers/samefringe.htm, e.g.

[3]  This also depends on how the "current coroutine" should be scoped.
     Dynamic scoping seems reasonable, but that's not obvious from [1].

## This version doesn't work; the recursive call from coro_enumerate_tree
## winds up yielding.  -- rgr, 7-Oct-06.

## build a complete N-ary tree of the specified depth, with the leaves being
## consecutive integer PMCs from start.
.sub make_nary_tree
        .param int start
        .param int node_width
        .param int depth

        .local pmc result
        if depth goto deeper
        result = new .Undef
        result = start
        inc start
        goto done
deeper:
        result = new .FixedPMCArray
        result = node_width
        dec depth
        .local int i
        i = 0
next:
        if i >= node_width goto done
        ($P0, start) = make_nary_tree(start, node_width, depth)
        result[i] = $P0
        inc i
        goto next
done:
        .return (result, start)
.end

## non-coroutine traversal, for debugging.
.sub enumerate_tree
        .param pmc tree_node
        .param int depth :optional
        .param int depth_p :opt_flag

        if depth_p goto have_depth
        depth = 0
have_depth:
        inc depth

        $I0 = isa tree_node, 'FixedPMCArray'
        if $I0 goto recur
        print "[leaf "
        print tree_node
        print "]\n"
done:
        .return ()
recur:
        .local int size, i
        i = 0
        size = tree_node
again:
        if i >= size goto done
        print "[recur: depth "
        print depth
        print ' elt '
        print i
        print "]\n"
        $P1 = tree_node[i]
        enumerate_tree($P1, depth)
        inc i
        goto again
.end

## recursive coroutine to enumerate tree elements, each of which is yielded in
## turn.
.sub coro_enumerate_tree
        .param pmc tree_node
        .param int depth :optional
        .param int depth_p :opt_flag

        if depth_p goto have_depth
        depth = 0
have_depth:
        inc depth

        $I0 = isa tree_node, 'FixedPMCArray'
        if $I0 goto recur
        print "[leaf "
        print tree_node
        print "]\n"
        .yield (tree_node)
        .return ()
recur:
        .local int size, i
        i = 0
        size = tree_node
again:
        if i >= size goto done
        print "[coro recur: depth "
        print depth
        print ' elt '
        print i
        print "]\n"
        $P1 = tree_node[i]
        ## [NB:  this recursive call isn't to the clone.  but it's not clear
        ## whether that would help.  -- rgr, 7-Oct-06.]
        coro_enumerate_tree($P1)
        inc i
        goto again
done:
        .return ()
.end

.sub main :main
        ## make a data structure for traversal.
        .local pmc binary_3
        binary_3 = make_nary_tree(1, 2, 3)
        ## enable this to show that make_nary_tree works.
        ## enumerate_tree(binary_3)

        ## list its contents via coroutine.
        .local pmc coro1
        coro1 = global 'coro_enumerate_tree'
        ## [cloning makes it fail later.  -- rgr, 7-Oct-06.]
        ## coro1 = clone coro1
loop:
        ($P0 :optional, $I0 :opt_flag) = coro1(binary_3)
        unless $I0 goto done
        if null $P0 goto oops
        print $P0
        print "\n"
        goto loop
oops:
        ## we should never get here; the coroutine returns either no values, or
        ## one value that must be an integer PMC.
        print "oops.\n"
done:
.end
.include "interpinfo.pasm"

### Coroutine implementation.

## Coroutine slots:
##
##  0.  Coroutine state:  1 is new or valid, 0 is dead.
##  1.  Initial sub.
##  2.  Continuation to which to return when yielding.
##  3.  Continuation from which to resume.

.sub coroutine_create
        .param pmc sub

        .local pmc coro, state
        coro = new .FixedPMCArray
        coro = 4
        state = new .Undef
        state = 1
        coro[0] = state
        coro[1] = sub
        .return (coro)
.end

## Invoke the coroutine.
.sub coroutine_resume
        .param pmc coro
        .param pmc args :slurpy

        ## Decide whether we're dead.
        .local pmc state
        state = coro[0]
        unless state goto dead

        ## Decide where to go.  If we've never been invoked before, we need to
        ## call the sub.
        .local pmc entry
        entry = coro[3]
        unless null entry goto doit
        entry = coro[1]

doit:
        ## Remember where to return when we yield.
        .local pmc cc
        cc = interpinfo .INTERPINFO_CURRENT_CONT
        coro[2] = cc

        ## Call the entry with our args.  Most of the time, it will yield (by
        ## calling our continuation for us) instead of returning directly.
        .local pmc result
        (result :slurpy) = entry(args :flat)
        ## If we returned normally, then the coroutine is dead.
        state = 0
        .return (result :flat)

dead:
        ## Complain about zombie creation.
        .local pmc error
        error = new .Exception
        error['_message'] = "Can't reanimate a dead coroutine.\n"
        throw error
.end

## Return values to the calling thread.
.sub coroutine_yield
        .param pmc coro
        .param pmc args :slurpy

        ## Remember where to go when we are resumed.
        .local pmc cc
        cc = interpinfo .INTERPINFO_CURRENT_CONT
        coro[3] = cc

        ## Return to the coro caller.
        cc = coro[2]
        .return cc(args :flat)
.end

### Recursive enumeration.

## build a complete N-ary tree of the specified depth, with the leaves being
## consecutive integer PMCs from start.
.sub make_nary_tree
        .param int start
        .param int end
        .param int node_width
        .param int depth

        .local pmc result
        if depth goto deeper
        result = new .Undef
        result = start
        inc start
        goto done
deeper:
        result = new .ResizablePMCArray
        dec depth
        .local int i
        i = 0
next:
        if i >= node_width goto done
        if start > end goto done
        ($P0, start) = make_nary_tree(start, end, node_width, depth)
        push result, $P0
        inc i
        goto next
done:
        .return (result, start)
.end

## non-coroutine traversal, for debugging.
.sub enumerate_tree
        .param pmc tree_node
        .param int depth :optional
        .param int depth_p :opt_flag

        if depth_p goto have_depth
        depth = 0
have_depth:
        inc depth

        $I0 = isa tree_node, 'ResizablePMCArray'
        if $I0 goto recur
        print "[leaf "
        print tree_node
        print "]\n"
done:
        .return ()
recur:
        .local int size, i
        i = 0
        size = tree_node
again:
        if i >= size goto done
        print "[recur: depth "
        print depth
        print ' elt '
        print i
        print "]\n"
        $P1 = tree_node[i]
        enumerate_tree($P1, depth)
        inc i
        goto again
.end

## Recursive coroutine to enumerate tree elements, each of which is yielded in
## turn.
.sub coro_enumerate_tree
        .param pmc coro
        .param pmc tree_node
        .param int depth :optional
        .param int depth_p :opt_flag

        if depth_p goto have_depth
        depth = 0
have_depth:
        inc depth

        $I0 = isa tree_node, 'FixedPMCArray'
        if $I0 goto recur
        ## print "[leaf "
        ## print tree_node
        ## print "]\n"
        ($P5 :optional, $I5 :opt_flag, $P6 :optional) = coroutine_yield(coro, 
tree_node)
        unless $I5 goto done
        ## [this is a bug; we shouldn't ever get *any* values from
        ## coroutine_resume.  -- rgr, 7-Oct-06.]
        print "[oops; got "
        print $P5
        unless $I6 goto no_p6
        print ' and '
        print $P6
no_p6:
        print "]\n"
        .return ()
recur:
        .local int size, i
        i = 0
        size = tree_node
again:
        if i >= size goto done
        ## print "[coro recur: depth "
        ## print depth
        ## print ' elt '
        ## print i
        ## print "]\n"
        $P1 = tree_node[i]
        coro_enumerate_tree(coro, $P1, depth)
        inc i
        goto again
done:
        .return ()
.end

## Solution to the "same fringe" problem that uses coroutines to enumerate each
## of two passed trees of numbers.  Prints 'equal' if the trees have the same
## fringe, else 'not equal.'
.sub same_fringe
        .param pmc tree1
        .param pmc tree2

        .local pmc coro1, coro2
        .const .Sub coro_sub = "coro_enumerate_tree"
        coro1 = coroutine_create(coro_sub)
        coro2 = coroutine_create(coro_sub)
        ($P0 :optional, $I0 :opt_flag) = coroutine_resume(coro1, coro1, tree1)
        ($P1 :optional, $I1 :opt_flag) = coroutine_resume(coro2, coro2, tree2)

loop:
        if $I0 goto got_first
        if $I1 goto not_equal
        goto equal
got_first:
        unless $I1 goto not_equal

        ## now have results from both.
        print "[got "
        print $P0
        print ' and '
        print $P1
        print "]\n"
        if $P0 != $P1 goto not_equal
        ## set up for the next iteration.
        ($P0 :optional, $I0 :opt_flag) = coroutine_resume(coro1)
        ($P1 :optional, $I1 :opt_flag) = coroutine_resume(coro2)
        goto loop
not_equal:
        print "not "
equal:
        print "equal.\n"
.end

## Main program to solve a "same fringe" test case.
.sub solve_same_fringe :main
        .local pmc binary, binary_4, ternary, ternary_2
        ## load_bytecode "Data/Dumper"
        binary = make_nary_tree(1, 8, 2, 3)
        ternary = make_nary_tree(1, 8, 3, 2)
        binary_4 = make_nary_tree(1, 16, 2, 4)
        ## now make a "damaged" one that we can decide that it is different.
        ternary_2 = make_nary_tree(1, 8, 3, 2)
        $P0 = ternary_2[1]
        $P0 = $P0[0]
        ternary_2[1] = $P0
        ## enumerate_tree(ternary)
        ## enumerate_tree(binary)

        same_fringe(binary, binary)
        same_fringe(binary, binary_4)
        same_fringe(binary, ternary)
        same_fringe(binary, ternary_2)
.end

## Main program to test tree creation and enumeration.
.sub enumerate_recursively
        ## make a data structure for traversal.
        .local pmc binary_3
        binary_3 = make_nary_tree(1, 8, 2, 3)
        ## enable this to show that make_nary_tree works.
        enumerate_tree(binary_3)

        ## list its contents via coroutine.
        .const .Sub coro_sub = "coro_enumerate_tree"
        .local pmc coro1
        coro1 = coroutine_create(coro_sub)
        ($P0 :optional, $I0 :opt_flag) = coroutine_resume(coro1, coro1, 
binary_3, 0)
loop:
        unless $I0 goto done
        if null $P0 goto oops
        print $P0
        print "\n"
        ($P0 :optional, $I0 :opt_flag) = coroutine_resume(coro1)
        goto loop
oops:
        ## we should never get here; the coroutine returns either no values, or
        ## one value that must be an integer PMC.
        print "oops.\n"
done:
.end

Reply via email to