Add NIL-accessible control structures

sorear · Jul 13, 2010 · f9a7172 · f9a7172
1 parent 4169610
commit f9a7172
Show file tree

Hide file tree

Showing 3 changed files with 69 additions and 0 deletions.
diff --git a/CodeGen.pm b/CodeGen.pm
@@ -188,6 +188,14 @@ use 5.010;
         $self->unreach(1);
     }
 
+    sub cgoto {
+        my ($self, $n) = @_;
+        $n = ($self->labelname->{$n} //= $self->label) if $n < 0;
+        my $top = $self->_pop;
+        $self->_saveall;
+        push @{ $self->buffer }, "    if ($top) { goto case $n; }\n";
+    }
+
     sub _cpscall {
         my ($self, $rt, $expr) = @_;
         $self->_saveall;
@@ -406,6 +414,13 @@ use 5.010;
         $self->_push($ty, "$a1 $op $a2");
     }
 
+    sub clr_compare {
+        my ($self, $op) = @_;
+        my $a2 = $self->_pop;
+        my $a1 = $self->_pop;
+        $self->_push('Bool', "$a1 $op $a2");
+    }
+
     sub clr_field_get {
         my ($self, $f) = @_;
         my $ty = $typedata{$self->stacktype->[-1]}{$f};

diff --git a/Niecza/Actions.pm b/Niecza/Actions.pm
@@ -338,6 +338,49 @@ sub insn__S_goto { my ($cl, $M) = @_;
     $M->{_ast} = [[ goto => -$M->{decint}{_ast} ]];
 }
 
+sub insn__S_cgoto { my ($cl, $M) = @_;
+    $M->{_ast} = [[ cgoto => -$M->{decint}{_ast} ]];
+}
+
+sub insn__S_ncgoto { my ($cl, $M) = @_;
+    $M->{_ast} = [[ ncgoto => -$M->{decint}{_ast} ]];
+}
+
+my $labelid = 1000;
+sub insn__S_if { my ($cl, $M) = @_;
+    my @r;
+    my $end1 = $labelid++;
+    my $end2 = $labelid++;
+    push @r, [ 'ncgoto', -$end1 ];
+    push @r, @{ $M->{nibbler}[0]{_ast}->code };
+    if ($M->{nibbler}[1]) {
+        push @r, [ 'goto', -$end2 ], [ 'labelhere', -$end1 ];
+        push @r, @{ $M->{nibbler}[1]{_ast}->code };
+        push @r, [ 'labelhere', -$end2 ];
+    } else {
+        push @r, [ 'labelhere', -$end1 ];
+    }
+    $M->{_ast} = \@r;
+}
+
+sub insn__S_begin { my ($cl, $M) = @_;
+    my @r;
+    my $b1 = $labelid++;
+    push @r, [ 'labelhere', -$b1 ];
+    push @r, @{ $M->{nibbler}[0]{_ast}->code };
+    if ($M->{while}) {
+        my $b2 = $labelid++;
+        push @r, [ 'ncgoto', -$b2 ];
+        push @r, @{ $M->{nibbler}[1]{_ast}->code };
+        push @r, [ 'goto', -$b1 ], [ 'labelhere', -$b2 ];
+    } elsif ($M->{until}) {
+        push @r, [ 'ncgoto', -$b1 ];
+    } elsif ($M->{again}) {
+        push @r, [ 'goto', -$b1 ];
+    }
+    $M->{_ast} = \@r;
+}
+
 sub insn__S_lex { my ($cl, $M) = @_;
     $M->{_ast} = [[ lex => $M->{up}{_ast}, $M->{varid}{_ast} ]];
 }

diff --git a/Niecza/Grammar.pm6 b/Niecza/Grammar.pm6
@@ -52,6 +52,16 @@ grammar NIL is STD {
     token insn:clr_int { $<sign>=[<[ - + ]>?] <decint> }
     token insn:label { ':'  {} <decint> }
     token insn:goto  { '->' {} <decint> }
+    token insn:cgoto { '?->' {} <decint> }
+    token insn:ncgoto { '!->' {} <decint> }
+    token insn:if { <sym>:s <nibbler> [ 'else' <nibbler> ]? 'then' }
+    token insn:begin {
+        <sym>:s <nibbler> [
+            | $<while>='while' <nibbler> 'repeat'
+            | $<again>='again'
+            | $<until>'until'
+        ]
+    }
 
     token insn:lexget { 'L@' {} <up> <varid> }
     token insn:lexput { 'L!' {} <up> <varid> }
@@ -70,6 +80,7 @@ grammar NIL is STD {
     token insn:unwrap { <sym> ':' {} <clrid> }
     token insn:new { <sym> '/' {} <decint> ':' <clrid> }
     token insn:arith { <[ + \- * / ^ & | ]> }
+    token insn:compare { '<' | '>' | '>=' | '<=' | '!=' | '==' }
     token insn:box { <sym> ':' {} <varid> }
     token insn:unbox { <sym> ':' {} <clrid> }
     token insn:clr_field_get { '@.' {} <varid> }