Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Redo the flip-flop implementation. This also covers the fff from, doe… 
…sn't suffer the scoping issues in the previous version and passes all but the final two tests in flip-flop.t (which seem to run into scoping issues that aren't the flip-flop operators fault anyway).
  • Loading branch information
@jnthn
jnthn committed May 8, 2012
1 parent 5d601c7 commit e5d47e5
Show file tree
Hide file tree
Showing 2 changed files with 138 additions and 55 deletions.
139 changes: 138 additions & 1 deletion src/Perl6/Actions.pm
View file
Expand Up @@ -3519,7 +3519,15 @@ class Perl6::Actions is HLL::Actions {
'!~~', -> $/, $sym { make_smartmatch($/, 1) },
'=', -> $/, $sym { assign_op($/[0].ast, $/[1].ast) },
':=', -> $/, $sym { bind_op($/, $/[0].ast, $/[1].ast, 0) },
'::=', -> $/, $sym { bind_op($/, $/[0].ast, $/[1].ast, 1) }
'::=', -> $/, $sym { bind_op($/, $/[0].ast, $/[1].ast, 1) },
'ff', -> $/, $sym { flipflop($/[0].ast, $/[1].ast, 0, 0, 0) },
'^ff', -> $/, $sym { flipflop($/[0].ast, $/[1].ast, 1, 0, 0) },
'ff^', -> $/, $sym { flipflop($/[0].ast, $/[1].ast, 0, 1, 0) },
'^ff^', -> $/, $sym { flipflop($/[0].ast, $/[1].ast, 1, 1, 0) },
'fff', -> $/, $sym { flipflop($/[0].ast, $/[1].ast, 0, 0, 1) },
'^fff', -> $/, $sym { flipflop($/[0].ast, $/[1].ast, 1, 0, 1) },
'fff^', -> $/, $sym { flipflop($/[0].ast, $/[1].ast, 0, 1, 1) },
'^fff^',-> $/, $sym { flipflop($/[0].ast, $/[1].ast, 1, 1, 1) }
);
method EXPR($/, $key?) {
unless $key { return 0; }
Expand Down Expand Up @@ -3858,6 +3866,135 @@ class Perl6::Actions is HLL::Actions {
$rhs,
PAST::Op.new( :pirop('perl6_booleanize__Pi'), 1, :named('thunked') ))
}

sub flipflop($lhs, $rhs, $min_excl, $max_excl, $one_only) {
# Need various constants.
my $zero := $*W.add_numeric_constant('Int', 0);
my $one := $*W.add_numeric_constant('Int', 1);
my $nil := $*W.get_ref($*W.find_symbol(['Nil']));
my $false := $*W.get_ref($*W.find_symbol(['Bool', 'False']));
my $true := $*W.get_ref($*W.find_symbol(['Bool', 'True']));

# Need a state variable to track the state.
my %cont;
my $id := $lhs.unique('FLIPFLOP_STATE_');
my $state := '!' ~ $id;
%cont{'bind_constraint'} := $*W.find_symbol(['Mu']);
%cont{'container_type'} := $*W.find_symbol(['Scalar']);
%cont{'container_base'} := %cont{'container_type'};
%cont{'default_value'} := $zero<compile_time_value>;
$*W.install_lexical_container($*W.cur_lexpad(), $state, %cont,
$*W.create_container_descriptor(%cont{'bind_constraint'}, 1, $state),
:state(1));

# Twiddle to make special-case RHS * work.
if $rhs.returns eq 'Whatever' {
$rhs := $false;
}

# Evaluate LHS and RHS. Note that in one-only mode, we use
# the state bit to decide which side to evaluate.
my $ff_code := PAST::Stmts.new(
PAST::Op.new(
:pasttype('bind'),
PAST::Var.new( :name($id ~ '_lhs'), :scope('register'), :isdecl(1) ),
($one_only ??
PAST::Op.new(
:pasttype('if'),
PAST::Var.new( :name($state), :scope('lexical_6model') ),
$false,
PAST::Op.new( :pasttype('callmethod'), :name('Bool'), $lhs )
) !!
PAST::Op.new( :pasttype('callmethod'), :name('Bool'), $lhs ))
),
PAST::Op.new(
:pasttype('bind'),
PAST::Var.new( :name($id ~ '_rhs'), :scope('register'), :isdecl(1) ),
($one_only ??
PAST::Op.new(
:pasttype('if'),
PAST::Var.new( :name($state), :scope('lexical_6model') ),
PAST::Op.new( :pasttype('callmethod'), :name('Bool'), $rhs ),
$false
) !!
PAST::Op.new( :pasttype('callmethod'), :name('Bool'), $rhs ))
)
);

# Now decide what to do based on current state and current
# results.
$ff_code.push(PAST::Op.new(
:pasttype('if'),
PAST::Var.new( :name($state), :scope('lexical_6model') ),

# State is currently true. Check RHS. If it's false, then we
# increment the sequence count. If it's true, then we reset,
# the state to zero and and what we return depends on $max_excl.
PAST::Op.new(
:pasttype('if'),
PAST::Var.new( :name($id ~ '_rhs'), :scope('register') ),
($max_excl ??
PAST::Stmts.new(
PAST::Op.new(
:pirop('perl6_container_store__0PP'),
PAST::Var.new( :name($state), :scope('lexical_6model') ),
$zero
),
$nil
) !!
PAST::Stmts.new(
PAST::Op.new(
:pasttype('bind'),
PAST::Var.new( :name($id ~ '_orig'), :scope('register'), :isdecl(1) ),
PAST::Op.new(
:pasttype('call'), :name('&prefix:<++>'),
PAST::Var.new( :name($state), :scope('lexical_6model') )
)
),
PAST::Op.new(
:pirop('perl6_container_store__0PP'),
PAST::Var.new( :name($state), :scope('lexical_6model') ),
$zero
),
PAST::Op.new(
:pirop('perl6_decontainerize__PP'),
PAST::Var.new( :name($id ~ '_orig'), :scope('register') )
)
)),
PAST::Stmts.new(
PAST::Op.new(
:pasttype('call'), :name('&prefix:<++>'),
PAST::Var.new( :name($state), :scope('lexical_6model') )
)
)
),

# State is currently false. Check LHS. If it's false, then we
# stay in a false state. If it's true, then we flip the bit,
# but only if the RHS is not also true. We return a result
# based on $min_excl.
PAST::Op.new(
:pasttype('if'),
PAST::Var.new( :name($id ~ '_lhs'), :scope('register') ),
PAST::Op.new(
:pasttype('if'),
PAST::Var.new( :name($id ~ '_rhs'), :scope('register') ),
$min_excl || $max_excl ?? $nil !! $one,
PAST::Stmts.new(
PAST::Op.new(
:pirop('perl6_container_store__0PP'),
PAST::Var.new( :name($state), :scope('lexical_6model') ),
$one
),
$min_excl ?? $nil !! $one
)
),
$nil
)
));

$ff_code
}

method prefixish($/) {
if $<prefix_postfix_meta_operator> {
Expand Down
54 changes: 0 additions & 54 deletions src/core/operators.pm
View file
Expand Up @@ -157,60 +157,6 @@ sub undefine(Mu \$x) {
$x = $undefined;
}

sub infix:<ff>($a as Bool, $b as Bool) {
my $pos := nqp::p6box_s(nqp::callerid());
state %ffv;
if %ffv{$pos} {
%ffv{$pos} = False if $b;
True;
}
elsif $a {
%ffv{$pos} = $a
}
else {
False
}
}

sub infix:<ff^>($a as Bool, $b as Bool) {
my $pos := nqp::p6box_s(nqp::callerid());
state %ffv;
if %ffv{$pos} {
$b ?? (%ffv{$pos} = False) !! True
}
elsif $a {
%ffv{$pos} = $a
}
else {
False
}
}

sub infix:<^ff>($a as Bool, $b as Bool) {
my $pos := nqp::p6box_s(nqp::callerid());
state %ffv;
if %ffv{$pos} {
%ffv{$pos} = False if $b;
True
}
else {
%ffv{$pos} = True if $a;
False
}
}

sub infix:<^ff^>($a as Bool, $b as Bool) {
my $pos := nqp::p6box_s(nqp::callerid());
state %ffv;
if %ffv{$pos} {
$b ?? (%ffv{$pos} = False) !! True
}
else {
%ffv{$pos} = True if $a;
False
}
}

sub prefix:<temp>(\$cont) is rw {
my $temp_restore := pir::find_caller_lex__Ps('!TEMP-RESTORE');
if nqp::iscont($cont) {
Expand Down

0 comments on commit e5d47e5

Please sign in to comment.