view release on metacpan or  search on metacpan

share/P6STD/STD.pm6  view on Meta::CPAN

            elsif $name ~~ s/^\&// {
                self.sorry("Illegal redeclaration of routine '$sid'$loc") unless $name eq '';
            }
            else {  # XXX eventually check for conformant arrays here
                # (redeclaration of identical package vars is not useless)
            }
            return self;
        }
    }
    else {
        $*DECLARAND = $curstash.{$name} = $declaring;
        $curstash.{$shortname} //= $declaring unless $shortname eq $name;
        $*DECLARAND<inpkg> = $curstash.idref;
        if $shortname ~~ /^\w+$/ and $*IN_DECL ne 'constant' {
            $curstash.{"\&$shortname"} //= $declaring;
            $curstash.{"\&$shortname"}<used> = 1;
            $sid ~= "::$name";
            $*NEWPKG = $curstash.{$name ~ '::'} //= Stash.new(
                'PARENT::' => $curstash.idref,
                '!file' => $*FILE, '!line' => self.line,
                '!id' => [$sid] );
        }
    }
    self.add_my_name($n, $declaring, $curstash.{$name ~ '::'}) if $curstash === $*CURPKG;   # the lexical alias
    self;
}

method add_mystery ($token,$pos,$ctx) {
    return self unless $token;
    my $name = $token.Str;
    return self if $*IN_PANIC;
    if self.is_known('&' ~ $name) or self.is_known($name) {
        self.deb("$name is known") if $*DEBUG +& DEBUG::symtab;
    }
    else {
        self.deb("add_mystery $name $*CURLEX") if $*DEBUG +& DEBUG::symtab;
        %*MYSTERY{$name}.<lex> = $*CURLEX;
        %*MYSTERY{$name}.<token> = $token;
        %*MYSTERY{$name}.<ctx> = $ctx;
        %*MYSTERY{$name}.<line> ~= ',' if %*MYSTERY{$name}.<line>;
        %*MYSTERY{$name}.<line> ~= self.lineof($pos);
    }
    self;
}

method explain_mystery() {
    my %post_types;
    my %unk_types;
    my %unk_routines;
    my $m = '';
    for keys(%*MYSTERY) {
        my $p = %*MYSTERY{$_}.<lex>;
        if self.is_name($_, $p) {
            # types may not be post-declared
            %post_types{$_} = %*MYSTERY{$_};
            next;
        }

        next if self.is_known($_, $p) or self.is_known('&' ~ $_, $p);

        # just a guess, but good enough to improve error reporting
        if $_ lt 'a' {
            %unk_types{$_} = %*MYSTERY{$_};
        }
        else {
            %unk_routines{$_} = %*MYSTERY{$_};
        }
    }
    if %post_types {
        my @tmp = sort keys(%post_types);
        $m ~= "Illegally post-declared type" ~ ('s' x (@tmp != 1)) ~ ":\n";
        for @tmp {
            $m ~= "\t'$_' used at line " ~ %post_types{$_}.<line> ~ "\n";
        }
    }
    if %unk_types {
        my @tmp = sort keys(%unk_types);
        $m ~= "Undeclared name" ~ ('s' x (@tmp != 1)) ~ ":\n";
        for @tmp {
            $m ~= "\t'$_' used at line " ~ %unk_types{$_}.<line> ~ "\n";
            $m ~= "\t  (in Perl 6 please use Mu as the most universal type)\n" if $_ eq 'Object';
        }
    }
    if %unk_routines {
        my @tmp = sort keys(%unk_routines);
        $m ~= "Undeclared routine" ~ ('s' x (@tmp != 1)) ~ ":\n";
        my $obs = {
            y => "tr",
            qr => "rx",
            local => "temp (or dynamic var)",
            new => "method call syntax",
            foreach => "for",
        }
        for @tmp {
            $m ~= "\t'$_' used at line " ~ %unk_routines{$_}.<line> ~ "\n";
            $m ~= "\t  (in Perl 6 please use " ~ $obs{$_} ~ " instead)\n" if $obs{$_};
        }
    }
    self.sorry($m) if $m;
    self;
}

method load_setting ($setting) {
    $ALL = self.load_lex($setting);

    $*CORE = $ALL<CORE>;
    $*CORE.<!id> //= ['CORE'];

    $*SETTING = $ALL<SETTING>;
    $*CURLEX = $*SETTING;

    $*GLOBAL = $*CORE.<GLOBAL::> = Stash.new(
        '!file' => $*FILE, '!line' => 1,
        '!id' => ['GLOBAL'],
    );
    $*CURPKG = $*GLOBAL;
}

method is_known ($n, $curlex = $*CURLEX) {
    my $name = $n;
    self.deb("is_known $name") if $*DEBUG +& DEBUG::symtab;