Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

[STDeco] start transitioning to {*} proto stubs

(when bootstrapped and stable, we'll switch from the current {{*}} to {*})
implement 'also' declarator, and attach 'also of' trait to proper $*DECLARAND
$*OFTYPE is now only used to preserve the 'of' type of a scope declarator until there is a declarand


git-svn-id: http://svn.pugscode.org/pugs@31615 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
commit f8625f42786be95ada28448e01245f5b7e71e08f 1 parent 97452a1
lwall authored
View
3  Actions.pm
@@ -124,6 +124,9 @@ sub hoistast {
$r{$k} = $zyg;
# $r{zygs}{$k} = $SEQ++ if @$zyg and $k ne 'sym';
}
+ elsif (ref($v) eq 'HASH') {
+ $r{$k} = $v;
+ }
elsif (ref($v)) {
if ($v->isa('Cursor') && !$v->{_reduced}) {
$r{$k} = $v->{'_ast'} //= hoistast($v);
View
1  NAME.pmc
@@ -17,4 +17,5 @@ sub file { my $self = shift; return $self->{file} };
sub line { my $self = shift; return $self->{line} };
sub xlex { my $self = shift; return $self->{xlex} };
sub olex { my $self = shift; return $self->{olex} };
+sub of { my $self = shift; return $self->{of} };
1;
View
134 STD.pm6
@@ -166,114 +166,114 @@ constant $methodcall_prec = 'y=';
my $*endsym = "null";
my $*endargs = -1;
-proto token category { <...> }
+proto token category {{*}}
token category:category { <sym> }
token category:sigil { <sym> }
-proto token sigil { <...> }
+proto token sigil {{*}}
token category:twigil { <sym> }
-proto token twigil (:$*endsym = 'begid') { <...> }
+proto token twigil (:$*endsym = 'begid') {{*}}
token category:special_variable { <sym> }
-proto token special_variable { <...> }
+proto token special_variable {{*}}
token category:comment { <sym> }
-proto token comment { <...> }
+proto token comment {{*}}
token category:version { <sym> }
-proto token version { <...> }
+proto token version {{*}}
token category:module_name { <sym> }
-proto token module_name { <...> }
+proto token module_name {{*}}
token category:value { <sym> }
-proto token value { <...> }
+proto token value {{*}}
token category:term { <sym> }
-proto token term { <...> }
+proto token term {{*}}
token category:strtonum { <sym> }
-proto token strtonum { <...> }
+proto token strtonum {{*}}
token category:quote { <sym> }
-proto token quote () { <...> }
+proto token quote () {{*}}
token category:prefix { <sym> }
-proto token prefix is unary is defequiv(%symbolic_unary) { <...> }
+proto token prefix is unary is defequiv(%symbolic_unary) {{*}}
token category:infix { <sym> }
-proto token infix is binary is defequiv(%additive) { <...> }
+proto token infix is binary is defequiv(%additive) {{*}}
token category:postfix { <sym> }
-proto token postfix is unary is defequiv(%autoincrement) { <...> }
+proto token postfix is unary is defequiv(%autoincrement) {{*}}
token category:dotty { <sym> }
-proto token dotty (:$*endsym = 'unspacey') { <...> }
+proto token dotty (:$*endsym = 'unspacey') {{*}}
token category:circumfix { <sym> }
-proto token circumfix { <...> }
+proto token circumfix {{*}}
token category:postcircumfix { <sym> }
-proto token postcircumfix is unary { <...> } # unary as far as EXPR knows...
+proto token postcircumfix is unary {{*}} # unary as far as EXPR knows...
token category:quote_mod { <sym> }
-proto token quote_mod { <...> }
+proto token quote_mod {{*}}
token category:trait_mod { <sym> }
-proto token trait_mod (:$*endsym = 'spacey') { <...> }
+proto token trait_mod (:$*endsym = 'spacey') {{*}}
token category:type_declarator { <sym> }
-proto token type_declarator (:$*endsym = 'spacey') { <...> }
+proto token type_declarator (:$*endsym = 'spacey') {{*}}
token category:scope_declarator { <sym> }
-proto token scope_declarator (:$*endsym = 'nofun') { <...> }
+proto token scope_declarator (:$*endsym = 'nofun') {{*}}
token category:package_declarator { <sym> }
-proto token package_declarator (:$*endsym = 'spacey') { <...> }
+proto token package_declarator (:$*endsym = 'spacey') {{*}}
token category:multi_declarator { <sym> }
-proto token multi_declarator (:$*endsym = 'spacey') { <...> }
+proto token multi_declarator (:$*endsym = 'spacey') {{*}}
token category:routine_declarator { <sym> }
-proto token routine_declarator (:$*endsym = 'nofun') { <...> }
+proto token routine_declarator (:$*endsym = 'nofun') {{*}}
token category:regex_declarator { <sym> }
-proto token regex_declarator (:$*endsym = 'spacey') { <...> }
+proto token regex_declarator (:$*endsym = 'spacey') {{*}}
token category:statement_prefix { <sym> }
-proto rule statement_prefix () { <...> }
+proto rule statement_prefix () {{*}}
token category:statement_control { <sym> }
-proto rule statement_control (:$*endsym = 'spacey') { <...> }
+proto rule statement_control (:$*endsym = 'spacey') {{*}}
token category:statement_mod_cond { <sym> }
-proto rule statement_mod_cond (:$*endsym = 'nofun') { <...> }
+proto rule statement_mod_cond (:$*endsym = 'nofun') {{*}}
token category:statement_mod_loop { <sym> }
-proto rule statement_mod_loop (:$*endsym = 'nofun') { <...> }
+proto rule statement_mod_loop (:$*endsym = 'nofun') {{*}}
token category:infix_prefix_meta_operator { <sym> }
-proto token infix_prefix_meta_operator is binary { <...> }
+proto token infix_prefix_meta_operator is binary {{*}}
token category:infix_postfix_meta_operator { <sym> }
-proto token infix_postfix_meta_operator ($op) is binary { <...> }
+proto token infix_postfix_meta_operator ($op) is binary {{*}}
token category:infix_circumfix_meta_operator { <sym> }
-proto token infix_circumfix_meta_operator is binary { <...> }
+proto token infix_circumfix_meta_operator is binary {{*}}
token category:postfix_prefix_meta_operator { <sym> }
-proto token postfix_prefix_meta_operator is unary { <...> }
+proto token postfix_prefix_meta_operator is unary {{*}}
token category:prefix_postfix_meta_operator { <sym> }
-proto token prefix_postfix_meta_operator is unary { <...> }
+proto token prefix_postfix_meta_operator is unary {{*}}
token category:prefix_circumfix_meta_operator { <sym> }
-proto token prefix_circumfix_meta_operator is unary { <...> }
+proto token prefix_circumfix_meta_operator is unary {{*}}
token category:terminator { <sym> }
-proto token terminator { <...> }
+proto token terminator {{*}}
token unspacey { <.unsp>? }
token begid { <?before \w> }
@@ -813,8 +813,8 @@ token charspec {
]
}
-proto token backslash { <...> }
-proto token escape { <...> }
+proto token backslash {{*}}
+proto token escape {{*}}
token starter { <!> }
token escape:none { <!> }
@@ -1255,6 +1255,7 @@ grammar P6 is STD {
:my $*PKGDECL ::= "";
:my $*IN_DECL = '';
:my $*DECLARAND;
+ :my $*OFTYPE;
:my $*NEWPKG;
:my $*NEWLEX;
:my $*QSIGIL ::= '';
@@ -1420,9 +1421,14 @@ grammar P6 is STD {
}
]*
- '{'
- <nibble( $¢.cursor_fresh($lang).unbalanced('}') )>
- [ '}' || <.panic: "Unable to parse regex; couldn't find right brace"> ]
+ [
+ | '{*}' <?{ $*MULTINESS eq 'proto' }> { $¢.<onlystar> = 1 }
+ | [
+ '{'
+ <nibble( $¢.cursor_fresh($lang).unbalanced('}') )>
+ [ '}' || <.panic: "Unable to parse regex; couldn't find right brace"> ]
+ ]
+ ]
<.curlycheck>
}
@@ -1876,9 +1882,9 @@ grammar P6 is STD {
<module_name>
}
- token package_declarator:does {
+ token package_declarator:sym<also> {
<sym>:s
- <typename>
+ <trait>+
}
rule package_def {
@@ -2006,11 +2012,20 @@ grammar P6 is STD {
method checkyada {
try {
- my $startsym = self.<blockoid><statementlist><statement>[0]<EXPR><sym> // '';
- if $startsym eq '...' or $startsym eq '!!!' or $startsym eq '???' {
- $*DECLARAND<stub> = 1;
+ my $statements = self.<blockoid><statementlist><statement>;
+ my $startsym = $statements[0]<EXPR><sym> // '';
+ given $startsym {
+ when '...' { $*DECLARAND<stub> = 1 }
+ when '!!!' { $*DECLARAND<stub> = 1 }
+ when '???' { $*DECLARAND<stub> = 1 }
+ when '*' {
+ if $*MULTINESS eq 'proto' and $statements.elems == 1 {
+ self.<blockoid>:delete;
+ self.<onlystar> = 1;
+ }
+ }
}
- };
+ }
return self;
}
@@ -2128,8 +2143,8 @@ grammar P6 is STD {
token trait_mod:of {
['of'|'returns']:s <typename>
- [ <?{ $*OFTYPE }> <.sorry("Extra 'of' type; already declared as type " ~ $*OFTYPE.Str)> ]?
- { $*OFTYPE = $<typename>; }
+ [ <?{ $*DECLARAND<of> }> <.sorry("Extra 'of' type; already declared as type " ~ $*DECLARAND<of>.Str)> ]?
+ { $*DECLARAND<of> = $<typename>; }
}
token trait_mod:as { <sym>:s <typename> }
token trait_mod:handles { <sym>:s <term> }
@@ -2847,6 +2862,7 @@ grammar P6 is STD {
token fakesignature() {
:temp $*CURLEX;
+ :my $*DECLARAND;
<.newlex>
<signature>
}
@@ -2935,8 +2951,8 @@ grammar P6 is STD {
[
| <value>
| <typename>
- [ <?{ $*OFTYPE }> <.sorry("Extra 'of' type; already declared as type " ~ $*OFTYPE.Str)> ]?
- { $*OFTYPE = $<typename>; }
+ [ <?{ $*DECLARAND<of> }> <.sorry("Extra 'of' type; already declared as type " ~ $*DECLARAND<of>.Str)> ]?
+ { $*DECLARAND<of> = $<typename>; }
| where <.ws> <EXPR(item %chaining)>
]
<.ws>
@@ -4826,21 +4842,21 @@ grammar Regex is STD {
# end tweaks (DO NOT ERASE)
token category:metachar { <sym> }
- proto token metachar { <...> }
+ proto token metachar {{*}}
token category:backslash { <sym> }
- proto token backslash { <...> }
+ proto token backslash {{*}}
token category:assertion { <sym> }
- proto token assertion { <...> }
+ proto token assertion {{*}}
token category:quantifier { <sym> }
- proto token quantifier { <...> }
+ proto token quantifier {{*}}
token category:mod_internal { <sym> }
- proto token mod_internal { <...> }
+ proto token mod_internal {{*}}
- proto token regex_infix { <...> }
+ proto token regex_infix {{*}}
# no such thing as ignored whitespace in a normal regex
token ws { <?> }
@@ -4945,6 +4961,8 @@ grammar Regex is STD {
]
}
+ token metachar:sym<{*}> { <onlystar=.sym> <?{ $*MULTINESS eq 'proto' }> }
+ token metachar:sym<[*]> { <onlystar=.sym> <?{ $*MULTINESS eq 'proto' }> }
token metachar:quant { <quantifier> <.sorry: "Quantifier quantifies nothing"> }
# "normal" metachars
@@ -5451,6 +5469,7 @@ method add_my_name ($n, $d = Nil, $p = Nil) { # XXX gimme doesn't handle optio
name => $name,
file => $*FILE, line => self.line,
mult => ($*MULTINESS||'only'),
+ of => $*OFTYPE,
);
my $old = $curstash.{$name};
if $old and $old<line> and not $old<stub> {
@@ -5551,6 +5570,7 @@ method add_our_name ($n) {
name => $name,
file => $*FILE, line => self.line,
mult => ($*MULTINESS||'only'),
+ of => $*OFTYPE,
);
my $old = $curstash.{$name};
if $old and $old<line> and not $old<stub> {
View
3  stage0/Actions.pm
@@ -124,6 +124,9 @@ sub hoistast {
$r{$k} = $zyg;
# $r{zygs}{$k} = $SEQ++ if @$zyg and $k ne 'sym';
}
+ elsif (ref($v) eq 'HASH') {
+ $r{$k} = $v;
+ }
elsif (ref($v)) {
if ($v->isa('Cursor') && !$v->{_reduced}) {
$r{$k} = $v->{'_ast'} //= hoistast($v);
View
43 stage0/CursorBase.pmc
@@ -220,6 +220,12 @@ sub parsefile {
$result;
}
+# used internally to isolate contextuals in do_need
+sub _parse_module {
+ $_[0]->parsefile($ARGV[0], setting => "CORE");
+ exit 0;
+}
+
## method initparse ($text, :$rule = 'TOP', :$tmp_prefix = '', :$setting = 'CORE', :$actions = '')
sub initparse {
my $self = shift;
@@ -234,6 +240,7 @@ sub initparse {
local $::TMP_PREFIX = $tmp_prefix;
local $::SETTINGNAME = $setting;
local $::ACTIONS = $actions;
+ local $::RECURSIVE_PERL = $args{recursive_perl};
local @::MEMOS = ();
local @::ACTIVE = ();
@@ -294,9 +301,17 @@ sub load_perl_lex {
my $store = "$syml/$setting.lex.store";
mkdir $syml unless -d $syml;
if (-f $store and -M $file and -M $file > -M $store) {
+ # HACK we get hashes with strangely aliased keys from Storable
$LEXS{$setting} = retrieve($store);
}
else {
+ if ($setting eq 'CORE') {
+ die <<EOM;
+syml/CORE.lex.store not found; CORE setting has not yet been compiled.
+This file must be generated using './std CORE.setting' or 'make' before STD.pm6
+can be used.
+EOM
+ }
$LEXS{$setting} = require $file;
store($LEXS{$setting}, $store);
}
@@ -324,7 +339,8 @@ sub load_yaml_lex {
$LEXS{$setting} = retrieve($store);
}
else {
- $LEXS{$setting} = LoadFile($file);
+ # HACK YAML::XS is horribly broken see https://rt.cpan.org/Public/Bug/Display.html?id=53278
+ $LEXS{$setting} = {%{LoadFile($file)}};
store($LEXS{$setting}, $store);
}
# say join ' ', sort keys %{ $LEXS{$setting} };
@@ -341,9 +357,10 @@ sub you_were_here {
my $self = shift;
my $file = $::FILE->{name};
my $all;
- $file =~ s/(\.setting)?$/.syml/;
- $file =~ s!.*/!!;
+ $file = $::UNIT->{'$?LONGNAME'};
$file =~ s/::/\//g;
+ $file .= $1 if $::FILE->{name} =~ /(\.pm6?)/;
+ $file .= '.syml';
$file = $::TMP_PREFIX . "syml/" . $file;
# setting?
@@ -1718,7 +1735,7 @@ sub _REDUCE { my $self = shift;
$self->{_from} = $S;
if ($::ACTIONS) {
eval { $::ACTIONS->$meth($self, @_) };
- warn $@ if $@ and not $@ =~ /locate/;
+ warn $@ if $@ and not $@ =~ /locate object method "\Q$meth/;
}
$self->deb("REDUCE $key from " . $S . " to " . $self->{_pos}) if DEBUG & DEBUG::matchers;
$self;
@@ -1829,7 +1846,14 @@ sub bless { CORE::bless $_[1], $_[0]->WHAT }
my %unicode_map_cache;
BEGIN {
$unicode_map_cache{ALL} = [scalar("\377" x 128) x 1088, "ALL"] ;
- open MAP, "uniprops" or die "cannot open unicode maps: $!";
+ OPEN_UNIPROPS: {
+ my @path = split ':', ($ENV{PERL6LIB} // './lib:.');
+ for (@path) {
+ open MAP, "<", "$_/uniprops" and last OPEN_UNIPROPS;
+ }
+ die "cannot open unicode maps from @path : $!\n";
+ }
+
binmode MAP;
while (defined (my $c = getc MAP)) {
my $name = "";
@@ -1838,8 +1862,7 @@ BEGIN {
read MAP, $name, ord($c);
read MAP, $used, 136;
- $unicode_map_cache{$name} = [];
- $unicode_map_cache{$name}[1088] = $name;
+ $unicode_map_cache{$name} = [ (("") x 1088), $name ];
for (my $i = 0; $i < 1088; $i++) {
if (vec($used, $i, 1)) {
@@ -2822,7 +2845,6 @@ sub do_need { my $self = shift;
my $modfile = $module;
my $topsym;
my $lib = '.';
- my $std = -x 'std' ? './std' : 'std';
if (not @::PERL6LIB) {
if ($ENV{PERL6LIB}) {
@::PERL6LIB = split ':', $ENV{PERL6LIB}
@@ -2870,7 +2892,10 @@ sub do_need { my $self = shift;
}
elsif (-f "$lib/$modfile$ext") {
# say "$std $lib/$module$ext";
- system "$std $lib/$module$ext" and die "Can't compile $lib/$module$ext";
+ local $ENV{STD5PREFIX} = $::TMP_PREFIX;
+ system($::RECURSIVE_PERL // $^X, "-MSTD", "-e", "STD->_parse_module",
+ "$lib/$module$ext") and die "Can't compile $lib/$module$ext";
+ print STDERR "Compiled $lib/$module$ext\n";
$topsym = LoadFile("$syml/$modfile$ext.syml");
}
else {
View
1  stage0/NAME.pmc
@@ -17,4 +17,5 @@ sub file { my $self = shift; return $self->{file} };
sub line { my $self = shift; return $self->{line} };
sub xlex { my $self = shift; return $self->{xlex} };
sub olex { my $self = shift; return $self->{olex} };
+sub of { my $self = shift; return $self->{of} };
1;
View
2  stage0/RE_ast.pmc
@@ -379,7 +379,7 @@ my $NULL = $nfa::NULL;
'\D' => nfa::cclass(['ALL', 'Gc/N']),
'\d' => nfa::cclass(['Gc/N']),
'\H' => nfa::cclass(['ALL', 'Perl/Blank']),
- '\h' => nfa::cclass(['Perl/Blank']),
+ '\h' => nfa::cclass(['Perl/Blank'], ["\015"]),
'\N' => nfa::cclass(['ALL', "\n"]),
'\n' => nfa::cclass(["\n"]),
'\S' => nfa::cclass(['ALL', 'Space/Y']),
View
4,388 stage0/STD.pmc
2,568 additions, 1,820 deletions not shown
View
3  stage0/viv
@@ -62,7 +62,7 @@ our $OPT_thaw = 0;
our $OPT_keep_going = 0;
our $OPT_output_file = undef;
my $PROG = '';
-my $ORIG;
+our $ORIG;
my $U = 0;
my @did_ws;
@@ -4260,5 +4260,6 @@ END
if ($0 eq __FILE__) {
::MAIN(@ARGV);
}
+1;
# vim: ts=8 sw=4 noexpandtab smarttab
Please sign in to comment.
Something went wrong with that request. Please try again.