Skip to content

Commit

Permalink
mergeback
Browse files Browse the repository at this point in the history
  • Loading branch information
sorear committed Jan 19, 2012
1 parent 24441d8 commit 5f1d66d
Show file tree
Hide file tree
Showing 2 changed files with 12 additions and 262 deletions.
17 changes: 12 additions & 5 deletions src/NieczaActions.pm6
Expand Up @@ -2177,11 +2177,17 @@ method param_var($/) {
my $hash = $sigil eq '%';
my $name = $<name> ?? ~$<name> !! Any;
my $flags = ($list ?? $Sig::IS_LIST !! 0) + ($hash ?? $Sig::IS_HASH !! 0) +
($sigil eq '&' ?? $Sig::CALLABLE !! 0) + $Sig::POSITIONAL;
my $slot;
if $twigil eq '' {
$slot = defined($name) ?? ($sigil ~ $name) !! Any;
} elsif $twigil eq '*' {
$slot = "$sigil*" ~ "$name";
} elsif $twigil eq ('!' | '.') {
make { :$flags, :$slot, attribute => "$sigil$twigil$name",
names => [ $name ], attribute_type => $*CURLEX<!sub>.cur_pkg };
return;
} else {
$/.CURSOR.sorry("Unhandled parameter twigil $twigil");
make { };
Expand All @@ -2200,9 +2206,7 @@ method param_var($/) {
noinit => ?($*SIGNUM)) if defined($slot);
});
make { :$slot, names => defined($name) ?? [ $name ] !! [],
flags => ($list ?? $Sig::IS_LIST !! 0) + ($hash?? $Sig::IS_HASH !! 0) +
$Sig::POSITIONAL };
make { :$slot, names => defined($name) ?? [ $name ] !! [], :$flags };
}
method parameter($/) {
Expand Down Expand Up @@ -2234,6 +2238,7 @@ method parameter($/) {
elsif $tag eq '\\:?' { $flags +|= ($Sig::RWTRANS + $Sig::OPTIONAL) }
elsif $tag eq ':!' { }
elsif $tag eq ':*' { $flags +|= $Sig::OPTIONAL }
elsif $tag eq '?:*' { $flags +|= $Sig::OPTIONAL }
elsif $tag eq ':?' { $flags +|= $Sig::OPTIONAL }
elsif $tag eq '?:?' { $flags +|= $Sig::OPTIONAL }
elsif $tag eq '!:!' { }
Expand Down Expand Up @@ -2650,7 +2655,7 @@ method add_accessor($/, $name, $store_name, $lexical, $public) {
});
}
method add_attribute($/, $barename, $sigil, $accessor, $type) {
method add_attribute($/, $barename, $sigil, $accessor, $type, $bare) {
my $ns = $*CURLEX<!sub>.body_of;
my $name = $sigil ~ '!' ~ $barename;
$/.CURSOR.sorry("Attribute $name declared outside of any class"),
Expand All @@ -2666,6 +2671,8 @@ method add_attribute($/, $barename, $sigil, $accessor, $type) {
self.add_accessor($/, $barename, $name, False, $accessor);
$/.CURSOR.trymop({
$ns.add_attribute($name, $sigil, +$accessor, $type, |mnode($/));
$*CURLEX<!sub>.add_attr_alias($sigil ~ $barename, $ns, $name)
if $bare;
});
$OpAttribute.new(name => $name, initializer => $ns);
Expand Down Expand Up @@ -2744,7 +2751,7 @@ method variable_declarator($/) {
if $scope eq 'has' {
make self.add_attribute($/, $v<name>, $v<sigil>, $t eq '.',
$typeconstraint);
$typeconstraint, $t eq '');
} elsif $scope eq 'state' {
$/.CURSOR.trymop({
$/.CURSOR.check_categorical($slot);
Expand Down
257 changes: 0 additions & 257 deletions src/niecza
Expand Up @@ -23,266 +23,9 @@ augment class Any {
submethod new(|$) { die "Attempted to instantiate undefined class." }
}

# augment class RxOp {
# method oplift() {
# say "oplift: {self.typename}";
# my $i = 0;
# map { say $i++; .oplift }, @$!zyg
# }
# }

our ($Sig, $SigParameter, $OpGeneralConst, $OpStateDecl, $OpLexical, $OpStatementList, $OpStart, $OpAttribute);

our $Actions; $Actions = $Actions but role {
method parameter($/) {
my $sorry;
my $p = $<param_var> // $<named_param>;
my $p_ast = $p ?? $p.ast !! { names => [], flags => $Sig::POSITIONAL };
my $flags = $p_ast<flags>;

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

for @( $<trait> ) -> $trait {
if $trait.ast<rw> { $flags +|= $Sig::READWRITE }
elsif $trait.ast<copy> { $flags +|= $Sig::IS_COPY }
elsif $trait.ast<parcel> { $flags +|= $Sig::RWTRANS }
elsif $trait.ast<readonly> { $flags +&= +^$Sig::READWRITE }
else {
$trait.CURSOR.sorry('Unhandled trait ' ~ $trait.ast.keys.[0]);
}
}

my $default = $<default_value> ?? $<default_value>.ast !! Any;
$default.set_name("$/ init") if $default;

my $tag = $<quant> ~ ':' ~ $<kind>;
if $tag eq '**:*' { $sorry = "Slice parameters NYI" }
elsif $tag eq '*:*' { $flags +|= ($flags +& $Sig::IS_HASH) ?? $Sig::SLURPY_NAM !! $Sig::SLURPY_POS }
elsif $tag eq '|:*' { $flags +|= $Sig::SLURPY_CAP }
elsif $tag eq '\\:!' { $flags +|= $Sig::RWTRANS }
elsif $tag eq '\\:?' { $flags +|= ($Sig::RWTRANS + $Sig::OPTIONAL) }
elsif $tag eq ':!' { }
elsif $tag eq ':*' { $flags +|= $Sig::OPTIONAL }
elsif $tag eq '?:*' { $flags +|= $Sig::OPTIONAL }
elsif $tag eq ':?' { $flags +|= $Sig::OPTIONAL }
elsif $tag eq '?:?' { $flags +|= $Sig::OPTIONAL }
elsif $tag eq '!:!' { }
elsif $tag eq '!:?' { $flags +|= $Sig::OPTIONAL }
elsif $tag eq '!:*' { }
else { $sorry = "Confusing parameters ($tag)" }
if $sorry { $/.CURSOR.sorry($sorry); }

if defined $p_ast<slot> {
# TODO: type constraint here
}

make $SigParameter.new(name => ~$/, mdefault => $default,
|$p_ast, :$flags);

for @<type_constraint> -> $tc {
if $tc.ast<where> {
push ($/.ast.where //= []), self.thunk_sub($tc.ast<where>.ast);
} elsif $tc.ast<value> {
$/.ast.tclass = $tc.ast<value>.get_type;
push ($/.ast.where //= []), self.thunk_sub(
$OpGeneralConst.new(value => $tc.ast<value>));
} else {
$/.CURSOR.sorry("Parameter coercion NYI") if $tc.ast<as>;
my $type = $tc.ast<type>;
if $type.kind eq 'subset' {
push ($/.ast.where //= []), self.thunk_sub(
$OpGeneralConst.new(value => $type.get_type_var));
$type = $type.get_basetype while $type.kind eq 'subset';
}
$/.ast.tclass = $type;
$/.ast.flags +|= $tc.ast<tmode>;
}
}

for @<post_constraint> -> $pc {
# XXX this doesn't seem to be specced anywhere, but it's
# Rakudo-compatible and shouldn't hurt
if $pc<bracket> {
$/.ast.flags +&= +^$Sig::IS_HASH;
$/.ast.flags +|= $Sig::IS_LIST;
}

if $pc<signature> -> $ssig {
$ssig.CURSOR.sorry('Cannot have more than one sub-signature for a pparameter') if $/.ast.subsig;
$/.ast.subsig = $pc<signature>.ast;
} else {
push ($/.ast.where //= []), self.thunk_sub($pc<EXPR>.ast);
}
}
}
method param_var($/) {
if $<signature> {
make { slot => Any, names => [], subsig => $<signature>.ast,
flags => $Sig::POSITIONAL +
(substr($/,0,1) eq '[' ?? $Sig::IS_LIST !! 0) };
return;
}
my $twigil = $<twigil> ?? ~$<twigil> !! '';
my $sigil = ~$<sigil>;
my $list = $sigil eq '@';
my $hash = $sigil eq '%';
my $name = $<name> ?? ~$<name> !! Any;

my $flags = ($list ?? $Sig::IS_LIST !! 0) + ($hash ?? $Sig::IS_HASH !! 0) +
($sigil eq '&' ?? $Sig::CALLABLE !! 0) + $Sig::POSITIONAL;
my $slot;
if $twigil eq '' {
$slot = defined($name) ?? ($sigil ~ $name) !! Any;
} elsif $twigil eq '*' {
$slot = "$sigil*" ~ "$name";
} elsif $twigil eq ('!' | '.') {
make { :$flags, :$slot, attribute => "$sigil$twigil$name",
names => [ $name ], attribute_type => $*CURLEX<!sub>.cur_pkg };
return;
} else {
$/.CURSOR.sorry("Unhandled parameter twigil $twigil");
make { };
return Nil;
}

if ($sigil ne '$' && $sigil ne '@' && $sigil ne '%' && $sigil ne '&') {
$/.CURSOR.sorry('Non bare scalar targets NYI');
make { }
return Nil;
}

$/.CURSOR.trymop({
$/.CURSOR.check_categorical($slot);
$*CURLEX<!sub>.add_my_name($slot, :$list, :$hash, |mnode($/),
noinit => ?($*SIGNUM)) if defined($slot);
});

make { :$slot, names => defined($name) ?? [ $name ] !! [], :$flags };
}
method variable_declarator($/) {
if $*MULTINESS {
$/.CURSOR.sorry("Multi variables NYI");
}

my $scope = $*SCOPE // 'my';

my $start;
for @$<trait> -> $t {
if $t.ast<rw> {
} elsif $t.ast<dynamic> {
} elsif $t.ast<start> && $*SCOPE eq 'state' {
$start = $t.ast<start>;
} else {
$/.CURSOR.sorry("Trait $t.ast.keys.[0] not available on variables");
}
}
if $<post_constraint> || $<postcircumfix> || $<semilist> {
$/.CURSOR.sorry("Postconstraints, and shapes on variable declarators NYI");
}

if $scope eq 'augment' || $scope eq 'supersede' {
$/.CURSOR.sorry("Illogical scope $scope for simple variable");
}

my $typeconstraint;
if $*OFTYPE {
my $of = $*OFTYPE.ast;
$*OFTYPE.CURSOR.sorry("Only simple types may be attached to variables")
if !$of<type> || $of<tmode> || $of<as>;
$typeconstraint = $of<type> // self.get_Any;
$/.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>;
my $list = $v<sigil> && $v<sigil> eq '@';
my $hash = $v<sigil> && $v<sigil> eq '%';
if ($t && defined "?=~^:".index($t)) {
$/.CURSOR.sorry("Variables with the $t twigil cannot be declared " ~
"using $scope; they are created " ~
($t eq '?' ?? "using 'constant'." !!
$t eq '=' ?? "by parsing POD blocks." !!
$t eq '~' ?? "by 'slang' definitions." !!
"automatically as parameters to the current block."));
}

if ($scope ne any <has our my>) && ($t eq '.' || $t eq '!') {
$/.CURSOR.sorry("Twigil $t is only valid with scopes has, our, or my.");
$scope = 'has';
}

if !defined($v<name>) && ($scope ne any < my anon state >) {
$/.CURSOR.sorry("Scope $scope requires a name");
$v<name> = "anon";
}

if defined($v<pkg>) || defined($v<iname>) {
$/.CURSOR.sorry(":: syntax is only valid when referencing variables, not when defining them.");
}

my $name = defined($v<name>) ?? $v<sigil> ~ $v<twigil> ~ $v<name> !! "";
# otherwise identical to my
my $slot = ($scope eq 'anon' || !defined($v<name>))
?? self.gensym !! $name;

if ($scope eq any <our my>) && $t eq any < . ! > {
$slot = $name = $v<sigil> ~ '!' ~ $v<name>;
self.add_accessor($/, $v<name>, $slot, True, $t eq '.');
}

if $scope eq 'has' {
make self.add_attribute($/, $v<name>, $v<sigil>, $t eq '.',
$typeconstraint, $t eq '');
} elsif $scope eq 'state' {
$/.CURSOR.trymop({
$/.CURSOR.check_categorical($slot);
$*CURLEX<!sub>.add_state_name($slot, self.gensym, :$list,
:$hash, :$typeconstraint, |mnode($/));
});
make $OpStateDecl.new(pos=>$/, inside =>
$OpLexical.new(pos=>$/, name => $slot, :$list, :$hash));
} elsif $scope eq 'our' {
make self.package_var($/, $slot, $slot, ['OUR']);
} else {
$/.CURSOR.trymop({
$/.CURSOR.check_categorical($slot);
$*CURLEX<!sub>.add_my_name($slot, :$list, :$hash,
:$typeconstraint, |mnode($/));
});
make $OpLexical.new(pos=>$/, name => $slot, :$list, :$hash);
}

if $start {
my $cv = self.gensym;
$*CURLEX<!sub>.add_state_name(Str, $cv);
make mklet($/.ast, -> $ll {
$OpStatementList.new(pos=>$/, children => [
$OpStart.new(condvar => $cv, body =>
self.inliney_call($/, $start, $ll)), $ll ]) });
}
}
method add_attribute($/, $barename, $sigil, $accessor, $type, $bare) {
my $ns = $*CURLEX<!sub>.body_of;
my $name = $sigil ~ '!' ~ $barename;
$/.CURSOR.sorry("Attribute $name declared outside of any class"),
return $OpStatementList.new unless $ns;
$/.CURSOR.sorry("Attribute $name declared in an augment"),
return $OpStatementList.new if defined $*AUGMENT_BUFFER;

if !$ns.CAN('add_attribute') {
$/.CURSOR.sorry("A $ns.WHAT() cannot have attributes");
return $OpStatementList.new
}

self.add_accessor($/, $barename, $name, False, $accessor);
$/.CURSOR.trymop({
$ns.add_attribute($name, $sigil, +$accessor, $type, |mnode($/));
$*CURLEX<!sub>.add_attr_alias($sigil ~ $barename, $ns, $name)
if $bare;
});

$OpAttribute.new(name => $name, initializer => $ns);
}
}

# remove run_dispatch
Expand Down

0 comments on commit 5f1d66d

Please sign in to comment.