Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
mergeback
  • Loading branch information
@sorear
sorear committed Mar 13, 2011
1 parent 7caf678 commit 22617be
Show file tree
Hide file tree
Showing 5 changed files with 73 additions and 414 deletions.
1 change: 1 addition & 0 deletions src/CgOp.pm6
View file
Expand Up @@ -283,6 +283,7 @@ method bif_cross($fcn,$pcl) { self._cgop("bif_cross",$fcn,$pcl) }
method letscope(*@items) { self._cgop('letscope', @items) }
method xspan(*@items) { self._cgop('xspan', @items) }
method bif_mod($x,$y) { self._cgop('bif_mod', $x, $y) }
method bif_simple_eval($str) { self._cgop("bif_simple_eval", $str) }
method double($x) {
# Hack - prevent JSON syntax errors
Expand Down
85 changes: 62 additions & 23 deletions src/NieczaActions.pm6
View file
Expand Up @@ -40,13 +40,17 @@ method FALLBACK($meth, $/) {
make Operator.funop('&postfix:<' ~ self.get_op_sym($/) ~ '>', 1);
} elsif $p eq 'v=' || $p eq 'o=' {
make Operator.funop('&prefix:<' ~ self.get_op_sym($/) ~ '>', 1);
} elsif $p eq 'z=' && !$<semilist> {
make mkcall($/, '&term:<' ~ self.get_op_sym($/) ~ '>');
}
} elsif substr($meth,0,7) eq 'prefix:' {
make Operator.funop('&prefix:<' ~ self.get_op_sym($/) ~ '>', 1);
} elsif substr($meth,0,8) eq 'postfix:' {
make Operator.funop('&postfix:<' ~ self.get_op_sym($/) ~ '>', 1);
} elsif substr($meth,0,6) eq 'infix:' {
make Operator.funop('&infix:<' ~ self.get_op_sym($/) ~ '>', 2);
} elsif substr($meth,0,5) eq 'term:' {
make mkcall($/, '&term:<' ~ self.get_op_sym($/) ~ '>');
} else {
$/.CURSOR.sorry("Action method $meth not yet implemented");
}
Expand Down Expand Up @@ -201,6 +205,11 @@ method unqual_longname($/, $what, $clean?) {
return $h<name>;
}

method simple_longname($/) {
my $r = self.mangle_longname($/);
($r<rest>:exists) ?? [ @($r<rest>), $r<name> ] !! [ 'MY', $r<name> ];
}

method mangle_longname($/, $clean?) {
my @ns = @( $<name>.ast<names> );
my $n = pop @ns;
Expand Down Expand Up @@ -1205,6 +1214,7 @@ method infix:sym<//>($/) { make ::Operator::ShortCircuit.new(kind => '//') }
method infix:sym<orelse>($/) { make ::Operator::ShortCircuit.new(kind => '//') }
method infix:sym<andthen>($/) { make ::Operator::ShortCircuit.new(kind => 'andthen') }
method infix:sym<?? !!>($/) { make ::Operator::Ternary.new(middle => $<EXPR>.ast) }
method infix:sym<.=> ($/) { make ::Operator::DotEq.new }

method prefix:temp ($/) { make ::Operator::Temp.new }

Expand Down Expand Up @@ -1374,6 +1384,7 @@ method methodop($/) {
$/.ast.args = $<arglist>[0].ast if $<arglist>[0];
}

method dottyopish ($/) { make $<term>.ast }
method dottyop($/) {
if $<colonpair> {
$/.CURSOR.sorry("Colonpair dotties NYI");
Expand All @@ -1396,6 +1407,10 @@ method privop($/) {
method dotty:sym<.> ($/) { make $<dottyop>.ast }

method dotty:sym<.*> ($/) {
if $<sym> eq '.=' {
make $<dottyop>.ast.meta_assign;
return;
}
if !$<dottyop>.ast.^isa(::Operator::Method) {
$/.CURSOR.sorry("Modified method calls can only be used with actual methods");
make Operator.funop('&postfix:<++>', 1);
Expand Down Expand Up @@ -1633,15 +1648,15 @@ method variable($/) {
Any;
if defined($dsosl) && defined($dsosl<ind>) {
make { term => self.docontext($/, $sigil, $dsosl<ind>) };
return Nil;
return;
} elsif defined $dsosl {
($name, $rest) = $dsosl<name path>;
} elsif $<name> {
# Both these cases are marked XXX in STD. I agree. What are they for?
if $<name>[0].ast<dc> {
$/.CURSOR.sorry("*ONE* pair of leading colons SHALL BE ENOUGH");
make { term => ::Op::StatementList.new };
return Nil;
return;
}
if substr(~$/,0,3) eq '$::' {
$rest = $<name>[0].ast.<names>;
Expand All @@ -1650,7 +1665,7 @@ method variable($/) {
if $<name>[0].ast<names> > 1 {
$/.CURSOR.sorry("Nonsensical attempt to qualify a self-declared named parameter detected");
make { term => ::Op::StatementList.new };
return Nil;
return;
}
$name = $<name>[0].ast<names>[0];
$twigil = ':';
Expand All @@ -1672,16 +1687,15 @@ method variable($/) {
receiver => ::Op::ContextVar.new(name => '$*/'),
positionals => $<postcircumfix>[0].ast.args)
};
return Nil;
return;
} else {
$/.CURSOR.sorry("Contextualizer variables NYI");
make { term => ::Op::StatementList.new };
return Nil;
make { term => self.docontext($/, $sigil, $<postcircumfix>[0].ast.args[0]) };
return;
}
} else {
$/.CURSOR.sorry("Non-simple variables NYI");
make { term => ::Op::StatementList.new };
return Nil;
return;
}

make {
Expand Down Expand Up @@ -1756,6 +1770,11 @@ method parameter($/) {
my $slurpycap;
my $optional;
my $rwt;
my $type;

if $<type_constraint> {
$type = self.simple_longname($<type_constraint>[0]<typename><longname>);
}

for @( $<trait> ) -> $trait {
if $trait.ast<rw> { $rw = True }
Expand Down Expand Up @@ -1792,7 +1811,7 @@ method parameter($/) {
my $p = $<param_var> // $<named_param>;

make ::Sig::Parameter.new(name => ~$/, :$default,
:$optional, :$slurpy, readonly => !$rw,
:$optional, :$slurpy, readonly => !$rw, type => ($type // 'Any'),
:$slurpycap, rwtrans => $rwt, |$p.ast);
}

Expand Down Expand Up @@ -2011,6 +2030,7 @@ method scope_declarator:has ($/) { make $<scoped>.ast }
method scope_declarator:state ($/) { make $<scoped>.ast }
method scope_declarator:anon ($/) { make $<scoped>.ast }

method multi_declarator:null ($/) { make $<declarator>.ast }
method multi_declarator:multi ($/) { make ($<declarator> // $<routine_def>).ast}
method multi_declarator:proto ($/) { make ($<declarator> // $<routine_def>).ast}
method multi_declarator:only ($/) { make ($<declarator> // $<routine_def>).ast}
Expand All @@ -2029,6 +2049,12 @@ method variable_declarator($/) {
$/.CURSOR.sorry("Illogical scope $scope for simple variable");
}

my $typeconstraint;
if $*OFTYPE {
$typeconstraint = self.simple_longname($*OFTYPE<longname>);
$/.CURSOR.sorry("Common variables are not unique definitions and may not have types") if $scope eq 'our';
}

my $v = $<variable>.ast;
my $t = $v<twigil>;
if ($t && defined "?=~^:".index($t)) {
Expand All @@ -2054,17 +2080,17 @@ method variable_declarator($/) {

if $scope eq 'has' {
make ::Op::Attribute.new(|node($/), name => $v<name>,
accessor => $t eq '.');
accessor => $t eq '.', :$typeconstraint);
} elsif $scope eq 'state' {
make ::Op::Lexical.new(|node($/), name => $slot, state_decl => True,
state_backing => self.gensym, declaring => True,
state_backing => self.gensym, declaring => True, :$typeconstraint,
list => $v<sigil> eq '@', hash => $v<sigil> eq '%');
} elsif $scope eq 'our' {
make ::Op::PackageVar.new(|node($/), name => $slot, slot => $slot,
path => [ 'OUR' ]);
} else {
make ::Op::Lexical.new(|node($/), name => $slot, declaring => True,
list => $v<sigil> eq '@', hash => $v<sigil> eq '%');
list => $v<sigil> eq '@', hash => $v<sigil> eq '%', :$typeconstraint);
}
}

Expand Down Expand Up @@ -2369,6 +2395,7 @@ method package_def ($/) {
if !$<longname> {
$scope = 'anon';
}

if $scope eq 'supersede' {
$/.CURSOR.sorry('Supercede is not yet supported');
return Nil;
Expand All @@ -2380,23 +2407,33 @@ method package_def ($/) {

my ($name, $outervar, @augpkg);

my $optype = %_decl2class{$*PKGDECL};
my $blocktype = $*PKGDECL;
my $bodyvar = self.gensym;
my ($ourpkg, $ourvar);

if $scope eq 'augment' {
my $r = self.mangle_longname($<longname>[0]);
my $r = self.mangle_longname($<longname>[0], True);
$name = $r<name>;
@augpkg = @( $r<path> // ['MY'] );
} elsif $<longname> {
my $r = self.mangle_longname($<longname>[0], True);
$name = $r<name>;
if ($r<path>:exists) && $scope ne 'our' {
$/.CURSOR.sorry("Block name $<longname> requires our scope");
$scope = 'our';
}
if $scope eq 'our' {
$ourpkg = ($r<path>:exists) ?? $r<path> !! ['OUR'];
$ourvar = $r<name>;
}
$outervar = ($scope eq 'anon' || ($r<path>:exists)) ?? self.gensym
!! $name;
} else {
$name = $<longname> ??
self.unqual_longname($<longname>[0],
"Qualified package definitions NYI", True) !! 'ANON';
$outervar = $scope ne 'anon' ?? $name !! self.gensym;
$name = 'ANON';
$outervar = self.gensym;
}

my $optype = %_decl2class{$*PKGDECL};
my $blocktype = $*PKGDECL;
my $bodyvar = self.gensym;
# currently always install into the local stash
my $ourpkg = ($scope eq 'our') ?? [ 'OUR::' ] !! Any;

if $scope eq 'augment' {
my $stmts = $<statementlist> // $<blockoid>;
$stmts = $stmts.ast;
Expand Down Expand Up @@ -2426,13 +2463,15 @@ method package_def ($/) {
exports => @export,
bodyvar => $bodyvar,
ourpkg => $ourpkg,
ourvar => $ourvar,
body => $cbody);
} else {
make $optype.new(
|node($/),
name => $name,
var => $outervar,
ourpkg => $ourpkg,
ourvar => $ourvar,
stub => True);
}
}
Expand Down
9 changes: 9 additions & 0 deletions src/Operator.pm6
View file
Expand Up @@ -222,3 +222,12 @@ class SmartMatch is Operator {
name => 'ACCEPTS', args => [ mklex($/, '$_') ]));
}
}

class DotEq is Operator {
method assignish() { True }
method meta_assign() { die ".= may not be metaoperated" }
method meta_not() { die ".= may not be metaoperated" }
method with_args($/, *@args) {
@args[1].meta_assign.with_args($/, @args[0]);
}
}
2 changes: 1 addition & 1 deletion src/STD.pm6
View file
Expand Up @@ -3241,7 +3241,7 @@ grammar P6 is STD {
|| { $term = 1 }
]

<O(|($op<O>), |%list_prefix, assoc => 'unary', uassoc => 'left', term => $term)>
<O(|%($op<O>), |%list_prefix, assoc => 'unary', uassoc => 'left', term => $term)>
$<sym> = {$<s>.Str}

}
Expand Down

0 comments on commit 22617be

Please sign in to comment.