view release on metacpan or  search on metacpan

Amb.pm  view on Meta::CPAN

@EXPORT_OK = qw(angelic demonic);

bootstrap Amb $VERSION;

use B::Generate 1.13; 
use Carp qw(confess croak);
use PadWalker;

BEGIN { *CORE::GLOBAL::die = \&dier } ;

my (%patched, %cv, @stack, $charged, $debug);
$debug = $ENV{AMB_DEBUG}||0;

sub dier
{
	CORE::die(@_) if $^S; # eval

AGAIN:
	my $c = pop @stack;
	unless ( $c) {
		my @c = caller;
		push @_, " at $c[1] line $c[2]\n" unless join('', @_) =~ /\n/;
		CORE::die @_;
	}

	if ( $c-> {angelic}) {
		$charged = $c;
		print "angelic/die in branch # $c->{state} at $c->{label}\n" if $debug;
		$c-> {state}++;
		goto $c-> {label};
	} else {
		print "demonic/die in branch # $c->{state} at $c->{label}\n" if $debug;
		$c-> {state} = 0;
		goto AGAIN; # that means die again
	}
}

sub after
{
	my $c = pop @stack;
	if ( $c) {
		if ( $c-> {angelic}) {
			print "angelic/after\n" if $debug;
			$c-> {state} = 0;
		} else {
			print "demonic/after\n" if $debug;
			$c-> {state}++;
			$charged = $c;
			goto $c-> {label};
		}
	}
	undef $charged;
}

sub fail($)
{
	local $Carp::CarpLevel = 3 unless $debug;
	confess "Can't call $_[0]\(\) that way";
}

sub patch
{
	my ($name, $xop, $cv, $upcontext) = @_;
	
	printf("$name: patch at COP( 0x%x)\n", $$xop) if $debug;

	my $cv_frame = $cv ? B::svref_2object($cv) : B::main_cv;

	# enter other CV's padlist
	my $savecp = B::cv_pad;
	B::cv_pad( $cv_frame);

	my $psm = B::GVOP-> new( 'gv', 0, \&after);

       # calling ops

Amb.pm  view on Meta::CPAN

	my $id  = sprintf "$name\:\:0x%x/0x%x", $$xop, $upcontext;
	my $lab = B::COP-> new( 0, $id, 0);
	$lab-> sibling( $xop-> sibling);
	$xop-> sibling( $lab);
	$lab-> next( $xop-> next);
	$xop-> next($lab);

	# restore padlist	
	B::cv_pad( $savecp);

	if ( $debug > 1) {
		no strict;
		local $SIG{__WARN__};
		eval "*B::CV::NAME      = sub { 'fake' };" unless exists ${'B::CV'}{NAME};
		eval "*B::NV::int_value = sub { '0.0' };"  unless exists ${'B::NV'}{int_value};

		require B::Concise;
		my $walker = B::Concise::compile('-terse',($cv?$cv:()));
		$walker->();
	}

Amb.pm  view on Meta::CPAN

	return $op, $cx, $up;
}

sub amb
{
	croak "format: amb(arg1,arg2)" if 1 != $#_;
	
	my $c;
	unless ( $charged) {
		my ($op, $cx, $up) = find_ctx('amb');
		printf("amb: 1st call at %x\n", $$op) if $debug;

		my $id;
		unless ( exists $patched{$$op}) {
			$id = patch( 'amb', $op, $cx, $up);
			$patched{$$op} = {
				angelic => 1,
				label   => $id,
			}
		}
		$c = $patched{$$op};
		$c-> {state} = 0;
	} else {
		$c = $charged;
		undef $charged;
		print "amb: jump from $c->{label}\n" if $debug;
	}

	die "amb: all branches fail" if $c-> {state} > $#_;

	push @stack, $c;
	return $_[ $c-> {state} ];
}

*angelic = \&amb;

sub demonic
{
	croak "format: demonic(arg1,arg2)" if 1 != $#_;

	my $c;
	unless ( $charged) {
		my ($op, $cx, $up) = find_ctx('demonic');
		printf("demonic: 1st call at %x\n", $op) if $debug;

		my $id;
		unless ( exists $patched{$$op}) {
			$id = patch( 'demonic', $op, $cx, $up);
			$patched{$$op} = {
				angelic => 0,
				label   => $id,
			}
		}
		$c = $patched{$$op};
		$c-> {state} = 0;
	} else {
		$c = $charged;
		undef $charged;
		print "demonic: jump from $c->{label}\n" if $debug;
	}

	die "demonic: all branches succeed" if $c-> {state} > $#_;

	push @stack, $c;
	return $_[ $c-> {state} ];
}

1;