Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'nom' of github.com:rakudo/rakudo into froggs_multibyte

  • Loading branch information...
commit a73e440f33d11168cf4bb129daf0b8e6b00f8fba 2 parents 86f3726 + 8308596
@FROGGS FROGGS authored
View
21 src/Perl6/Grammar.pm
@@ -275,7 +275,8 @@ role STD {
my $name := $varast.name;
if $name ne '%_' && $name ne '@_' && !$*W.is_lexical($name) {
if $var<sigil> ne '&' {
- $*W.throw($var, ['X', 'Undeclared'], symbol => $varast.name());
+ my @suggestions := $*W.suggest_lexicals($name);
+ $*W.throw($var, ['X', 'Undeclared'], symbol => $varast.name(), suggestions => @suggestions);
}
else {
$var.CURSOR.add_mystery($varast.name, $var.to, 'var');
@@ -880,12 +881,14 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
# Tag UNIT with a magical lexical. Also if we're compiling CORE,
# give it such a tag too.
if %*COMPILING<%?OPTIONS><setting> eq 'NULL' {
- $*W.install_lexical_symbol($*UNIT, '!CORE_MARKER',
- $*W.pkg_create_mo($/, %*HOW<package>, :name('!CORE_MARKER')));
+ my $marker := $*W.pkg_create_mo($/, %*HOW<package>, :name('!CORE_MARKER'));
+ $marker.HOW.compose($marker);
+ $*W.install_lexical_symbol($*UNIT, '!CORE_MARKER', $marker);
}
else {
- $*W.install_lexical_symbol($*UNIT, '!UNIT_MARKER',
- $*W.pkg_create_mo($/, %*HOW<package>, :name('!UNIT_MARKER')));
+ my $marker := $*W.pkg_create_mo($/, %*HOW<package>, :name('!UNIT_MARKER'));
+ $marker.HOW.compose($marker);
+ $*W.install_lexical_symbol($*UNIT, '!UNIT_MARKER', $marker);
}
}
@@ -3002,7 +3005,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
| <longname>
| <?before '$' | '@' | '&' > <variable> { self.check_variable($<variable>) }
| <?before <[ ' " ]> >
- [ <!{$*QSIGIL}> || <!before '"' <-["]>*? \s > ] # dwim on "$foo."
+ [ <!{$*QSIGIL}> || <!before '"' <-["]>*? [\s|$] > ] # dwim on "$foo."
<quote>
[ <?before '(' | '.(' | '\\'> || <.panic: "Quoted method name requires parenthesized arguments. If you meant to concatenate two strings, use '~'."> ]
] <.unsp>?
@@ -3311,6 +3314,8 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}
}
+ my %routine_suggestion := hash();
+
for %*MYSTERY {
my %sym := $_.value;
my $name := %sym<name>;
@@ -3332,13 +3337,15 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}
else {
%unk_routines{$name} := [] unless %unk_routines{$name};
+ my @suggs := $*W.suggest_routines($name);
+ %routine_suggestion{$name} := @suggs;
push_lines(%unk_routines{$name}, %sym<pos>);
}
}
if %post_types || %unk_types || %unk_routines {
self.typed_sorry('X::Undeclared::Symbols',
- :%post_types, :%unk_types, :%unk_routines);
+ :%post_types, :%unk_types, :%unk_routines, :%routine_suggestion);
}
self;
View
223 src/Perl6/World.pm
@@ -47,6 +47,124 @@ sub p6ize_recursive($x) {
pir::perl6ize_type__PP($x);
}
+# this levenshtein implementation is used to suggest good alternatives
+# when deriving from an unknown/typo'd class.
+sub levenshtein($a, $b) {
+ my %memo;
+ my $alen := nqp::chars($a);
+ my $blen := nqp::chars($b);
+
+ return 0 if $alen eq 0 || $blen eq 0;
+
+ # the longer of the two strings is an upper bound.
+ #my $bound := $alen < $blen ?? $blen !! $alen;
+
+ sub changecost($ac, $bc) {
+ sub issigil($_) { nqp::index('$@%&|', $_) != -1 };
+ return 0 if $ac eq $bc;
+ return 0.5 if nqp::uc($ac) eq nqp::lc($bc);
+ return 0.5 if issigil($ac) && issigil($bc);
+ return 1;
+ }
+
+ sub levenshtein_impl($apos, $bpos, $estimate) {
+ my $key := nqp::join(":", ($apos, $bpos));
+
+ return %memo{$key} if nqp::existskey(%memo, $key);
+
+ # if either cursor reached the end of the respective string,
+ # the result is the remaining length of the other string.
+ sub check($pos1, $len1, $pos2, $len2) {
+ if $pos2 == $len2 {
+ return $len1 - $pos1;
+ }
+ return -1;
+ }
+
+ my $check := check($apos, $alen, $bpos, $blen);
+ return $check unless $check == -1;
+ $check := check($bpos, $blen, $apos, $alen);
+ return $check unless $check == -1;
+
+ my $achar := nqp::substr($a, $apos, 1);
+ my $bchar := nqp::substr($b, $bpos, 1);
+
+ my $cost := changecost($achar, $bchar);
+
+ # hyphens and underscores cost half when adding/deleting.
+ my $addcost := 1;
+ $addcost := 0.5 if $bchar eq "-" || $bchar eq "_";
+
+ my $delcost := 1;
+ $delcost := 0.5 if $achar eq "-" || $achar eq "_";
+
+ my $ca := levenshtein_impl($apos+1, $bpos, $estimate+$delcost) + $delcost; # what if we remove the current letter from A?
+ my $cb := levenshtein_impl($apos, $bpos+1, $estimate+$addcost) + $addcost; # what if we add the current letter from B?
+ my $cc := levenshtein_impl($apos+1, $bpos+1, $estimate+$cost) + $cost; # what if we change/keep the current letter?
+
+ # the result is the shortest of the three sub-tasks
+ my $distance;
+ $distance := $ca if $ca <= $cb && $ca <= $cc;
+ $distance := $cb if $cb <= $ca && $cb <= $cc;
+ $distance := $cc if $cc <= $ca && $cc <= $cb;
+
+ # switching two letters costs only 1 instead of 2.
+ if $apos + 1 <= $alen && $bpos + 1 <= $blen &&
+ nqp::substr($a, $apos + 1, 1) eq $bchar &&
+ nqp::substr($b, $bpos + 1, 1) eq $achar {
+ my $cd := levenshtein_impl($apos+2, $bpos+2, $estimate+1) + 1;
+ $distance := $cd if $cd < $distance;
+ }
+
+ %memo{$key} := $distance;
+ return $distance;
+ }
+
+ my $result := levenshtein_impl(0, 0, 0);
+ return $result;
+}
+
+sub make_levenshtein_evaluator($orig_name, @candidates) {
+ my $Str-obj := $*W.find_symbol(["Str"]);
+ sub inner($name, $object, $hash) {
+ # difference in length is a good lower bound.
+ my $parlen := nqp::chars($orig_name);
+ my $lendiff := nqp::chars($name) - $parlen;
+ $lendiff := -$lendiff if $lendiff < 0;
+ return 1 if $lendiff >= $parlen * 0.3;
+
+ my $dist := levenshtein($orig_name, $name) / $parlen;
+ my @target;
+ @target := @candidates[0] if $dist <= 0.1;
+ @target := @candidates[1] if 0.1 < $dist && $dist <= 0.2;
+ @target := @candidates[2] if 0.2 < $dist && $dist <= 0.35;
+ if nqp::defined(@target) {
+ my $name-str := nqp::box_s($name, $Str-obj);
+ nqp::push(@target, $name-str);
+ }
+ }
+ return &inner;
+}
+
+sub levenshtein_candidate_heuristic(@candidates, $target) {
+ # only take a few suggestions
+ my $to-add := 5;
+ for @candidates[0] {
+ $target.push($_) if $to-add > 0;
+ $to-add := $to-add - 1;
+ }
+ $to-add := $to-add - 1 if +@candidates[0] > 0;
+ for @candidates[1] {
+ $target.push($_) if $to-add > 0;
+ $to-add := $to-add - 1;
+ }
+ $to-add := $to-add - 2 if +@candidates[1] > 0;
+ for @candidates[2] {
+ $target.push($_) if $to-add > 0;
+ $to-add := $to-add - 1;
+ }
+}
+
# This builds upon the HLL::World to add the specifics needed by Rakudo Perl 6.
class Perl6::World is HLL::World {
# The stack of lexical pads, actually as QAST::Block objects. The
@@ -1394,10 +1512,40 @@ class Perl6::World is HLL::World {
# Applies a trait.
method apply_trait($/, $trait_sub_name, *@pos_args, *%named_args) {
- my $trait_sub := $*W.find_symbol([$trait_sub_name]);
- self.ex-handle($/, { $trait_sub(|@pos_args, |%named_args) });
+ my $trait_sub := self.find_symbol([$trait_sub_name]);
+ my $ex;
+ my $nok := 0;
+ try {
+ self.ex-handle($/, { $trait_sub(|@pos_args, |%named_args) });
+ CATCH {
+ $ex := $_;
+ my $payload := nqp::getpayload($_);
+ if nqp::istype($payload, self.find_symbol(["X", "Inheritance", "UnknownParent"])) {
+ my %seen;
+ %seen{$payload.child} := 1;
+ my @candidates := [[], [], []];
+ my &inner-evaluator := make_levenshtein_evaluator($payload.parent, @candidates);
+
+ sub evaluator($name, $object, $hash) {
+ # only care about type objects
+ return 1 if nqp::isconcrete($object);
+ return 1 if nqp::existskey(%seen, $name);
+ &inner-evaluator($name, $object, $hash);
+ %seen{$name} := 1;
+ 1;
+ }
+ self.walk_symbols(&evaluator);
+
+ levenshtein_candidate_heuristic(@candidates, $payload.suggestions);
+ }
+ $nok := 1;
+ }
+ }
+ if $nok {
+ self.rethrow($/, $ex);
+ }
}
-
+
# Some things get cloned many times with an outer lexical scope that
# we never enter. This makes sure we capture them as needed.
method create_lexical_capture_fixup() {
@@ -1849,7 +1997,31 @@ class Perl6::World is HLL::World {
}
$result
}
-
+
+ method walk_symbols($code) {
+ # first, go through all lexical scopes
+ sub walk_block($block) {
+ my %symtable := $block.symtable();
+ for %symtable {
+ if nqp::existskey($_.value, 'value') {
+ my $val := $_.value<value>;
+ if nqp::istype($val, QAST::Block) {
+ walk_block($val);
+ } else {
+ $code($_.key, $val, $_.value);
+ }
+ }
+ }
+ }
+
+ for @!BLOCKS {
+ walk_block($_);
+ }
+ for $*GLOBALish.WHO {
+ $code($_.key, $_.value, hash());
+ }
+ }
+
# Finds a symbol that has a known value at compile time from the
# perspective of the current scope. Checks for lexicals, then if
# that fails tries package lookup.
@@ -2024,6 +2196,49 @@ class Perl6::World is HLL::World {
0;
}
+ method suggest_lexicals($name) {
+ my @suggestions;
+ my @candidates := [[], [], []];
+ my &inner-evaluator := make_levenshtein_evaluator($name, @candidates);
+ my %seen;
+ %seen{$name} := 1;
+ sub evaluate($name, $value, $hash) {
+ # the descriptor identifies variables.
+ return 1 unless nqp::existskey($hash, "descriptor");
+ return 1 if nqp::existskey(%seen, $name);
+
+ &inner-evaluator($name, $value, $hash);
+ %seen{$name} := 1;
+ 1;
+ }
+ self.walk_symbols(&evaluate);
+
+ levenshtein_candidate_heuristic(@candidates, @suggestions);
+ return @suggestions;
+ }
+
+ method suggest_routines($name) {
+ $name := "&"~$name unless nqp::substr($name, 0, 1) eq "&";
+ my @suggestions;
+ my @candidates := [[], [], []];
+ my &inner-evaluator := make_levenshtein_evaluator($name, @candidates);
+ my %seen;
+ %seen{$name} := 1;
+ sub evaluate($name, $value, $hash) {
+ return 1 unless nqp::substr($name, 0, 1) eq "&";
+ return 1 if nqp::existskey(%seen, $name);
+
+ &inner-evaluator($name, $value, $hash);
+ %seen{$name} := 1;
+ 1;
+ }
+ self.walk_symbols(&evaluate);
+
+ levenshtein_candidate_heuristic(@candidates, @suggestions);
+ return @suggestions;
+ }
+
+
# Checks if the symbol is really an alias to an attribute.
method is_attr_alias($name) {
my int $i := +@!BLOCKS;
View
37 src/core/Exception.pm
@@ -213,7 +213,7 @@ do {
$_() for pir::perl6ize_type__PP(@*END_PHASERS);
}
if $! {
- pir::perl6_based_rethrow__0PP(nqp::getattr($!, Exception, '$!ex'), $ex);
+ pir::perl6_based_rethrow__0PP(nqp::getattr(nqp::p6decont($!), Exception, '$!ex'), $ex);
}
}
@@ -463,8 +463,15 @@ my class X::Placeholder::Mainline is X::Placeholder::Block {
my class X::Undeclared does X::Comp {
has $.what = 'Variable';
has $.symbol;
+ has @.suggestions;
method message() {
- "$.what $.symbol is not declared";
+ my $message := "$.what '$.symbol' is not declared";
+ if +@.suggestions == 1 {
+ $message := "$message. Did you mean '@.suggestions[0]'?";
+ } elsif +@.suggestions > 1 {
+ $message := "$message. Did you mean any of these?\n { nqp::join("\n ", @.suggestions) }\n";
+ }
+ $message;
}
}
@@ -481,6 +488,7 @@ my class X::Undeclared::Symbols does X::Comp {
has %.post_types;
has %.unk_types;
has %.unk_routines;
+ has %.routine_suggestion;
multi method gist(:$sorry = True) {
($sorry ?? self.sorry_heading() !! "") ~ self.message
}
@@ -489,6 +497,9 @@ my class X::Undeclared::Symbols does X::Comp {
my @lu = @l.uniq.sort;
'used at line' ~ (@lu == 1 ?? ' ' !! 's ') ~ @lu.join(', ')
}
+ sub s(@s) {
+ "Did you mean '{ @s.join("', '") }'?";
+ }
my $r = "";
if %.post_types {
$r ~= "Illegally post-declared type" ~ (%.post_types.elems == 1 ?? "" !! "s") ~ ":\n";
@@ -505,7 +516,11 @@ my class X::Undeclared::Symbols does X::Comp {
if %.unk_routines {
$r ~= "Undeclared routine" ~ (%.unk_routines.elems == 1 ?? "" !! "s") ~ ":\n";
for %.unk_routines.sort(*.key) {
- $r ~= " $_.key() &l($_.value)\n";
+ $r ~= " $_.key() &l($_.value)";
+ if %.routine_suggestion{$_.key()} :exists {
+ $r ~= ". " ~ s(%.routine_suggestion{$_.key()});
+ }
+ $r ~= "\n";
}
}
$r
@@ -1035,6 +1050,22 @@ my class X::Inheritance::Unsupported does X::Comp {
}
}
+my class X::Inheritance::UnknownParent is Exception {
+ has $.child;
+ has $.parent;
+ has @.suggestions is rw;
+
+ method message {
+ my $message := "'" ~ $.child ~ "' cannot inherit from '" ~ $.parent ~ "' because it is unknown.";
+ if +@.suggestions > 1 {
+ $message := $message ~ "\nDid you mean one of these?\n '" ~ @.suggestions.join("'\n '") ~ "'\n";
+ } elsif +@.suggestions == 1 {
+ $message := $message ~ "\nDid you mean '" ~ @.suggestions[0] ~ "'?\n";
+ }
+ return $message;
+ }
+}
+
my class X::Export::NameClash does X::Comp {
has $.symbol;
method message() {
View
8 src/core/traits.pm
@@ -12,6 +12,7 @@ my role Callable { ... }
# for errors
my class X::Inheritance::Unsupported { ... }
+my class X::Inheritance::UnknownParent { ... }
my class X::Export::NameClash { ... }
my class X::Composition::NotComposable { ... }
my class X::Import::MissingSymbols { ... }
@@ -41,6 +42,13 @@ multi trait_mod:<is>(Mu:U $type, :$nativesize!) {
multi trait_mod:<is>(Mu:U $type, :$hidden!) {
$type.HOW.set_hidden($type);
}
+multi trait_mod:<is>(Mu:U $type, *%fail) {
+ X::Inheritance::UnknownParent.new(
+ :child($type.HOW.name($type)),
+ :parent(%fail.keys[0]),
+ :suggestions([])
+ ).throw;
+}
multi trait_mod:<is>(Attribute:D $attr, :$rw!) {
$attr.set_rw();
View
2  tools/build/NQP_REVISION
@@ -1 +1 @@
-2013.01
+2013.01-9-g769044f
Please sign in to comment.
Something went wrong with that request. Please try again.