Add a concrete syntax for CgOp

Niecza/Actions.pm

@@ -149,6 +149,8 @@ sub quote__S_Q { my ($cl, $M) = @_;
 sub nibbler { my ($cl, $M) = @_;
     if ($M->isa('STD::Regex')) {
         $M->{_ast} = $M->{EXPR}{_ast};
+    } elsif ($M->isa('Niecza::Grammar::CgOp')) {
+        $M->{_ast} = Op::CgOp->new(op => $M->{cgexp}{_ast});
     } elsif ($M->isa('Niecza::Grammar::NIL')) {
         $M->{_ast} = Op::NIL->new(ops => [map { @{$_->{_ast}} } @{$M->{insn}}]);
     } else {
@@ -528,6 +530,32 @@ sub multisig { my ($cl, $M) = @_;
     $M->{_ast} = $M->{signature}[0]{_ast};
 }
 
+sub cgopname { my ($cl, $M) = @_;
+    $M->{_ast} = $M->Str;
+}
+
+sub cgexp { }
+sub cgexp__S_name { my ($cl, $M) = @_;
+    $M->{_ast} = $M->{cgopname}{_ast};
+}
+
+sub cgexp__S_decint { my ($cl, $M) = @_;
+    $M->{_ast} = $M->{decint}{_ast};
+}
+
+sub cgexp__S_quote { my ($cl, $M) = @_;
+    if (!$M->{quote}{_ast}->isa('Op::StringLiteral')) {
+        $M->sorry("Strings used in CgOp code must be compile time constants");
+    }
+    $M->{_ast} = $M->{quote}{_ast}->text;
+}
+
+sub cgexp__S_op { my ($cl, $M) = @_;
+    no strict 'refs';
+    $M->{_ast} = &{'CgOp::' . $M->{cgopname}{_ast}}(
+        map { $_->{_ast} } @{ $M->{cgexp} });
+}
+
 sub voidmark { my ($cl, $M) = @_;
     $M->{_ast} = 1;
 }

Niecza/Grammar.pm6

@@ -22,6 +22,23 @@ grammar Q is STD::Q {
     #}
 
     multi method tweak(:$NIL!) { self.cursor_fresh( ::Niecza::Grammar::NIL ) }
+    multi method tweak(:$CgOp!) { self.cursor_fresh( ::Niecza::Grammar::CgOp)}
+}
+
+# an OPP is planned, but I need a better way to write action methods first,
+# since the OPP would necessarily use the same rule names as STD::P6
+grammar CgOp is STD {
+    rule nibbler { <cgexp> }
+
+    token category:cgexp { <sym> }
+    proto token cgexp { <...> }
+
+    token cgopname { \w+ }
+
+    token cgexp:op { '(':s {} <cgopname> [ <cgexp> ]* ')' }
+    token cgexp:name { <cgopname> }
+    token cgexp:quote { <?before <[ ' " ]>> {} [ :lang(%*LANG<MAIN>) <quote> ] }
+    token cgexp:decint { <decint> }
 }
 
 # mnemonic characters: (@, !, =) fetch, store, lvalue.

Op.pm

@@ -30,6 +30,19 @@ use CgOp;
     no Moose;
 }
 
+{
+    package Op::CgOp;
+    use Moose;
+    extends 'Op';
+
+    has op => (is => 'ro', required => 1);
+
+    sub code { $_[0]->op }
+
+    __PACKAGE__->meta->make_immutable;
+    no Moose;
+}
+
 {
     package Op::StatementList;
     use Moose;