Skip to content

Commit

Permalink
Import latest STD changes, various tweaks to make my \term:<∞> work...
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorear
sorear committed Jan 26, 2012
1 parent 32dcbb0 commit 931be35
Show file tree
Hide file tree
Showing 2 changed files with 105 additions and 58 deletions.
75 changes: 44 additions & 31 deletions src/STD.pm6
View file
Expand Up @@ -220,6 +220,9 @@ proto token quote_mod {*}
token category:trait_mod { <sym> }
proto token trait_mod is endsym<keyspace> {*}

token category:initializer { <sym> }
proto token initializer is endsym<ws> {*}

token category:type_declarator { <sym> }
proto token type_declarator is endsym<keyspace> {*}

Expand Down Expand Up @@ -1750,7 +1753,7 @@ grammar P6 is STD {
token declarator {
:my $*LEFTSIGIL = '';
[
| '\\' <identifier> <.ws> { $Actions.install_parcel($/) }
| '\\' <defterm> <.ws>
[ <initializer> || <.sorry("Term definition requires an initializer")> ]
| <variable_declarator> <initializer>?
[ <?before <.ws>','<.ws> { @*MEMOS[$¢.pos]<declend> = $*SCOPE; }> ]?
Expand Down Expand Up @@ -2401,6 +2404,11 @@ grammar P6 is STD {



token defterm { # XXX this is probably too general
:dba('new term to be defined')
<identifier> <colonpair>*
}

token deflongname {
:dba('new name to be defined')
<name>
Expand Down Expand Up @@ -2739,7 +2747,7 @@ grammar P6 is STD {
<sym> <.ws>

[
| '\\'? <identifier>
| '\\'? <defterm>
| <variable>
| <?>
]
Expand All @@ -2755,19 +2763,18 @@ grammar P6 is STD {
]
}

token initializer {
<?before '=' | '.=' | ':=' | '::=' >
<infix> <.ws>
[
:my $infix; { $infix = $<infix>.Str; }
[
|| <?{ $infix eq '=' or $infix eq ':=' or $infix eq '::=' }>
[ <EXPR(($*LEFTSIGIL eq '$' ?? (item %item_assignment) !! (item %list_prefix) ))>
|| <.panic: "Malformed initializer"> ]
|| <?{ $infix eq '.=' }>
[ <dottyopish> || <.panic: "Malformed method call"> ]
]
]
token initializer:sym<=> {
<sym> <EXPR(($*LEFTSIGIL eq '$' ?? (item %item_assignment) !! (item %list_prefix) ))>
|| <.panic: "Malformed initializer">
}
token initializer:sym<:=> {
<sym> <EXPR(item %list_prefix)> || <.panic: "Malformed binding">
}
token initializer:sym<::=> {
<sym> <EXPR(item %list_prefix)> || <.panic: "Malformed binding">
}
token initializer:sym<.=> {
<sym> <dottyopish> || <.panic: "Malformed mutator method call">
}

token type_constraint {
Expand All @@ -2792,16 +2799,24 @@ grammar P6 is STD {

token named_param {
:my $*GOAL ::= ')';
:dba('named parameter')
':'
[
| <name=.identifier> '(' <.ws>
[ <named_param> | <param_var> <.ws> ]
[ ')' || <.panic: "Unable to parse named parameter; couldn't find right parenthesis"> ]
| <name=.identifier> '(' ~ ')' <named_param_term>
| <param_var>
| '\\' <varname=.identifier>
| '\\' <defterm>
]
}

token named_param_term {
<.ws>
[
| <named_param>
| <param_var>
| '\\' <defterm>
] <.ws>
}

token param_var {
:dba('formal parameter')
[
Expand Down Expand Up @@ -2865,13 +2880,12 @@ grammar P6 is STD {
@t > 1 and $¢.sorry("Multiple prefix constraints not yet supported")
}
[
| '**' <param_var> { $quant = '**'; $kind = '*'; }
| '**' <param_var> { $quant = '**'; $kind = '*'; }
| '*' <param_var> { $quant = '*'; $kind = '*'; }
| '|' [ <identifier> ]?
{ $quant = '|'; $kind = '!'; }
| '\\' <identifier> { $quant = '\\'; $kind = '!'; }
| '|' <defterm>? { $quant = '|'; $kind = '!'; }
| '\\' <defterm>? { $quant = '\\'; $kind = '!'; }
| '|' <param_var> { $quant = '|'; $kind = '!'; } <.worryobs("| with sigil","| without sigil"," nowadays")>
| '\\' <param_var> { $quant = '\\'; $kind = '!'; } <.worryobs("\\ with sigil","\\ without sigil"," nowadays")>
| '\\' <param_var> { $quant = '\\'; $kind = '!'; } <.worryobs("\\ with sigil","\\ without sigil"," nowadays")>
| [
| <param_var> { $quant = ''; $kind = '!'; }
| <named_param> { $quant = ''; $kind = '*'; }
Expand All @@ -2885,11 +2899,10 @@ grammar P6 is STD {
]

| '**' <param_var> { $quant = '**'; $kind = '*'; }
| '*' <param_var> { $quant = '*'; $kind = '*'; }
| '|' [ <identifier> ]?
{ $quant = '|'; $kind = '!'; }
| '\\' <identifier> { $quant = '\\'; $kind = '!'; }
| '|' <param_var> { $quant = '|'; $kind = '!'; } <.worryobs("| with sigil","| without sigil"," nowadays")>
| '*' <param_var> { $quant = '*'; $kind = '*'; }
| '|' <defterm>? { $quant = '|'; $kind = '!'; }
| '\\' <defterm>? { $quant = '\\'; $kind = '!'; }
| '|' <param_var> { $quant = '|'; $kind = '!'; } <.worryobs("| with sigil","| without sigil"," nowadays")>
| '\\' <param_var> { $quant = '\\'; $kind = '!'; } <.worryobs("\\ with sigil","\\ without sigil"," nowadays")>
| [
| <param_var> { $quant = ''; $kind = '!'; }
Expand Down Expand Up @@ -5520,8 +5533,8 @@ method lookup_compiler_var($name) {

method check_categorical ($name) {
self.deb("check_categorical $name") if $*DEBUG +& DEBUG::symtab;
self.add_categorical(substr($name,1))
if defined($name) && $name ~~ /^\&\w+\:/;
self.add_categorical($0)
if defined($name) && $name ~~ /^\&?(\w+\:.*)/;
}

method trymop($f) {
Expand Down
88 changes: 61 additions & 27 deletions src/niecza
View file
Expand Up @@ -23,6 +23,11 @@ augment class Any {
submethod new(|$) { die "Attempted to instantiate undefined class." }
}

our ($Operator, $Operator_Method, $Operator_Replicate, $Operator_FlipFlop,
$Operator_SmartMatch, $Operator_Comma, $Operator_Binding,
$Operator_ShortCircuit, $Operator_Ternary, $Operator_Temp,
$Operator_DotEq, $Operator_Mixin, $Operator_Let, $Operator_PostCall,
$Operator_Function, $Operator_CompoundAssign); #OK
our ($Op, $OpAttribute, $OpBareBlock, $OpBuiltin, $OpCallLike, $OpCallMethod,
$OpCallSub, $OpCatchyWrapper, $OpCgOp, $OpConditional, $OpConstantDecl,
$OpContextVar, $OpDoOnceLoop, $OpForLoop, $OpGather, $OpGeneralConst,
Expand All @@ -44,14 +49,32 @@ our ($RxOp, $RxOpAlt, $RxOpAny, $RxOpBefore, $RxOpCut, $RxOpConj, $RxOpCutLTM,
our ($Sig, $SigParameter, $PassSimplifier, $CClass); #OK

our $Actions; $Actions = $Actions but role {
method install_parcel($/) {
$/.CURSOR.trymop({
$*CURLEX<!sub>.add_my_name(~$<identifier>, |mnode($/));
});
method FALLBACK($meth, $/) {
my $S = $<sym>;

if substr($meth,0,7) eq 'prefix:' {
make $Operator.funop($/, q:s'&prefix:<$S>', 1);
} elsif substr($meth,0,14) eq 'postcircumfix:' {
make $Operator.funop($/, q:s'&postcircumfix:<$S>', 1, @( $<semilist>.ast ));
} elsif substr($meth,0,10) eq 'circumfix:' {
make mkcall($/, q:s'&circumfix:<$S>', @( $<semilist>.ast ));
} elsif substr($meth,0,8) eq 'postfix:' {
make $Operator.funop($/, q:s'&postfix:<$S>', 1);
} elsif substr($meth,0,6) eq 'infix:' {
make $Operator.funop($/, q:s'&infix:<$S>', 2);
} elsif substr($meth,0,5) eq 'term:' {
if $*CURLEX<!sub>.lookup_lex(q:s"term:<$S>") {
make mklex($/, q:s"term:<$S>");
} else {
make mkcall($/, q:s'&term:<$S>');
}
} else {
$/.CURSOR.sorry("Action method $meth not yet implemented");
}
}
method declarator($/) {
if $<identifier> {
make ~$<identifier>;
if $<defterm> {
make $<defterm>.ast;
self.do_initialize($/, True);
return;
}
Expand Down Expand Up @@ -101,29 +124,31 @@ method install_constant ($/) {
if $*MULTINESS {
$/.CURSOR.sorry("Multi variables NYI");
}
my $name = ~($<identifier> // $<variable> // self.gensym);
my $name = ~($<defterm> // $<variable> // self.gensym);

make self.make_constant($/, $*SCOPE, $name);
}
method named_param_term($/) {
if $<named_param> {
make $<named_param>.ast;
} elsif $<param_var> {
make (anon % = %( $<param_var>.ast ));
$/.ast<names> = []; # completely replace
} else {
make { slot => $<defterm>.ast, names => [ ], flags => $Sig::RWTRANS };
}
}
method named_param($/) {
my %rt;
if $<varname> {
if $<defterm> {
# XXX funky syntax
my $id = ~$<varname>;
$/.CURSOR.trymop({
$*CURLEX<!sub>.add_my_name($id, |mnode($/));
});
my $id = ~$<defterm>;
make { slot => $id, names => [ $id ], flags => $Sig::RWTRANS };
$/.CURSOR.sorry("bare identifier forms NYI");
return;
}
if $<name> {
if $<named_param> {
%rt = %( $<named_param>.ast );
} else {
%rt = %( $<param_var>.ast );
%rt<names> = []; # completely replace
}
%rt = %( $<named_param_term>.ast );
%rt<names> = [ @( %rt<names> // [] ), ~$<name> ]
unless %rt<names> && %rt<names>.grep(~$<name>);
} else {
Expand All @@ -146,15 +171,10 @@ method INFIX($/) {
method parameter($/) {
my $sorry;
my $p = $<param_var> // $<named_param>;
my $p_ast = $p ?? $p.ast !! $<identifier> ??
{ names => [], flags => $Sig::POSITIONAL + $Sig::RWTRANS, slot => ~$<identifier> } !!
my $p_ast = $p ?? $p.ast !! $<defterm> ??
{ names => [], flags => $Sig::POSITIONAL + $Sig::RWTRANS, slot => ~$<defterm> } !!
{ names => [], flags => $Sig::POSITIONAL };
my $flags = $p_ast<flags>;
if $<identifier> {
$/.CURSOR.trymop({
$*CURLEX<!sub>.add_my_name($p_ast<slot>, |mnode($/));
});
}

$flags +|= $Sig::READWRITE if $*SIGNUM && $*CURLEX<!rw_lambda>;

Expand Down Expand Up @@ -232,15 +252,29 @@ method parameter($/) {
}
}

method defterm($/) {
make ~$/;
return if ($*IN_DECL // '') eq 'constant';
$/.CURSOR.trymop({
$*CURLEX<!sub>.add_my_name($/.ast, |mnode($/));
$/.CURSOR.check_categorical($/.ast);
});
}

method initializer($/) { }
method initializer:sym<=> ($/) { make $Operator.funop($/, '&infix:<=>', 2) }
method initializer:sym<:=> ($/) { make $Operator_Binding.new(:!readonly) }
method initializer:sym<::=> ($/) { make $Operator_Binding.new(:readonly) }
method initializer:sym<.=> ($/) { make $Operator_DotEq.new }

method do_initialize($/, $parcel?) {
my $i = $<initializer> or return;
my $fn = $i<infix>.ast;
my $fn = $i.ast;
my $lhs = $/.ast;
my $rhs = ($i<EXPR> // $i<dottyopish>).ast;

if $parcel {
if $i<infix> ne '=' {
if $i<sym> ne '=' {
$/.CURSOR.sorry('Parcel variables may only be set using = for now');
}
make $OpLexicalBind.new(name => $lhs, :$rhs);
Expand Down

0 comments on commit 931be35

Please sign in to comment.