Permalink
Browse files

[CORE] add protos of operators

[STD] add operators to symbol tables as subs
[Cursor] canonicalize operator names in symbol table


git-svn-id: http://svn.pugscode.org/pugs@30650 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent 338b4a4 commit fd5f65027418c0bea797cca9a290add034acf85a lwall committed May 16, 2010
Showing with 129 additions and 8 deletions.
  1. +116 −0 CORE.setting
  2. +9 −4 Cursor.pmc
  3. +4 −4 STD.pm6
View
@@ -383,6 +383,122 @@ my proto wait { }
my proto kill { }
my proto sleep { }
+my proto infix:<=> ($x,$y) { }
+my proto postfix:<i> ($x) { }
+my proto infix:<.> ($x,$y) { }
+my proto postfix:['->'] ($x) { }
+my proto postfix:<++> ($x) { }
+my proto postfix:«--» ($x) { }
+my proto prefix:<++> ($x) { }
+my proto prefix:«--» ($x) { }
+my proto infix:<**> ($x,$y) { }
+my proto prefix:<!> ($x) { }
+my proto prefix:<+> ($x) { }
+my proto prefix:<-> ($x) { }
+my proto prefix:<~~> ($x) { }
+my proto prefix:<~> ($x) { }
+my proto prefix:<??> ($x) { }
+my proto prefix:<?> ($x) { }
+my proto prefix:<~^> ($x) { }
+my proto prefix:<+^> ($x) { }
+my proto prefix:<?^> ($x) { }
+my proto prefix:<^^> ($x) { }
+my proto prefix:<^> ($x) { }
+my proto prefix:<||> ($x) { }
+my proto prefix:<|> ($x) { }
+my proto infix:<*> ($x,$y) { }
+my proto infix:</> ($x,$y) { }
+my proto infix:<div> ($x,$y) { }
+my proto infix:<%> ($x,$y) { }
+my proto infix:<mod> ($x,$y) { }
+my proto infix:<+&> ($x,$y) { }
+my proto infix:« << » ($x,$y) { }
+my proto infix:« >> » ($x,$y) { }
+my proto infix:<~&> ($x,$y) { }
+my proto infix:<?&> ($x,$y) { }
+my proto infix:« ~< » ($x,$y) { }
+my proto infix:« ~> » ($x,$y) { }
+my proto infix:« +< » ($x,$y) { }
+my proto infix:« +> » ($x,$y) { }
+my proto infix:<+> ($x,$y) { }
+my proto infix:<-> ($x,$y) { }
+my proto infix:<+|> ($x,$y) { }
+my proto infix:<+^> ($x,$y) { }
+my proto infix:<~|> ($x,$y) { }
+my proto infix:<~^> ($x,$y) { }
+my proto infix:<?|> ($x,$y) { }
+my proto infix:<?^> ($x,$y) { }
+my proto infix:<x> ($x,$y) { }
+my proto infix:<xx> ($x,$y) { }
+my proto infix:<~> ($x,$y) { }
+my proto infix:<&> ($x,$y) { }
+my proto infix:<|> ($x,$y) { }
+my proto infix:<^> ($x,$y) { }
+my proto infix:« <=> » ($x,$y) { }
+my proto infix:<..> ($x,$y) { }
+my proto infix:<^..> ($x,$y) { }
+my proto infix:<..^> ($x,$y) { }
+my proto infix:<^..^> ($x,$y) { }
+my proto infix:<==> ($x,$y) { }
+my proto infix:<!=> ($x,$y) { }
+my proto infix:« < » ($x,$y) { }
+my proto infix:« <= » ($x,$y) { }
+my proto infix:« > » ($x,$y) { }
+my proto infix:« >= » ($x,$y) { }
+my proto infix:<~~> ($x,$y) { }
+my proto infix:<!~> ($x,$y) { }
+my proto infix:<=~> ($x,$y) { }
+my proto infix:<eq> ($x,$y) { }
+my proto infix:<ne> ($x,$y) { }
+my proto infix:<lt> ($x,$y) { }
+my proto infix:<le> ($x,$y) { }
+my proto infix:<gt> ($x,$y) { }
+my proto infix:<ge> ($x,$y) { }
+my proto infix:<=:=> ($x,$y) { }
+my proto infix:<===> ($x,$y) { }
+my proto infix:<eqv> ($x,$y) { }
+my proto infix:<before> ($x,$y) { }
+my proto infix:<after> ($x,$y) { }
+my proto infix:<&&> ($x,$y) { }
+my proto infix:<||> ($x,$y) { }
+my proto infix:<^^> ($x,$y) { }
+my proto infix:<//> ($x,$y) { }
+my proto infix:<min> ($x,$y) { }
+my proto infix:<max> ($x,$y) { }
+my proto infix:<?? !!> ($x,$y) { }
+my proto infix:<!!> ($x,$y) { }
+my proto infix:<?> ($x,$y) { }
+my proto infix:<ff> ($x,$y) { }
+my proto infix:<^ff> ($x,$y) { }
+my proto infix:<ff^> ($x,$y) { }
+my proto infix:<^ff^> ($x,$y) { }
+my proto infix:<fff> ($x,$y) { }
+my proto infix:<^fff> ($x,$y) { }
+my proto infix:<fff^> ($x,$y) { }
+my proto infix:<^fff^> ($x,$y) { }
+my proto infix:<=> ($x,$y) { }
+my proto infix:<:=> ($x,$y) { }
+my proto infix:<::=> ($x,$y) { }
+my proto infix:<.=> ($x,$y) { }
+my proto infix:« => » ($x,$y) { }
+my proto prefix:<so> ($x) { }
+my proto prefix:<not> ($x) { }
+my proto infix:<,> ($x,$y) { }
+my proto infix:<:> ($x,$y) { }
+my proto infix:<X> ($x,$y) { }
+my proto infix:<Z> ($x,$y) { }
+my proto infix:<minmax> ($x,$y) { }
+my proto infix:<...> ($x,$y) { }
+my proto infix:<and> ($x,$y) { }
+my proto infix:<andthen> ($x,$y) { }
+my proto infix:<or> ($x,$y) { }
+my proto infix:<orelse> ($x,$y) { }
+my proto infix:<xor> ($x,$y) { }
+my proto infix:« <== » ($x,$y) { }
+my proto infix:« ==> » ($x,$y) { }
+my proto infix:« <<== » ($x,$y) { }
+my proto infix:« ==>> » ($x,$y) { }
+
my package PROCESS {
my %ENV is export;
}
View
@@ -1943,7 +1943,7 @@ sub _AUTOLEXgen { my $self = shift;
for my $class ($self->meta->linearized_isa) {
for my $method (sort $class->meta->get_method_list) {
if (substr($method,0,$protolen) eq $protopat) {
- next if substr($method,-6,6) eq '__PEEK';
+ next if $method =~ /__PEEK/;
my $callname = $class . '::' . $method . '__PEEK';
my $peeklex = $self->$callname();
if ($peeklex and $peeklex->{PATS}) {
@@ -2246,13 +2246,12 @@ sub trim_heredoc { my $doc = shift;
}
sub add_macro { my $lang = shift;
- my $start = shift;
+ my $name = shift;
state $GEN = "500";
- $lang->{_from} = $start->{_from};
- my $name = $lang->Str;
$name =~ s/:<<(.*)>>$/$1»/;
my $WHAT = ref $lang;
if ($name =~ s/^(\w+):(?=[«<({[])/$1:sym/) {
+ my $cat = $1;
my ($sym) = $name =~ /:sym(.*)/;
$sym =~ s/^<\s*(.*\S)\s*>$/<$1>/g;
$sym =~ s/^\(\s*(.*\S)\s*\)$/$1/g;
@@ -2273,6 +2272,12 @@ sub add_macro { my $lang = shift;
}
$sym = $ok . $sym . $ok;
}
+ {
+ my $canon = substr($sym,1,length($sym)-2);
+ $canon =~ s/([<>])/\\$1/g;
+ my $canonname = $cat . ':<' . $canon . '>';
+ $lang->add_my_name($canonname);
+ }
if ($sym =~ / /) {
$sym = '[qw' . $sym . ']';
}
View
@@ -2554,15 +2554,14 @@ grammar P6 is STD {
:dba('new name to be defined')
<name>
[
- | <colonpair>+ {.add_macro($<name>) if $*IN_DECL; }
+ | <colonpair>+ {.add_macro(substr($*ORIG, self.pos, $¢.pos - self.pos)) if $*IN_DECL; }
| {.add_routine($<name>.Str) if $*IN_DECL; }
]
}
token subshortname {
[
- | <category>
- [ <colonpair>+ {.add_macro($<category>) if $*IN_DECL; } ]?
+ | <category> <colonpair>+
| <desigilname>
]
}
@@ -2866,7 +2865,7 @@ grammar P6 is STD {
:my $*DECLARAND;
<sym> <.ws>
[
- | <name=identifier> {.add_name($<name>.Str); }
+ | <name=longname> {.add_name($<name>.Str); }
| <name=variable> {.add_variable($<name>.Str); }
| <?>
]
@@ -5381,6 +5380,7 @@ method add_my_name ($n, $d = Nil, $p = Nil) { # XXX gimme doesn't handle optio
$name = my $shortname = shift @components;
return self unless defined $name and $name ne '';
return self if $name eq '$' or $name eq '@' or $name eq '%';
+ return self.add_macro(substr($name,1)) if $name ~~ /^\&\w+\:/;
if $shortname ~~ /\:/ {
$shortname ~~ s/\:.*//;
}

0 comments on commit fd5f650

Please sign in to comment.