Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
refactor Type:D so that it requires an initializer 
Calling .new on the type internally seemed to makes sence when you think
of e.g. Int:D, but it will get problematic quickly when the constructor
would need arguments... Therefore, an initializer has to be specified.
  • Loading branch information
@FROGGS
FROGGS committed Oct 6, 2015
1 parent 54746f2 commit 7f0e6a5
Show file tree
Hide file tree
Showing 4 changed files with 59 additions and 76 deletions.
57 changes: 4 additions & 53 deletions src/Perl6/Actions.nqp
View file
Expand Up @@ -2562,7 +2562,7 @@ Compilation unit '$file' contained the following violations:
$/.CURSOR.panic("Cannot declare an anonymous attribute");
}
my $attrname := ~$sigil ~ '!' ~ $desigilname;
my %cont_info := container_type_info($/, $sigil, $*OFTYPE ?? [$*OFTYPE] !! [], $shape, :@post);
my %cont_info := $*W.container_type_info($/, $sigil, $*OFTYPE ?? [$*OFTYPE] !! [], $shape, :@post);
my $descriptor := $*W.create_container_descriptor(
%cont_info<value_type>, 1, $attrname, %cont_info<default_value>);

Expand Down Expand Up @@ -2632,7 +2632,7 @@ Compilation unit '$file' contained the following violations:

# Create a container descriptor. Default to rw and set a
# type if we have one; a trait may twiddle with that later.
my %cont_info := container_type_info($/, $sigil, $*OFTYPE ?? [$*OFTYPE] !! [], $shape, :@post);
my %cont_info := $*W.container_type_info($/, $sigil, $*OFTYPE ?? [$*OFTYPE] !! [], $shape, :@post);
my $descriptor := $*W.create_container_descriptor(
%cont_info<value_type>, 1, $varname || $name, %cont_info<default_value>);

Expand Down Expand Up @@ -2704,47 +2704,6 @@ Compilation unit '$file' contained the following violations:
$past
}

sub container_type_info($/, $sigil, @value_type, $shape, :@post) {
if @value_type {
my $of := @value_type[0].ast;
my $D;
my $U;
for (@value_type[0]<longname> ?? @value_type[0]<longname><colonpair> !! @value_type[0]<colonpair>) {
if $_<identifier> {
if $_<identifier>.Str eq 'D' {
$D := 1;
}
elsif $_<identifier>.Str eq 'U' {
$U := 1;
}
else {
$*W.throw($/, ['X', 'InvalidTypeSmiley'],
name => $_<identifier>.Str)
}
}
}

if $D {
my $Pair := $*W.find_symbol(['Pair']);
@post.push($Pair.new('defined', 1));
$*W.container_type_info($/, $sigil, [$of], $shape, :@post,
:subset_name(~@value_type[0]), :default_value($of.new()));
}
elsif $U {
my $Pair := $*W.find_symbol(['Pair']);
@post.push($Pair.new('defined', 0));
$*W.container_type_info($/, $sigil, [$of], $shape, :@post,
:subset_name(~@value_type[0]));
}
else {
$*W.container_type_info($/, $sigil, [$of], $shape, :@post);
}
}
else {
$*W.container_type_info($/, $sigil, [], $shape, :@post);
}
}

sub add_lexical_accessor($/, $var_past, $meth_name, $install_in) {
# Generate and install code block for accessor.
my $a_past := $*W.push_lexpad($/);
Expand Down Expand Up @@ -4404,16 +4363,8 @@ Compilation unit '$file' contained the following violations:
}
%*PARAM_INFO<of_type> := %*PARAM_INFO<nominal_type>;
%*PARAM_INFO<of_type_match> := $<typename>;
for ($<typename><longname> ?? $<typename><longname><colonpair> !! $<typename><colonpair>) {
if $_<identifier> {
if $_<identifier>.Str eq 'D' {
%*PARAM_INFO<defined_only> := 1;
}
elsif $_<identifier>.Str eq 'U' {
%*PARAM_INFO<undefined_only> := 1;
}
}
}
%*PARAM_INFO<defined_only> := 1 if $<typename><colonpairs><D>;
%*PARAM_INFO<undefined_only> := 1 if $<typename><colonpairs><U>;
}
}
elsif $<value> {
Expand Down
50 changes: 31 additions & 19 deletions src/Perl6/Grammar.nqp
View file
Expand Up @@ -2309,8 +2309,14 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
[ <.ws> <term_init=initializer> || <.typed_panic: "X::Syntax::Term::MissingInitializer"> ]
| <variable_declarator>
[
|| <?{ $*SCOPE eq 'has' }> <.newpad> [ <.ws> <initializer> ]? { $*ATTR_INIT_BLOCK := $*W.pop_lexpad() }
|| [ <.ws> <initializer> ]?
|| <?{ $*SCOPE eq 'has' }> <.newpad>
[
|| <.ws> <initializer>
|| <?{ $*OFTYPE<colonpairs><D> }> { self.typed_panic: "X::Syntax::Variable::MissingInitializer", type => ~$*OFTYPE }
]? { $*ATTR_INIT_BLOCK := $*W.pop_lexpad() }
|| <.ws> <initializer>
|| <?{ $*OFTYPE<colonpairs><D> }> { self.typed_panic: "X::Syntax::Variable::MissingInitializer", type => ~$*OFTYPE }
|| <?>
]
| '(' ~ ')' <signature('variable')> [ <.ws> <trait>+ ]? [ <.ws> <initializer> ]?
| <routine_declarator>
Expand Down Expand Up @@ -3333,6 +3339,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token bare_complex_number { <?before <[\-+0..9<>:.eEboxdInfNa\\]>+? 'i'> <re=.signed-number> <?[\-+]> <im=.signed-number> \\? 'i' }

token typename {
:my %colonpairs;
[
| '::?'<identifier> <colonpair>* # parse ::?CLASS as special case
| <longname>
Expand All @@ -3347,6 +3354,20 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
<.unsp>? [ <?[[]> '[' ~ ']' <arglist> ]?
<.unsp>? [ <?[(]> '(' ~ ')' [<.ws> [<accept=.typename> || $<accept_any>=<?>] <.ws>] ]?
[<.ws> 'of' <.ws> <typename> ]?
{
for ($<longname> ?? $<longname><colonpair> !! $<colonpair>) {
if $_<identifier> {
my $name := $_<identifier>.Str;
if $name eq 'D' || $name eq 'U' {
%colonpairs{$name} := 1;
}
else {
$*W.throw($/, ['X', 'InvalidTypeSmiley'], :$name)
}
}
}
}
[<?{ %colonpairs }> <colonpairs=.AS_MATCH(%colonpairs)>]?
}

token typo_typename($panic = 0) {
Expand Down Expand Up @@ -3714,14 +3735,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
[ <?before '='> <infix_postfix_meta_operator> { $*OPER := $<infix_postfix_meta_operator> }
]?
]
<OPER=.asOPER($*OPER)>
}

method asOPER($OPER) {
my $cur := self.'!cursor_start_cur'();
$cur.'!cursor_pass'(self.pos());
nqp::bindattr($cur, NQPCursor, '$!match', $OPER);
$cur
<OPER=.AS_MATCH($*OPER)>
}

token fake_infix {
Expand Down Expand Up @@ -3831,24 +3845,22 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
{} <infixish('hyper')>
$<closing>=[ '«' | '»' || <.missing("« or »")> ]
<.can_meta($<infixish>, "hyper with")>
{} <O=.copyO($<infixish>)>
{} <O=.AS_MATCH($<infixish><OPER><O>)>
}

token infix_circumfix_meta_operator:sym«<< >>» {
$<opening>=[ '<<' | '>>' ]
{} <infixish('HYPER')>
$<closing>=[ '<<' | '>>' || <.missing("<< or >>")> ]
{} <O=.copyO($<infixish>)>
{} <O=.AS_MATCH($<infixish><OPER><O>)>
}

method copyO($from) {
my $O := $from<OPER><O>;
my $cur := self.'!cursor_start_cur'();
method AS_MATCH($v) {
my $cur := self.'!cursor_start_cur'();
$cur.'!cursor_pass'(self.pos());
nqp::bindattr($cur, NQPCursor, '$!match', $O);
nqp::bindattr($cur, NQPCursor, '$!match', $v);
$cur
}

method revO($from) {
my $O := nqp::clone($from<OPER><O>);
my $cur := self.'!cursor_start_cur'();
Expand Down Expand Up @@ -4142,7 +4154,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
<sym> <![!]> {} [ <infixish('neg')> || <.panic: "Negation metaoperator not followed by valid infix"> ]
[
|| <?{ $<infixish>.Str eq '=' }> <O('%chaining')>
|| <.can_meta($<infixish>, "negate")> <?{ $<infixish><OPER><O><iffy> }> <O=.copyO($<infixish>)>
|| <.can_meta($<infixish>, "negate")> <?{ $<infixish><OPER><O><iffy> }> <O=.AS_MATCH($<infixish><OPER><O>)>
|| { self.typed_panic: "X::Syntax::CannotMeta", meta => "negate", operator => ~$<infixish>, dba => ~$<infixish><OPER><O><dba>, reason => "not iffy enough" }
]
}
Expand All @@ -4156,7 +4168,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token infix_prefix_meta_operator:sym<S> {
<sym> <infixish('S')> {}
<.can_meta($<infixish>, "sequence the args of")>
<O=.copyO($<infixish>)>
<O=.AS_MATCH($<infixish><OPER><O>)>
}

token infix_prefix_meta_operator:sym<X> {
Expand Down
23 changes: 19 additions & 4 deletions src/Perl6/World.nqp
View file
Expand Up @@ -1222,10 +1222,25 @@ class Perl6::World is HLL::World {
# attribute/lexpad), bind constraint (what could we bind to this
# slot later), and if specified a constraint on the inner value
# and a default value.
method container_type_info($/, $sigil, @value_type, $shape?, :@post, :$subset_name, :$default_value) {
method container_type_info($/, $sigil, @value_type, $shape?, :@post) {
my %info;
%info<sigil> := $sigil;
@value_type[0] := nqp::decont(@value_type[0]) if @value_type;
my $subset_name;

if @value_type {
if @value_type[0]<colonpairs><D> {
my $subset_name := ~@value_type[0];
my $Pair := $*W.find_symbol(['Pair']);
@post.push($Pair.new('defined', 1));
}
elsif @value_type[0]<colonpairs><U> {
my $subset_name := ~@value_type[0];
my $Pair := $*W.find_symbol(['Pair']);
@post.push($Pair.new('defined', 0));
}
@value_type[0] := nqp::decont(@value_type[0].ast);
}

for @post -> $con {
@value_type[0] := self.create_subset(self.resolve_mo($/, 'subset'),
@value_type ?? @value_type[0] !! self.find_symbol(['Mu']),
Expand Down Expand Up @@ -1320,7 +1335,7 @@ class Perl6::World is HLL::World {
if @value_type {
%info<bind_constraint> := @value_type[0];
%info<value_type> := @value_type[0];
%info<default_value> := $default_value // @value_type[0];
%info<default_value> := @value_type[0];
}
else {
%info<bind_constraint> := self.find_symbol(['Mu']);
Expand Down Expand Up @@ -1442,7 +1457,7 @@ class Perl6::World is HLL::World {
my $varast := $var.ast;
my $name := $varast.name;
my $BLOCK := self.cur_lexpad();
my %cont_info := self.container_type_info(NQPMu, $var<sigil>, $*OFTYPE ?? [$*OFTYPE.ast] !! []);
my %cont_info := self.container_type_info(NQPMu, $var<sigil>, $*OFTYPE ?? [$*OFTYPE] !! []);
my $descriptor := self.create_container_descriptor(%cont_info<value_type>, 1, $name);

self.install_lexical_container($BLOCK, $name, %cont_info, $descriptor,
Expand Down
5 changes: 5 additions & 0 deletions src/core/Exception.pm
View file
Expand Up @@ -1387,6 +1387,11 @@ my class X::Syntax::Term::MissingInitializer does X::Syntax {
method message { 'Term definition requires an initializer' }
}

my class X::Syntax::Variable::MissingInitializer does X::Syntax {
has $.type;
method message { "Variable definition of type $.type requires an initializer" }
}

my class X::Syntax::AddCategorical::TooFewParts does X::Syntax {
has $.category;
has $.needs;
Expand Down

0 comments on commit 7f0e6a5

Please sign in to comment.