Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

More Levenshtein stuff:types in parameters. code cleanups. Self-Inherit error. #98

Merged
merged 6 commits into from

2 participants

timo Will Coleda
timo
Collaborator

Passes the spectests, too :)

timo
Collaborator

Also, in case of catastrophical failure, it will not take a huge amount of time trying to find prettier matches (or any match at all, for that matter)

Will Coleda coke merged commit 8356157 into from
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
This page is out of date. Refresh to see the latest.
8 src/Perl6/Grammar.pm
View
@@ -2184,7 +2184,13 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
| $<quant>=['\\'|'|'] <param_var> { pir::getstderr__P().print("Obsolete use of | or \\ with sigil on param { $<param_var> }\n") }
| $<quant>=['\\'|'|'] <defterm>?
| [ <param_var> | <named_param> ] $<quant>=['?'|'!'|<?>]
- | <longname> <.panic('Invalid typename in parameter declaration')>
+ | <longname>
+ {
+ my $name := $*W.disect_longname($<longname>);
+ $*W.throw($/, ['X', 'Parameter', 'InvalidType'],
+ :typename($name.name),
+ :suggestions($*W.suggest_typename($name.name)));
+ }
]
<trait>*
<post_constraint>*
82 src/Perl6/World.pm
View
@@ -126,22 +126,28 @@ sub levenshtein($a, $b) {
sub make_levenshtein_evaluator($orig_name, @candidates) {
my $Str-obj := $*W.find_symbol(["Str"]);
+ my $find-count := 0;
+ my $try-count := 0;
sub inner($name, $object, $hash) {
# difference in length is a good lower bound.
+ $try-count := $try-count + 1;
+ return 0 if $find-count > 20 || $try-count > 1000;
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 $target := -1;
+ $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 $target != -1 {
my $name-str := nqp::box_s($name, $Str-obj);
- nqp::push(@target, $name-str);
+ nqp::push($target, $name-str);
+ $find-count := $find-count + 1;
}
+ 1;
}
return &inner;
}
@@ -1509,7 +1515,29 @@ class Perl6::World is HLL::World {
# Result is the value.
$val
}
-
+
+ method suggest_typename($name) {
+ my %seen;
+ %seen{$name} := 1;
+ my @candidates := [[], [], []];
+ my &inner-evaluator := make_levenshtein_evaluator($name, @candidates);
+ my @suggestions;
+
+ sub evaluator($name, $object, $hash) {
+ # only care about type objects
+ return 1 if nqp::isconcrete($object);
+ return 1 if nqp::existskey(%seen, $name);
+
+ %seen{$name} := 1;
+ return &inner-evaluator($name, $object, $hash);
+ }
+ self.walk_symbols(&evaluator);
+
+ levenshtein_candidate_heuristic(@candidates, @suggestions);
+
+ return @suggestions;
+ }
+
# Applies a trait.
method apply_trait($/, $trait_sub_name, *@pos_args, *%named_args) {
my $trait_sub := self.find_symbol([$trait_sub_name]);
@@ -1521,22 +1549,10 @@ class Perl6::World is HLL::World {
$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;
+ my @suggestions := self.suggest_typename($payload.parent);
+ for @suggestions {
+ $payload.suggestions.push($_)
}
- self.walk_symbols(&evaluator);
-
- levenshtein_candidate_heuristic(@candidates, $payload.suggestions);
}
$nok := 1;
}
@@ -2002,23 +2018,24 @@ class Perl6::World is HLL::World {
# 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>;
+ for %symtable -> $symp {
+ if nqp::existskey($symp.value, 'value') {
+ my $val := $symp.value<value>;
if nqp::istype($val, QAST::Block) {
- walk_block($val);
+ return 0 if walk_block($val) == 0;
} else {
- $code($_.key, $val, $_.value);
+ return 0 if $code($symp.key, $val, $symp.value) == 0;
}
}
}
+ 1;
}
for @!BLOCKS {
- walk_block($_);
+ return 0 if walk_block($_) == 0;
}
for $*GLOBALish.WHO {
- $code($_.key, $_.value, hash());
+ return 0 if $code($_.key, $_.value, hash()) == 0;
}
}
@@ -2206,10 +2223,8 @@ class Perl6::World is HLL::World {
# 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;
+ return &inner-evaluator($name, $value, $hash);
}
self.walk_symbols(&evaluate);
@@ -2228,9 +2243,8 @@ class Perl6::World is HLL::World {
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;
+ return &inner-evaluator($name, $value, $hash);
}
self.walk_symbols(&evaluate);
20 src/core/Exception.pm
View
@@ -621,6 +621,18 @@ my class X::Parameter::WrongOrder does X::Comp {
}
}
+my class X::Parameter::InvalidType does X::Comp {
+ has $.typename;
+ has @.suggestions;
+ method message() {
+ my $msg := "Invalid typename '$.typename' in parameter declaration.";
+ if +@.suggestions > 0 {
+ $msg := $msg ~ " Did you mean '" ~ @.suggestions.join("', '") ~ "'?";
+ }
+ return $msg;
+ }
+}
+
my class X::Signature::NameClash does X::Comp {
has $.name;
method message() {
@@ -1066,6 +1078,14 @@ my class X::Inheritance::UnknownParent is Exception {
}
}
+my class X::Inheritance::SelfInherit is Exception {
+ has $.name;
+
+ method message {
+ "'$.name' cannot inherit from itself."
+ }
+}
+
my class X::Export::NameClash does X::Comp {
has $.symbol;
method message() {
17 src/core/traits.pm
View
@@ -17,6 +17,7 @@ my class X::Export::NameClash { ... }
my class X::Composition::NotComposable { ... }
my class X::Import::MissingSymbols { ... }
my class X::Redeclaration { ... }
+my class X::Inheritance::SelfInherit { ... }
proto trait_mod:<is>(|) { * }
multi trait_mod:<is>(Mu:U $child, Mu:U $parent) {
@@ -43,11 +44,17 @@ 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;
+ if %fail.keys[0] !eq $type.HOW.name($type) {
+ X::Inheritance::UnknownParent.new(
+ :child($type.HOW.name($type)),
+ :parent(%fail.keys[0]),
+ :suggestions([])
+ ).throw;
+ } else {
+ X::Inheritance::SelfInherit.new(
+ :name(%fail.keys[0])
+ ).throw;
+ }
}
multi trait_mod:<is>(Attribute:D $attr, :$rw!) {
Something went wrong with that request. Please try again.