Here's the Parrot::Coroutine patch; I will commit this if nobody
objects.
It seems to me that this should be mentioned in docs/compiler_faq.pod
as an alternative way to do coroutines . . . I will take a look at this.
In fact, it might be safer to deprecate Coroutine.pmc until it can be
redesigned. It would be a shame if somebody looked at only that and
concluded that Parrot doesn't really support coroutines after all.
-- Bob Rogers
http://rgrjr.dyndns.org/
Diffs between last version checked in and current workfile(s):
Index: runtime/parrot/library/Parrot/Coroutine.pir
===================================================================
--- runtime/parrot/library/Parrot/Coroutine.pir (revision 0)
+++ runtime/parrot/library/Parrot/Coroutine.pir (revision 0)
@@ -0,0 +1,266 @@
+=head1 TITLE
+
+Parrot::Coroutine - A pure PIR implementation of coroutines
+
+=head1 VERSION
+
+ $Id:$
+
+=head1 SYNOPSIS
+
+ .sub __onload :load
+ load_bytecode 'Parrot/Coroutine.pir'
+ .end
+
+ ## Recursive coroutine to enumerate tree elements. Each element that is
+ ## not a FixedPMCArray is yielded in turn.
+ .sub 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"
+ coro.'yield'(tree_node)
+ .return ()
+
+ recur:
+ ## Loop through array elements, recurring on each.
+ .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(coro, $P1, depth)
+ inc i
+ goto again
+ done:
+ .return ()
+ .end
+
+ .sub print_tree
+ .param pmc tree
+
+ .local int coro_class, idx
+ coro_class = find_type 'Parrot::Coroutine'
+ .local pmc coro
+ .const .Sub coro_sub = "enumerate_tree"
+ coro = new coro_class, coro_sub
+ ($P0 :optional, $I0 :opt_flag) = coro.'resume'(coro, tree)
+ idx = 0
+
+ loop:
+ unless $I0 goto done
+ print 'print_tree: '
+ print idx
+ print ' => '
+ print $P0
+ print "\n"
+ ($P0 :optional, $I0 :opt_flag) = coro.'resume'()
+ goto loop
+ done:
+ .end
+
+=head1 DESCRIPTION
+
+This object class provides an implementation of coroutines that is written
+in pure PIR using continuations.
+
+=cut
+
+.const int slot_state = 0 ## State: 1 is new/valid, 0 is dead.
+.const int slot_initial_sub = 1 ## Initial sub.
+.const int slot_yield_cont = 2 ## Continuation to for yielding.
+.const int slot_resume_cont = 3 ## Continuation from which to resume.
+
+.sub __loadtime_create_class :load
+ find_type $I0, "Parrot::Coroutine"
+ if $I0 > 1 goto END
+ newclass $P0, "Parrot::Coroutine"
+ addattribute $P0, "state"
+ addattribute $P0, "initial_sub"
+ addattribute $P0, "yield_cont"
+ addattribute $P0, "resume_cont"
+END:
+ .return ()
+.end
+
+.namespace ["Parrot::Coroutine"]
+
+.include "interpinfo.pasm"
+
+=head2 METHODS
+
+=head3 B<__init(sub)>
+
+This method is normally called via the C<new> op:
+
+ .local int coro_class
+ coro_class = find_type 'Parrot::Coroutine'
+ .local pmc coro
+ .const .Sub coro_sub = "enumerate_tree"
+ coro = new coro_class, coro_sub
+
+Given a sub, it initializes a new C<Parrot::Coroutine> object.
+
+=cut
+
+.sub __init :method
+ .param pmc sub
+
+ ## [should complain if sub is not a sub or closure. -- rgr, 8-Oct-06.]
+ .local pmc state
+ state = new .Undef
+ state = 1
+ setattribute self, slot_state, state
+ setattribute self, slot_initial_sub, sub
+.end
+
+## [it would be nice to include a pointer value. -- rgr, 8-Oct-06.]
+.sub __get_string :method
+ $S0 = '<Parrot::Coroutine ?>'
+ .return ($S0)
+.end
+
+=head3 B<coro.resume(args...)>
+
+Invoke the coroutine. The first time this is called on a new coroutine,
+the initial sub is invoked with the passed arguments. The second and
+subsequent times, the args are delivered as the result of the previous
+C<yield> operation.
+
+If the coroutine subsequently yields, the values passed to the C<yield>
+method are returned as the values from C<resume>.
+
+If the coroutine returns normally (i.e. from the original sub), then those
+values are passed returned from the C<resume> method, and the coroutine is
+marked as dead, in which case it is an error to attempt to resume it again.
+
+=cut
+
+.sub resume :method
+ .param pmc args :slurpy
+
+ ## Decide whether we're dead.
+ .local pmc state
+ state = getattribute self, slot_state
+ 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 = getattribute self, slot_resume_cont
+ unless null entry goto doit
+ entry = getattribute self, slot_initial_sub
+
+doit:
+ ## Remember where to return when we yield.
+ .local pmc cc
+ cc = interpinfo .INTERPINFO_CURRENT_CONT
+ setattribute self, slot_yield_cont, 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
+ ## Note that the value of the yield_cont slot will normally have been
+ ## changed magically behind our backs by a subsequent yield/resume, so
+ ## we can't just return directly.
+ cc = getattribute self, slot_yield_cont
+ .return cc(result :flat)
+
+dead:
+ ## Complain about attempted zombie creation.
+ .local pmc error
+ error = new .Exception
+ error['_message'] = "Can't reanimate a dead coroutine.\n"
+ throw error
+.end
+
+=head3 B<coro.yield(args...)>
+
+Within the coroutine, C<yield> returns arbitrary values back to the
+caller, making it look like the values came from the last C<resume> call.
+
+The next time the caller decides to resume the coroutine, the arguments
+passed to C<resume> are returned as the values from C<yield>.
+
+=cut
+
+## Return values to the calling thread.
+.sub yield :method
+ .param pmc args :slurpy
+
+ ## Remember where to go when we are resumed.
+ .local pmc cc
+ cc = interpinfo .INTERPINFO_CURRENT_CONT
+ setattribute self, slot_resume_cont, cc
+
+ ## Return to the coro caller.
+ cc = getattribute self, slot_yield_cont
+ .return cc(args :flat)
+.end
+
+=head1 BUGS
+
+=over 4
+
+=item 1.
+
+We should really keep more state details. The only legal state
+transitions should be 'new' to 'resumed' to 'yielded' to 'resumed'
+to 'yielded' ..., except that one might at any time transition to
+'dead', which is (not surprisingly) the terminal state.
+
+=back
+
+Please report any others you find to C<E<lt>[EMAIL PROTECTED]<gt>>.
+
+=head1 SEE ALSO
+
+L<http://en.wikipedia.org/wiki/Coroutine> -- coroutines defined.
+
+C<t/library/coroutine.t> -- "same fringe" test case.
+
+C<src/pmc/coroutine.pmc> -- the C<pmclass> implementation.
+
+L<http://www.lua.org/manual/5.1/manual.html#2.11> -- definition of the
+coroutine API for the Lua programming language, upon which the
+C<Parrot::Coroutine> API is based.
+
+L<http://gd.tuwien.ac.at/languages/scheme/tutorial-dsitaram/t-y-scheme-Z-H-14.html>
+-- Scheme tutorial chapter that introduces call/cc and uses it to solve
+"same fringe" via coroutines.
+
+=head1 AUTHOR
+
+Bob Rogers C<E<lt>[EMAIL PROTECTED]<gt>>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006, The Perl Foundation.
+This program is free software. It is subject to the same
+license as The Parrot Interpreter.
+
+=for vim
+
+" vim: ts=8 expandtab
+
+=cut
Index: MANIFEST
===================================================================
--- MANIFEST (revision 14921)
+++ MANIFEST (working copy)
@@ -2128,6 +2128,7 @@
runtime/parrot/library/HTTP/Daemon.pir [library]
runtime/parrot/library/JSON.pir [library]
runtime/parrot/library/MIME/Base64.pir [library]
+runtime/parrot/library/Parrot/Coroutine.pir [library]
runtime/parrot/library/PGE/Dumper.pir [library]
runtime/parrot/library/PGE/Glob.pir [library]
runtime/parrot/library/PGE/Hs.pir [library]
@@ -2550,6 +2551,7 @@
t/examples/subs.t []
t/harness []
t/library/File_Spec.t []
+t/library/coroutine.t []
t/library/data_escape.t []
t/library/dumper.t []
t/library/getopt_obj.t []
Index: t/library/coroutine.t
===================================================================
--- t/library/coroutine.t (revision 0)
+++ t/library/coroutine.t (revision 0)
@@ -0,0 +1,219 @@
+#!./parrot
+# Copyright (C) 2006, The Perl Foundation.
+# $Id:$
+
+=head1 NAME
+
+t/library/coroutine.t -- Test the Parrot::Coroutine class
+
+=head1 SYNOPSIS
+
+ ./parrot t/library/coroutine.t
+
+=head1 DESCRIPTION
+
+This script tests the C<Parrot::Coroutine> class using an implementation of the
+"same fringe" problem.
+
+=head1 SEE ALSO
+
+L<http://swiss.csail.mit.edu/classes/symbolic/spring06/psets/ps6/samefringe.scm>
+-- a collection of "same fringe" implementations in Scheme.
+
+=cut
+
+.const int N_TESTS = 6
+
+## Build an N-ary tree (where N is passed as node_width) of the specified
depth,
+## with the leaves being consecutive integer PMCs from start but less than N.
+## The tree will be complete iff end-start+1 == node_width^depth.
+.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:
+ ## Loop through array elements, recurring on each.
+ .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 element that is not a
+## FixedPMCArray 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"
+ coro.'yield'(tree_node)
+ .return ()
+
+recur:
+ ## Loop through array elements, recurring on each.
+ .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. Returns 1 if the trees have the same
fringe,
+## else 0.
+.sub same_fringe
+ .param pmc tree1
+ .param pmc tree2
+
+ .local int coro_class
+ coro_class = find_type 'Parrot::Coroutine'
+ if coro_class goto found
+ printerr "Bug: Can't find 'Parrot::Coroutine' class.\n"
+ die 5, 1
+found:
+ .local pmc coro1, coro2
+ .const .Sub coro_sub = "coro_enumerate_tree"
+ coro1 = new coro_class, coro_sub
+ coro2 = new coro_class, coro_sub
+ ($P0 :optional, $I0 :opt_flag) = coro1.'resume'(coro1, tree1)
+ ($P1 :optional, $I1 :opt_flag) = coro2.'resume'(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) = coro1.'resume'()
+ ($P1 :optional, $I1 :opt_flag) = coro2.'resume'()
+ goto loop
+not_equal:
+ .return (0)
+equal:
+ .return (1)
+.end
+
+.sub main :main
+ load_bytecode 'Test/Builder.pir'
+ .local pmc test
+ test = new 'Test::Builder'
+ test.'plan'(N_TESTS)
+
+ push_eh cant_load
+ load_bytecode 'Parrot/Coroutine.pir'
+ clear_eh
+ test.'ok'(1, 'loaded bytecode')
+
+ ## grow some trees for traversal.
+ .local pmc binary, binary_4, ternary, ternary_2
+ 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 will be different.
+ ternary_2 = make_nary_tree(1, 8, 3, 2)
+ $P0 = ternary_2[1]
+ $P0 = $P0[0]
+ ternary_2[1] = $P0
+ ## enumerate_tree(ternary_2)
+ test.'ok'(1, 'made test trees.')
+
+ $I0 = same_fringe(binary, binary)
+ test.'ok'($I0, 'binary [[[1,2],[3,4]],[[5,6],[7,8]]] vs. itself')
+ $I0 = same_fringe(binary, binary_4)
+ $I0 = 1 - $I0
+ test.'ok'($I0, 'binary 1..8 vs. binary 1..16')
+ $I0 = same_fringe(binary, ternary)
+ test.'ok'($I0, 'binary 1..8 vs. ternary [[1,2,3],[4,5,6],[7,8]]')
+ $I0 = same_fringe(binary, ternary_2)
+ $I0 = 1 - $I0
+ test.'ok'($I0, 'binary 1..8 vs. ternary [[1,2,3],4,[7,8]]')
+ test.'finish'()
+ end
+cant_load:
+ test.'ok'(0, 'Load failed')
+ test.'finish'()
+.end
Property changes on: t/library/coroutine.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
End of diffs.
