Permalink
Browse files

[qast] implement while/until

  • Loading branch information...
1 parent 2d2de4e commit 694648e1b8045d7ea2f6ef34c5415584dc72c426 @masak masak committed May 23, 2012
Showing with 109 additions and 0 deletions.
  1. +55 −0 src/QAST/Operations.nqp
  2. +54 −0 t/qast/qast.t
View
@@ -215,6 +215,61 @@ for <if unless> -> $op_name {
});
}
+# Loops.
+for <while until> -> $op_name {
+ QAST::Operations.add_core_op($op_name, -> $qastcomp, $op {
+ # Check operand count.
+ my $operands := +$op.list;
+ pir::die("Operation '$op_name' needs 2 operands")
+ if $operands != 2;
+
+ # Create labels.
+ my $while_id := $qastcomp.unique($op_name);
+ my $loop_lbl := $qastcomp.post_new('Label', :result($while_id ~ '_loop'));
+ my $last_lbl := $qastcomp.post_new('Label', :result($while_id ~ '_last'));
+
+ # Compile each of the children; we'll need to look at the result
+ # types and pick an overall result type if in non-void context.
+ my @comp_ops;
+ my @op_types;
+ for $op.list {
+ my $comp := $qastcomp.as_post($_);
+ @comp_ops.push($comp);
+ @op_types.push(nqp::uc($qastcomp.infer_type($comp.result)));
+ }
+ my $res_type := 'i';
+ my $res_reg := $*REGALLOC."fresh_$res_type"();
+
+ # Evaluate the condition; store result if needed.
+ my $ops := $qastcomp.post_new('Ops');
+
+ # Emit loop label.
+ $ops.push($loop_lbl);
+ $ops.result($res_reg);
+
+ my $coerced := $qastcomp.coerce(@comp_ops[0], $res_type);
+ $ops.push($coerced);
+ $ops.push_pirop('set', $res_reg, $coerced.result);
+
+ # Emit the exiting jump.
+ $ops.push_pirop(($op_name eq 'while' ?? 'unless ' !! 'if ') ~
+ @comp_ops[0].result ~ ' goto ' ~ $last_lbl.result);
+
+ # Emit the loop body; stash the result.
+ my $body := $qastcomp.coerce(@comp_ops[1], $res_type);
+ $ops.push($body);
+ $ops.push_pirop('set', $res_reg, $body.result);
+
+ # Emit the iteration jump.
+ $ops.push_pirop('goto ' ~ $loop_lbl.result);
+
+ # Emit last label and tag ops with result.
+ $ops.push($last_lbl);
+ $ops.result($res_reg);
+ $ops;
+ });
+}
+
# Binding
QAST::Operations.add_core_op('bind', -> $qastcomp, $op {
# Sanity checks.
View
@@ -613,3 +613,57 @@ is_qast_args(
[$test_obj],
199,
'attribute lookup works');
+
+is_qast(
+ QAST::Block.new(
+ QAST::Op.new(
+ :op('bind'),
+ QAST::Var.new( :name('$i'), :scope('lexical'), :decl('var'), :returns(int) ),
+ QAST::IVal.new( :value(5) )
+ ),
+ QAST::Op.new(
+ :op('while'),
+ QAST::Var.new( :name('$i'), :scope('lexical') ),
+ QAST::Op.new(
+ :op('bind'),
+ QAST::Var.new( :name('$i'), :scope('lexical') ),
+ QAST::Op.new(
+ :op('sub_i'),
+ QAST::Var.new( :name('$i'), :scope('lexical') ),
+ QAST::IVal.new( :value(1) )
+ )
+ ),
+ ),
+ QAST::Var.new( :name('$i'), :scope('lexical') ),
+ ),
+ 0,
+ 'while loop works');
+
+is_qast(
+ QAST::Block.new(
+ QAST::Op.new(
+ :op('bind'),
+ QAST::Var.new( :name('$i'), :scope('lexical'), :decl('var'), :returns(int) ),
+ QAST::IVal.new( :value(5) )
+ ),
+ QAST::Op.new(
+ :op('until'),
+ QAST::Op.new(
+ :op('islt_i'),
+ QAST::Var.new( :name('$i'), :scope('lexical') ),
+ QAST::IVal.new( :value(3) )
+ ),
+ QAST::Op.new(
+ :op('bind'),
+ QAST::Var.new( :name('$i'), :scope('lexical') ),
+ QAST::Op.new(
+ :op('sub_i'),
+ QAST::Var.new( :name('$i'), :scope('lexical') ),
+ QAST::IVal.new( :value(1) )
+ )
+ ),
+ ),
+ QAST::Var.new( :name('$i'), :scope('lexical') ),
+ ),
+ 2,
+ 'until loop works');

0 comments on commit 694648e

Please sign in to comment.