├── .gitignore ├── Actions.pm ├── CORE.setting ├── CORE5.setting ├── Cursor.pm6 ├── CursorBase.pm6 ├── CursorBase.pmc ├── DEBUG.pmc ├── LazyMap.pm ├── Makefile ├── NAME.pmc ├── README ├── RE_ast.pmc ├── STD.pm ├── STD.pm6 ├── STD_P5.pm6 ├── Stash.pmc ├── boot ├── Cursor.pmc └── STD.pmc ├── dist.ini ├── inc └── MyBuilder.pm ├── lib ├── DEBUG.pm6 ├── FindBin.pm6 ├── MONKEY_TYPING.pm6 ├── NAME.pm6 ├── Stash.pm6 ├── Test.pm6 ├── class.pm6 ├── fatal.pm6 ├── lib.pm6 └── oo.pm6 ├── mangle.pl ├── std_hilite ├── STD_syntax_highlight ├── STD_syntax_highlight.ansi ├── STD_syntax_highlight.css ├── STD_syntax_highlight.js ├── STD_syntax_highlight.mirc ├── cron_spec_highlight ├── jquery-1.4.2.min.js └── spec_highlight ├── tools ├── DumpMatch.pm ├── STD5_dump_match ├── cleanlex.pl ├── compact_pmc ├── gen-unicode-table.pl ├── reds ├── redspans ├── setting ├── show_changed_vars ├── sprixel_csv.pl ├── teststd ├── tlong ├── tloop ├── try5 ├── try5_post ├── tryfile └── tryfoo ├── uniprops └── viv /.gitignore: -------------------------------------------------------------------------------- 1 | lex/ 2 | *.store 3 | *.syml 4 | STD.pm5 5 | STD.pmc 6 | -------------------------------------------------------------------------------- /Actions.pm: -------------------------------------------------------------------------------- 1 | use v5.14; 2 | use YAML::XS; 3 | use strict; 4 | use warnings; 5 | our $OPT_log; 6 | our $OPT_match; 7 | package Actions; 8 | use Scalar::Util 'refaddr'; 9 | 10 | # Generic ast translation done via autoload 11 | 12 | our $AUTOLOAD; 13 | my $SEQ = 1; 14 | our %GENCLASS; 15 | 16 | sub AUTOLOAD { 17 | my $self = shift; 18 | my $match = shift; 19 | return if @_; # not interested in tagged reductions 20 | return if $match->{_ast}{_specific} and ref($match->{_ast}) =~ /^VAST/; 21 | print STDERR "AUTOLOAD $AUTOLOAD\n" if $OPT_log; 22 | my $r = hoistast($match); 23 | (my $class = $AUTOLOAD) =~ s/^Actions/VAST/; 24 | $class =~ s/__S_\d\d\d/__S_/ and $r->{_specific} = 1; 25 | if ($class =~ /::((?:p5)?)(infix|prefix|postfix|postcircumfix|dotty|regex_infix)__S_/) { 26 | $r->{_op} = $class; 27 | $class =~ s/::((?:p5)?)(infix|prefix|postfix|postcircumfix|dotty|regex_infix)__S_/::SYM_$1$2__S_/; 28 | } 29 | gen_class($class); 30 | bless $r, $class unless ref($r) =~ /^VAST/; 31 | $r->{MATCH} = $match if $OPT_match; 32 | $match->{'_ast'} = $r; 33 | } 34 | 35 | # propagate ->{'_ast'} nodes upward 36 | # (untransformed STD nodes in output indicate bugs) 37 | 38 | sub hoistast { 39 | my $node = shift; 40 | my $text = $node->Str; 41 | my %r; 42 | my @all; 43 | my %allused; 44 | my @fake; 45 | for my $k (keys %$node) { 46 | print STDERR $node->{_reduced} // 'ANON', " $k\n" if $OPT_log; 47 | my $v = $node->{$k}; 48 | if ($k eq 'O') { 49 | for my $key (keys %$v) { 50 | $r{$key} = $$v{$key}; 51 | } 52 | } 53 | elsif ($k eq 'PRE') { 54 | } 55 | elsif ($k eq 'POST') { 56 | } 57 | elsif ($k eq 'SIGIL') { 58 | $r{SIGIL} = $v; 59 | } 60 | elsif ($k eq 'sym') { 61 | if (ref $v) { 62 | if (ref($v) eq 'ARRAY') { 63 | $r{SYM} = $v; 64 | } 65 | elsif (ref($v) eq 'HASH') { 66 | $r{SYM} = $v; 67 | } 68 | elsif ($v->{_pos}) { 69 | $r{SYM} = $v->Str; 70 | } 71 | else { 72 | $r{SYM} = $v->TEXT; 73 | } 74 | } 75 | else { 76 | $r{SYM} = $v; 77 | } 78 | } 79 | elsif ($k eq '_arity') { 80 | $r{ARITY} = $v; 81 | } 82 | elsif ($k eq '~CAPS') { 83 | # print "CAPS ref ". ref($v) . "\n"; 84 | if (ref $v) { 85 | for (@$v) { 86 | eval { # XXX punt on non-hashes 87 | push @all, $_->{'_ast'} if defined $_->{'_ast'} 88 | and !($allused{refaddr $_}++); 89 | # don't generate multiple entries for a multi-named 90 | # capture 91 | }; 92 | } 93 | } 94 | } 95 | elsif ($k eq '_from') { 96 | $r{BEG} = $v; 97 | $r{END} = $node->{_pos}; 98 | if (exists $::MEMOS[$v]{'ws'}) { 99 | my $wsstart = $::MEMOS[$v]{'ws'}; 100 | $r{WS} = $v - $wsstart if defined $wsstart and $wsstart < $v 101 | } 102 | } 103 | elsif ($k =~ /^[a-zA-Z]/) { 104 | if ($k eq 'noun') { # trim off PRE and POST 105 | $r{BEG} = $v->{_from}; 106 | $r{END} = $v->{_pos}; 107 | } 108 | if (ref($v) eq 'ARRAY') { 109 | my $zyg = []; 110 | for my $z (@$v) { 111 | if (ref $z) { 112 | if (ref($z) eq 'ARRAY') { 113 | push @$zyg, $z; 114 | push @fake, @$z; 115 | } 116 | elsif (exists $z->{'_ast'}) { 117 | my $zy = $z->{'_ast'}; 118 | push @fake, $zy; 119 | push @$zyg, $zy; 120 | } 121 | } 122 | else { 123 | push @$zyg, $z; 124 | } 125 | } 126 | $r{$k} = $zyg; 127 | # $r{zygs}{$k} = $SEQ++ if @$zyg and $k ne 'sym'; 128 | } 129 | elsif (ref($v) eq 'HASH') { 130 | $r{$k} = $v; 131 | } 132 | elsif (ref($v)) { 133 | if ($v->isa('Cursor') && !$v->{_reduced}) { 134 | $r{$k} = $v->{'_ast'} //= hoistast($v); 135 | bless $r{$k}, 'VAST::Str'; 136 | next; 137 | } 138 | elsif (exists $v->{'_ast'}) { 139 | push @fake, $v->{'_ast'}; 140 | $r{$k} = $v->{'_ast'}; 141 | } 142 | elsif (exists $v->{'_from'}) { 143 | $r{$k}{BEG} = $v->{'_from'}; 144 | $r{$k}{END} = $v->{'_pos'}; 145 | $r{$k}{TEXT} = $v->Str; 146 | } 147 | else { 148 | # NAME or decl or sig or... 149 | $r{$k} = $v; 150 | next; 151 | } 152 | # $r{zygs}{$k} = $SEQ++; 153 | unless (ref($r{$k}) =~ /^VAST/) { 154 | my $class = "VAST::$k"; 155 | gen_class($class); 156 | bless $r{$k}, $class unless ref($r{$k}) =~ /^VAST/; 157 | } 158 | } 159 | else { 160 | $r{$k} = $v; 161 | } 162 | } 163 | } 164 | if (@all == 1 and defined $all[0]) { 165 | $r{'.'} = $all[0]; 166 | } 167 | elsif (@all) { 168 | $r{'.'} = \@all; 169 | } 170 | elsif (@fake) { 171 | $r{'.'} = \@fake; 172 | } 173 | else { 174 | $r{TEXT} = $text; 175 | } 176 | \%r; 177 | } 178 | 179 | sub hoist { 180 | my $match = shift; 181 | 182 | my %r; 183 | my $v = $match->{O}; 184 | if ($v) { 185 | for my $key (keys %$v) { 186 | $r{$key} = $$v{$key}; 187 | } 188 | } 189 | if ($match->{sym}) { 190 | # $r{sym} = $match->{sym}; 191 | } 192 | if ($match->{ADV}) { 193 | $r{ADV} = $match->{ADV}; 194 | } 195 | \%r; 196 | } 197 | 198 | sub CHAIN { 199 | my $self = shift; 200 | my $match = shift; 201 | my $r = hoistast($match); 202 | 203 | my $class = 'VAST::Chaining'; 204 | 205 | gen_class($class); 206 | $r = bless $r, $class; 207 | $match->{'_ast'} = $r; 208 | } 209 | 210 | sub LIST { 211 | my $self = shift; 212 | my $match = shift; 213 | my $r = hoist($match); 214 | 215 | my @list = @{$match->{list}}; 216 | my @delims = @{$match->{delims}}; 217 | $r->{'args'} = [ map { $_->{_ast} } @list ]; 218 | my @all; 219 | while (@delims) { 220 | my $term = shift @list; 221 | push @all, $term->{_ast}; 222 | my $infix = shift @delims; 223 | push @all, $infix->{_ast}; 224 | } 225 | push @all, $list[0]->{_ast} if @list; 226 | pop @all while @all and not $all[-1]{END}; 227 | $r->{BEG} = $all[0]{BEG}; 228 | $r->{END} = $all[-1]{END} // $r->{BEG}; 229 | $r->{'infix'} = $all[-2]; # assume final one is most representative 230 | $r->{'.'} = \@all; 231 | 232 | my $base = ucfirst $match->{O}{dba} // $match->{sym} // 'termish'; 233 | $base =~ s/ /_/g; 234 | $base =~ s/^/VAST::/; 235 | 236 | my $class = 237 | $match->{delims}[0]{_ast}{infix}{_op} // 238 | $match->{delims}[0]{_ast}{regex_infix}{_op} // 239 | exit warn ::Dump($match); 240 | gen_class($class, $base); 241 | $r = bless $r, $class; 242 | $match->{'_ast'} = $r; 243 | } 244 | 245 | sub POSTFIX { 246 | my $self = shift; 247 | my $match = shift; 248 | my $r = hoist($match); 249 | my $arg = $match->{arg}->{_ast}; 250 | $r->{'arg'} = $arg; 251 | $r->{postop} = $match->{postop}{_ast} if exists $match->{postop}; 252 | my $a = $r->{'.'} = [$arg,$match->{_ast}]; 253 | $r->{BEG} = $a->[0]->{BEG} // $match->{_from}; 254 | $r->{END} = $a->[-1]->{END} // $match->{_pos}; 255 | 256 | my $base = ucfirst $match->{O}{dba} // $match->{sym} // 'termish'; 257 | $base =~ s/ /_/g; 258 | $base =~ s/^/VAST::/; 259 | 260 | my $class; 261 | if ($match->{fake}) { 262 | $class = $base; 263 | $base = ''; 264 | } 265 | else { 266 | $class = 267 | $match->{_ast}{postop}{postfix}{_op} // 268 | $match->{_ast}{postop}{postcircumfix}{_op} // 269 | $match->{_ast}{dotty}{_op} // 270 | exit warn ::Dump($match); 271 | } 272 | 273 | gen_class($class, $base); 274 | $r = bless $r, $class; 275 | $match->{'_ast'} = $r; 276 | } 277 | 278 | sub PREFIX { 279 | my $self = shift; 280 | my $match = shift; 281 | my $r = hoist($match); 282 | my $arg = $match->{arg}->{_ast}; 283 | $r->{'postop'} = $match->{postop}->{_ast} if exists $match->{postop}; 284 | $r->{'arg'} = $arg; 285 | my $a = $r->{'.'} = [$match->{_ast},$arg]; 286 | 287 | $r->{BEG} = $a->[0]->{BEG} // $match->{_from}; 288 | $r->{END} = $a->[-1]->{END} // $match->{_pos}; 289 | 290 | my $base = ucfirst $match->{O}{dba} // $match->{sym} // 'termish'; 291 | $base =~ s/ /_/g; 292 | $base =~ s/^/VAST::/; 293 | 294 | my $class; 295 | if ($match->{fake}) { 296 | $class = $base; 297 | $base = ''; 298 | } 299 | else { 300 | $class = 301 | $match->{_ast}{prefix}{_op} // 302 | $match->{_ast}{prefix_postfix_meta_operator}{_op} // 303 | $match->{_ast}{prefix_circumfix_meta_operator}{_op} // 304 | exit warn ::Dump($match); 305 | } 306 | 307 | gen_class($class,$base); 308 | $r = bless $r, $class; 309 | $match->{'_ast'} = $r; 310 | } 311 | 312 | sub INFIX { 313 | my $self = shift; 314 | my $match = shift; 315 | my $r = hoist($match); 316 | my $left = $match->{left}->{_ast}; 317 | my $right = $match->{right}->{_ast}; 318 | if ($match->{middle}) { # ternary 319 | my $middle = $match->{middle}->{_ast}; 320 | $r->{'args'} = [$left,$middle,$right]; 321 | } 322 | else { 323 | $r->{'args'} = [$left,$right]; 324 | } 325 | my $a = $r->{'.'} = [$left,$match->{_ast},$right]; 326 | $r->{BEG} = $a->[0]->{BEG} // $match->{_from}; 327 | $r->{END} = $a->[-1]->{END} // $match->{_pos}; 328 | $r->{'infix'} = $a->[1]; 329 | 330 | my $base = ucfirst $match->{O}{dba} // $match->{sym} // 'termish'; 331 | $base =~ s/ /_/g; 332 | $base =~ s/^/VAST::/; 333 | 334 | my $class; 335 | if ($match->{fake}) { 336 | $class = $base; 337 | $base = ''; 338 | } 339 | else { 340 | $class = 341 | $match->{_ast}{infix}{_op} // 342 | $match->{_ast}{regex_infix}{_op} // 343 | exit warn ::Dump($match); 344 | } 345 | 346 | gen_class($class, $base); 347 | $r = bless $r, $class; 348 | $match->{'_ast'} = $r; 349 | } 350 | 351 | sub nibbler { 352 | my $self = shift; 353 | my $match = shift; 354 | my $r = hoist($match); 355 | if ($match->{nibbles}) { 356 | my @dot; 357 | for my $n ( @{ $match->{nibbles} } ) { 358 | if (ref $n eq 'Str') { 359 | push @dot, bless($n,"VAST::Str"); 360 | } 361 | elsif (ref $n eq 'VAST::Str') { 362 | push @dot, $n; 363 | } 364 | elsif (ref $n eq 'ARRAY') { 365 | push @dot, $n->[0]{_ast}; 366 | } 367 | elsif ($n->{_ast}) { 368 | push @dot, $n->{_ast}; 369 | } 370 | elsif ($n->{EXPR}) { 371 | push @dot, $n->{EXPR}->{_ast}; 372 | } 373 | else { 374 | warn "Oops", ref($n); 375 | exit; 376 | } 377 | } 378 | my $a = $r->{'.'} = \@dot; 379 | $r->{BEG} = $a->[0]->{BEG} // $match->{_from}; 380 | $r->{END} = $a->[-1]->{END} // $match->{_pos}; 381 | } 382 | elsif ($match->{EXPR}) { # regex? 383 | $r->{'.'} = $match->{EXPR}->{_ast}; 384 | $r->{BEG} = $r->{'.'}->{BEG} // $match->{_from}; 385 | $r->{END} = $r->{'.'}->{END} // $match->{_pos}; 386 | } 387 | elsif ($match->{alternation}) { # regex? 388 | $r->{'.'} = $match->{alternation}->{_ast}; 389 | $r->{BEG} = $r->{'.'}->{BEG} // $match->{_from}; 390 | $r->{END} = $r->{'.'}->{END} // $match->{_pos}; 391 | } 392 | 393 | my $class = 'VAST::nibbler'; 394 | # print STDERR ::Dump($r); 395 | gen_class($class); 396 | $r = bless $r, $class; 397 | $match->{'_ast'} = $r; 398 | } 399 | 400 | sub EXPR { 401 | return; 402 | } 403 | 404 | sub termish { 405 | my $self = shift; 406 | my $match = shift; 407 | $match->{'_ast'} = $match->{term}{'_ast'}; 408 | } 409 | 410 | sub gen_class { 411 | my $class = shift; 412 | my $base = shift() // 'VAST::Base'; 413 | # say $class; 414 | no strict 'refs'; 415 | if (@{$class . '::ISA'}) { 416 | print STDERR "Existing class $class\n" if $OPT_log; 417 | return; 418 | } 419 | $GENCLASS{$class} = $base; 420 | print STDERR "Creating class $class\n" if $OPT_log; 421 | @{$class . '::ISA'} = $base; 422 | } 423 | 424 | 1; 425 | -------------------------------------------------------------------------------- /CORE.setting: -------------------------------------------------------------------------------- 1 | # CORE.setting 2 | # 3 | # Copyright 2009-2010, Larry Wall 4 | # 5 | # You may copy this software under the terms of the Artistic License, 6 | # version 2.0 or later. 7 | 8 | my module CORE; 9 | 10 | my class Parcel { } 11 | constant Nil = Parcel; 12 | 13 | my enum Bool ; 14 | 15 | my enum Order < Increase Same Decrease >; 16 | my enum TrigBase ; 17 | 18 | my role Stash { } 19 | my role Role does Stash { } 20 | my role Package does Stash { } 21 | my role Module does Stash { } 22 | my role Class does Module { } 23 | my role List { } 24 | my role Iterable { } 25 | 26 | # XXX does this mean anything? 27 | my role Matcher { } 28 | 29 | my class Cursor { } 30 | my class Grammar is Cursor { } 31 | my class CallFrame { } # or is this a role? 32 | my class P6opaque { } 33 | my class Mu { } 34 | my class Any { } 35 | my class Cool { } 36 | my class Junction { } 37 | my class junction { } 38 | my class Whatever { } 39 | my class WhateverCode { } 40 | my class HyperWhatever { } 41 | my class Capture { } 42 | my class Iterator does List { } 43 | my class LoL { } 44 | my class Match { } 45 | my class Signature { } 46 | my class Parameter { } 47 | my class Proxy { } 48 | my class Scalar { } 49 | my class Array does Iterable { } 50 | my class Hash does Iterable { } 51 | my class KeyHash does Iterable { } 52 | my class KeySet does Iterable { } 53 | my class KeyBag does Iterable { } 54 | my class KeyWeight does Iterable { } 55 | my class Pair { } 56 | my class PairMap { } 57 | my class Enum { } 58 | my class EnumMap { } 59 | my class Seq { } 60 | my class SeqIter does List { } 61 | my class Range { } 62 | my class RangeIter does List { } 63 | my class Set { } 64 | my class Bag { } 65 | my class Mapping { } 66 | my class Sink { } 67 | my class Undef { } 68 | my class Code { } 69 | my class Block { } 70 | my class Routine { } 71 | my class Sub { } 72 | my class Macro { } 73 | my class Method { } 74 | my class Submethod { } 75 | my class Regex { } 76 | my class Attribute { } 77 | 78 | my role Stringy { } 79 | my class Str { } 80 | my class Cat { } 81 | my class Blob { } 82 | my class Char { } 83 | my class AnyChar { } 84 | my class CharLingua { } 85 | my class Byte { } 86 | my class Codepoint { } 87 | my class Grapheme { } 88 | my class StrPos { } 89 | my class StrLen { } 90 | my class Version { } 91 | 92 | my role Numeric { } 93 | my role Real { } 94 | my class Num { 95 | # for now, limit denominator to one quintillion to fit in Rat64. 96 | our constant pi is export = 3.14159_26535_89793_238; # 46_26433_83279_50288; 97 | our constant e is export = 2.71828_18284_59045_235; # 36_02874_71352_66249; 98 | our constant i is export = 1i; 99 | } 100 | import Num ; 101 | 102 | my class num { } 103 | my class num16 { } 104 | my class num32 { } 105 | my class num64 { } 106 | my class num128 { } 107 | 108 | my class Complex { } 109 | my class complex { } 110 | 111 | # (eventually these should be instantiated generics, complex:of(num64) and such) 112 | my class complex16 { } 113 | my class complex32 { } 114 | my class complex64 { } 115 | my class complex128 { } 116 | 117 | my role Integral { } 118 | my class Int { } 119 | my class int { } 120 | 121 | my class int1 { } 122 | my class int2 { } 123 | my class int4 { } 124 | my class int8 { } 125 | my class int16 { } 126 | my class int32 { } 127 | my class int64 { } 128 | my class int128 { } 129 | 130 | my role Rational { } 131 | my class Rat { } 132 | my class FatRat { } 133 | my class rat { } 134 | my class rat8 { } 135 | my class rat16 { } 136 | my class rat32 { } 137 | my class rat64 { } 138 | my class rat128 { } 139 | 140 | my class UInt { } 141 | my class uint { } 142 | my class uint1 { } 143 | my class uint2 { } 144 | my class uint4 { } 145 | my class uint8 { } 146 | my class uint16 { } 147 | my class uint32 { } 148 | my class uint64 { } 149 | my class uint128 { } 150 | 151 | my role Buf { } 152 | my class buf { } 153 | my class buf1 { } 154 | my class buf2 { } 155 | my class buf4 { } 156 | my class buf8 { } 157 | my class buf16 { } 158 | my class buf32 { } 159 | my class buf64 { } 160 | 161 | my class utf8 { } 162 | my class utf16 { } 163 | my class utf32 { } 164 | 165 | my class Bit { } 166 | my class bit { } 167 | my class bool { } 168 | 169 | my class Exception { } 170 | my class Failure { ... } 171 | my role X { } 172 | my role X::Comp { ... } 173 | my class X::ControlFlow { ... } 174 | my class X::AdHoc is Exception { ... } 175 | my class X::Method::NotFound is Exception { ... } 176 | my class X::Method::InvalidQualifier is Exception { ... } 177 | my class X::Comp::AdHoc { ... } 178 | my role X::OS { ... } 179 | my role X::IO does X::OS { } 180 | my class X::IO::Rename does X::IO is Exception { ... } 181 | my class X::IO::Copy does X::IO is Exception { ... } 182 | my class X::IO::Mkdir does X::IO is Exception { ... } 183 | my class X::IO::Chdir does X::IO is Exception { ... } 184 | my class X::IO::Dir does X::IO is Exception { ... } 185 | my class X::IO::Cwd does X::IO is Exception { ... } 186 | my class X::IO::Rmdir does X::IO is Exception { ... } 187 | my class X::IO::Unlink does X::IO is Exception { ... } 188 | my class X::IO::Chmod does X::IO is Exception { ... } 189 | my role X::Comp is Exception { ... } 190 | my class X::Comp::AdHoc is X::AdHoc does X::Comp { ... } 191 | my role X::Syntax does X::Comp { } 192 | my role X::Pod { } 193 | my class X::NYI is Exception { ... } 194 | my class X::Comp::NYI is X::NYI does X::Comp { } 195 | my class X::OutOfRange is Exception { ... } 196 | my class X::Buf::AsStr is Exception { ... } 197 | my class X::Buf::Pack is Exception { ... } 198 | my class X::Buf::Pack::NonASCII is Exception { ... } 199 | my class X::Signature::Placeholder does X::Comp { ... } 200 | my class X::Placeholder::Block does X::Comp { ... } 201 | my class X::Placeholder::Mainline is X::Placeholder::Block { ... } 202 | my class X::Undeclared does X::Comp { ... } 203 | my class X::Attribute::Undeclared is X::Undeclared { ... } 204 | my class X::Redeclaration does X::Comp { ... } 205 | my class X::Import::Redeclaration does X::Comp { ... } 206 | my class X::Phaser::Multiple does X::Comp { ... } 207 | my class X::Obsolete does X::Comp { ... } 208 | my class X::Parameter::Default does X::Comp { ... } 209 | my class X::Parameter::Placeholder does X::Comp { ... } 210 | my class X::Parameter::Twigil does X::Comp { ... } 211 | my class X::Parameter::MultipleTypeConstraints does X::Comp { ... } 212 | my class X::Parameter::WrongOrder does X::Comp { ... } 213 | my class X::Signature::NameClash does X::Comp { ... } 214 | my class X::Method::Private::Permission does X::Comp { ... } 215 | my class X::Method::Private::Unqualified does X::Comp { ... } 216 | my class X::Bind is Exception { ... } 217 | my class X::Bind::NativeType does X::Comp { ... } 218 | my class X::Bind::Slice is Exception { ... } 219 | my class X::Bind::ZenSlice is X::Bind::Slice { ... } 220 | my class X::Value::Dynamic does X::Comp { ... } 221 | my class X::Syntax::Name::Null does X::Syntax { ... } 222 | my class X::Syntax::UnlessElse does X::Syntax { ... } 223 | my class X::Syntax::Reserved does X::Syntax { ... } 224 | my class X::Syntax::P5 does X::Syntax { ... } 225 | my class X::Syntax::NegatedPair does X::Syntax { ... } 226 | my class X::Syntax::Variable::Numeric does X::Syntax { ... } 227 | my class X::Syntax::Variable::Match does X::Syntax { ... } 228 | my class X::Syntax::Variable::Twigil does X::Syntax { ... } 229 | my class X::Syntax::Variable::IndirectDeclaration does X::Syntax { ... } 230 | my class X::Syntax::Augment::WithoutMonkeyTyping does X::Syntax { ... } 231 | my class X::Syntax::Augment::Role does X::Syntax { ... } 232 | my class X::Syntax::Argument::MOPMacro does X::Syntax { ... } 233 | my class X::Does::TypeObject is Exception { ... } 234 | my class X::Role::Initialization is Exception { ... } 235 | my class X::Syntax::Comment::Embedded does X::Syntax { ... } 236 | my class X::Syntax::Pod::BeginWithoutIdentifier does X::Syntax does X::Pod { ... } 237 | my class X::Syntax::Pod::BeginWithoutEnd does X::Syntax does X::Pod { ... } 238 | my class X::Syntax::Confused does X::Syntax { ... } 239 | my class X::Syntax::Malformed does X::Syntax { ... } 240 | my class X::Syntax::Missing does X::Syntax { ... } 241 | my class X::Syntax::SigilWithoutName does X::Syntax { ... } 242 | my class X::Syntax::Self::WithoutObject does X::Syntax { ... } 243 | my class X::Syntax::VirtualCall does X::Syntax { ... } 244 | my class X::Syntax::NoSelf does X::Syntax { ... } 245 | my class X::Syntax::Number::RadixOutOfRange does X::Syntax { ... } 246 | my class X::Syntax::Regex::Adverb does X::Syntax { ... } 247 | my class X::Syntax::Signature::InvocantMarker does X::Syntax { ... } 248 | my class X::Syntax::Extension::Category does X::Syntax { ... } 249 | my class X::Syntax::InfixInTermPosition does X::Syntax { ... } 250 | my class X::Attribute::Package does X::Comp { ... } 251 | my class X::Attribute::NoPackage does X::Comp { ... } 252 | my class X::Declaration::Scope does X::Comp { ... } 253 | my class X::Declaration::Scope::Multi is X::Declaration::Scope { ... } 254 | my class X::Anon::Multi does X::Comp { ... } 255 | my class X::Anon::Augment does X::Comp { ... } 256 | my class X::Augment::NoSuchType does X::Comp { ... } 257 | my class X::Routine::Unwrap is Exception { ... } 258 | my class X::Constructor::Positional is Exception { ... } 259 | my class X::Hash::Store::OddNumber is Exception { ... } 260 | my class X::Package::Stubbed does X::Comp { ... } 261 | my class X::Phaser::PrePost is Exception { ... } 262 | my class X::Str::Numeric is Exception { ... } 263 | my class X::Str::Match::x is Exception { ... } 264 | my class X::Str::Trans::IllegalKey is Exception { ... } 265 | my class X::Str::Trans::InvalidArg is Exception { ... } 266 | my class X::Sequence::Deduction is Exception { ... } 267 | my class X::ControlFlow is Exception { ... } 268 | my class X::ControlFlow::Return is X::ControlFlow { ... } 269 | my class X::Composition::NotComposable does X::Comp { ... } 270 | my class X::TypeCheck is Exception { ... } 271 | my class X::TypeCheck::Binding is X::TypeCheck { ... } 272 | my class X::TypeCheck::Return is X::TypeCheck { ... } 273 | my class X::TypeCheck::Assignment is X::TypeCheck { ... } 274 | my class X::TypeCheck::Splice is X::TypeCheck does X::Comp { ... } 275 | my class X::Assignment::RO is Exception { ... } 276 | my class X::NoDispatcher is Exception { ... } 277 | my class X::Localizer::NoContainer is Exception { ... } 278 | my class X::Mixin::NotComposable is Exception { ... } 279 | my class X::Inheritance::Unsupported does X::Comp { ... } 280 | my class X::Export::NameClash does X::Comp { ... } 281 | my class X::HyperOp::NonDWIM is Exception { ... } 282 | my class X::Set::Coerce is Exception { ... } 283 | my role X::Temporal is Exception { } 284 | my class X::Temporal::InvalidFormat does X::Temporal { ... } 285 | my class X::Temporal::Truncation does X::Temporal { ... } 286 | my class X::DateTime::TimezoneClash does X::Temporal { ... } 287 | my class X::Eval::NoSuchLang is Exception { ... } 288 | my class X::Import::MissingSymbols is Exception { ... } 289 | my class X::Numeric::Real is Exception { ... } 290 | my class X::PseudoPackage::InDeclaration does X::Comp { ... } 291 | 292 | my class Backtrace { ... } 293 | 294 | my role Ordered { } 295 | my role Callable { } 296 | my role Positional { } 297 | my role Associative { } 298 | my role Abstraction { } 299 | my role Integral { } 300 | my role AttributeDeclarand { } 301 | my role ContainerDeclarand { } 302 | 303 | my subset Comparator of Code where { .signature === :(Any, Any --> Int ) }; 304 | my subset KeyExtractor of Code where { .signature === :(Any --> Any) }; 305 | my subset OrderingPair of Pair where { .left ~~ KeyExtractor && .right ~~ Comparator }; 306 | my subset Ordering of Mu where Signature | KeyExtractor | Comparator | OrderingPair | Whatever; 307 | 308 | my class Instant { } 309 | my class Duration { } 310 | my class Date { } 311 | my class DateTime { } 312 | 313 | my class IO { } 314 | my class Path { } 315 | 316 | my class KitchenSink { } 317 | 318 | my proto WHAT {*} 319 | my proto WHERE {*} 320 | my proto HOW {*} 321 | my proto WHICH {*} 322 | my proto VAR {*} 323 | my proto WHO {*} 324 | my proto WHENCE {*} 325 | my proto fail {*} 326 | my proto temp {*} 327 | my proto let {*} 328 | my proto any {*} 329 | my proto all {*} 330 | my proto none {*} 331 | my proto one {*} 332 | my proto not {*} 333 | my proto so {*} 334 | my proto next {*} 335 | my proto last {*} 336 | my proto redo {*} 337 | my proto succeed {*} 338 | my proto goto {*} 339 | 340 | my proto die {*} 341 | my proto exit {*} 342 | my proto warn {*} 343 | my proto note {*} 344 | my proto caller {*} 345 | my proto callframe {*} 346 | my proto EVAL {*} 347 | my proto evalfile {*} 348 | my proto callsame {*} 349 | my proto callwith {*} 350 | my proto nextsame {*} 351 | my proto nextwith {*} 352 | my proto lastcall {*} 353 | my proto defined {*} 354 | my proto notdef {*} 355 | my proto undefine {*} 356 | my proto item {*} 357 | my proto list {*} 358 | my proto flat {*} 359 | my proto lol {*} 360 | my proto eager {*} 361 | my proto hyper {*} 362 | my proto race {*} 363 | 364 | my proto cat {*} 365 | my proto classify {*} 366 | my proto categorize {*} 367 | my proto quotemeta {*} 368 | my proto chr {*} 369 | my proto ord {*} 370 | my proto chrs {*} 371 | my proto ords {*} 372 | my proto chop {*} 373 | my proto chomp {*} 374 | my proto trim {*} 375 | my proto trim-leading {*} 376 | my proto trim-trailing {*} 377 | my proto index {*} 378 | my proto rindex {*} 379 | my proto substr {*} 380 | my proto substr-rw {*} 381 | my proto join {*} 382 | my proto split {*} 383 | my proto comb {*} 384 | my proto pack {*} 385 | my proto unpack {*} 386 | my proto uc {*} 387 | my proto lc {*} 388 | my proto tc {*} 389 | my proto tclc {*} 390 | my proto tcuc {*} 391 | my proto wordcase {*} 392 | my proto normalize {*} 393 | my proto nfc {*} 394 | my proto nfd {*} 395 | my proto nfkc {*} 396 | my proto nfkd {*} 397 | my proto samecase {*} 398 | my proto sameaccent {*} 399 | my proto chars {*} 400 | my proto graphs {*} 401 | my proto codes {*} 402 | my proto bytes {*} 403 | 404 | my proto say {*} 405 | my proto print {*} 406 | my proto gist {*} 407 | my proto open {*} 408 | my proto close {*} 409 | my proto printf {*} 410 | my proto sprintf {*} 411 | my proto unlink {*} 412 | my proto link {*} 413 | my proto symlink {*} 414 | my proto elems {*} 415 | my proto end {*} 416 | my proto grep {*} 417 | my proto map {*} 418 | my proto first {*} 419 | my proto reduce {*} 420 | my proto sort {*} 421 | my proto min {*} 422 | my proto max {*} 423 | my proto minmax {*} 424 | my proto uniq {*} 425 | my proto push {*} 426 | my proto rotate {*} 427 | my proto reverse {*} 428 | my proto flip {*} 429 | my proto take {*} 430 | my proto take-rw {*} 431 | my proto splice {*} 432 | my proto slurp {*} 433 | my proto get {*} 434 | my proto lines {*} 435 | my proto getc {*} 436 | my proto prompt {*} 437 | my proto chdir {*} 438 | my proto chmod {*} 439 | 440 | my proto zip {*} 441 | my proto each {*} 442 | my proto roundrobin {*} 443 | my proto return {*} 444 | my proto return-rw {*} 445 | my proto leave {*} 446 | my proto make {*} 447 | my proto pop {*} 448 | my proto shift {*} 449 | my proto unshift {*} 450 | my proto keys {*} 451 | my proto values {*} 452 | my proto hash {*} 453 | my proto kv {*} 454 | my proto key {*} 455 | my proto value {*} 456 | my proto pairs {*} 457 | my proto invert {*} 458 | my proto pair {*} 459 | my proto enum {*} 460 | my proto set {*} 461 | my proto bag {*} 462 | 463 | my proto sign {*} 464 | my proto abs {*} 465 | my proto floor {*} 466 | my proto ceiling {*} 467 | my proto round {*} 468 | my proto truncate {*} 469 | my proto is-prime {*} 470 | my proto expmod {*} 471 | my proto exp {*} 472 | my proto log {*} 473 | my proto log10 {*} 474 | my proto sqrt {*} 475 | my proto roots {*} 476 | my proto rand {*} 477 | my proto srand {*} 478 | my proto pick {*} 479 | my proto roll {*} 480 | my proto cis {*} 481 | my proto unpolar {*} 482 | 483 | my proto sin {*} 484 | my proto cos {*} 485 | my proto tan {*} 486 | my proto asin {*} 487 | my proto acos {*} 488 | my proto atan {*} 489 | my proto sec {*} 490 | my proto cosec {*} 491 | my proto cotan {*} 492 | my proto asec {*} 493 | my proto acosec {*} 494 | my proto acotan {*} 495 | my proto sinh {*} 496 | my proto cosh {*} 497 | my proto tanh {*} 498 | my proto asinh {*} 499 | my proto acosh {*} 500 | my proto atanh {*} 501 | my proto sech {*} 502 | my proto cosech {*} 503 | my proto cotanh {*} 504 | my proto asech {*} 505 | my proto acosech {*} 506 | my proto acotanh {*} 507 | my proto atan2 {*} 508 | 509 | my proto today {*} 510 | 511 | my proto gmtime {*} 512 | my proto localtime {*} 513 | my proto times {*} 514 | my proto gethost {*} 515 | my proto getpw {*} 516 | my proto chroot {*} 517 | my proto getlogin {*} 518 | my proto shell {*} 519 | my proto run {*} 520 | my proto runinstead {*} 521 | my proto fork {*} 522 | my proto wait {*} 523 | my proto kill {*} 524 | my proto sleep {*} 525 | my proto dir {*} 526 | my proto mkdir {*} 527 | my proto rmdir {*} 528 | 529 | my proto socket {*} 530 | my proto listen {*} 531 | my proto accept {*} 532 | my proto connect {*} 533 | my proto bind {*} 534 | 535 | my proto postfix: ($x) {*} 536 | my proto infix:<.> ($x,$y) {*} 537 | my proto postfix:['->'] ($x) {*} 538 | my proto postfix:<++> ($x) {*} 539 | my proto postfix:«--» ($x) {*} 540 | my proto prefix:<++> ($x) {*} 541 | my proto prefix:«--» ($x) {*} 542 | my proto infix:<**> ($x,$y) {*} 543 | my proto prefix: ($x) {*} 544 | my proto prefix:<+> ($x) {*} 545 | my proto prefix:<-> ($x) {*} 546 | my proto prefix:<~~> ($x) {*} 547 | my proto prefix:<~> ($x) {*} 548 | my proto prefix: ($x) {*} 549 | my proto prefix: ($x) {*} 550 | my proto prefix:<~^> ($x) {*} 551 | my proto prefix:<+^> ($x) {*} 552 | my proto prefix: ($x) {*} 553 | my proto prefix:<^^> ($x) {*} 554 | my proto prefix:<^> ($x) {*} 555 | my proto prefix:<||> ($x) {*} 556 | my proto prefix:<|> ($x) {*} 557 | my proto infix:<*> ($x,$y) {*} 558 | my proto infix: ($x,$y) {*} 559 | my proto infix:
($x,$y) {*} 560 | my proto infix:<%> ($x,$y) {*} 561 | my proto infix: ($x,$y) {*} 562 | my proto infix:<+&> ($x,$y) {*} 563 | my proto infix:« << » ($x,$y) {*} 564 | my proto infix:« >> » ($x,$y) {*} 565 | my proto infix:<~&> ($x,$y) {*} 566 | my proto infix: ($x,$y) {*} 567 | my proto infix:« ~< » ($x,$y) {*} 568 | my proto infix:« ~> » ($x,$y) {*} 569 | my proto infix:« +< » ($x,$y) {*} 570 | my proto infix:« +> » ($x,$y) {*} 571 | my proto infix:<+> ($x,$y) {*} 572 | my proto infix:<-> ($x,$y) {*} 573 | my proto infix:<+|> ($x,$y) {*} 574 | my proto infix:<+^> ($x,$y) {*} 575 | my proto infix:<~|> ($x,$y) {*} 576 | my proto infix:<~^> ($x,$y) {*} 577 | my proto infix: ($x,$y) {*} 578 | my proto infix: ($x,$y) {*} 579 | my proto infix: ($x,$y) {*} 580 | my proto infix: ($x,$y) {*} 581 | my proto infix:<~> ($x,$y) {*} 582 | my proto infix:<&> ($x,$y) {*} 583 | my proto infix:<|> ($x,$y) {*} 584 | my proto infix:<^> ($x,$y) {*} 585 | my proto infix:« <=> » ($x,$y) {*} 586 | my proto infix: ($x,$y) {*} 587 | my proto infix: ($x,$y) {*} 588 | my proto infix:<..> ($x,$y) {*} 589 | my proto infix:<^..> ($x,$y) {*} 590 | my proto infix:<..^> ($x,$y) {*} 591 | my proto infix:<^..^> ($x,$y) {*} 592 | my proto infix:<==> ($x,$y) {*} 593 | my proto infix: ($x,$y) {*} 594 | my proto infix:« < » ($x,$y) {*} 595 | my proto infix:« <= » ($x,$y) {*} 596 | my proto infix:« > » ($x,$y) {*} 597 | my proto infix:« >= » ($x,$y) {*} 598 | my proto infix:<~~> ($x,$y) {*} 599 | my proto infix: ($x,$y) {*} 600 | my proto infix:<=~> ($x,$y) {*} 601 | my proto infix: ($x,$y) {*} 602 | my proto infix: ($x,$y) {*} 603 | my proto infix: ($x,$y) {*} 604 | my proto infix: ($x,$y) {*} 605 | my proto infix: ($x,$y) {*} 606 | my proto infix: ($x,$y) {*} 607 | my proto infix:<=:=> ($x,$y) {*} 608 | my proto infix:<===> ($x,$y) {*} 609 | my proto infix: ($x,$y) {*} 610 | my proto infix: ($x,$y) {*} 611 | my proto infix: ($x,$y) {*} 612 | my proto infix:<&&> ($x,$y) {*} 613 | my proto infix:<||> ($x,$y) {*} 614 | my proto infix:<^^> ($x,$y) {*} 615 | my proto infix: ($x,$y) {*} 616 | my proto infix: ($x,$y) {*} 617 | my proto infix: ($x,$y) {*} 618 | my proto infix: ($x,$y) {*} 619 | my proto infix: ($x,$y) {*} 620 | my proto infix: ($x,$y) {*} 621 | my proto infix: ($x,$y) {*} 622 | my proto infix:<^ff> ($x,$y) {*} 623 | my proto infix: ($x,$y) {*} 624 | my proto infix:<^ff^> ($x,$y) {*} 625 | my proto infix: ($x,$y) {*} 626 | my proto infix:<^fff> ($x,$y) {*} 627 | my proto infix: ($x,$y) {*} 628 | my proto infix:<^fff^> ($x,$y) {*} 629 | my proto infix:<=> ($x,$y) {*} 630 | my proto infix:<:=> ($x,$y) {*} 631 | my proto infix:<::=> ($x,$y) {*} 632 | my proto infix:<.=> ($x,$y) {*} 633 | my proto infix:« => » ($x,$y) {*} 634 | my proto prefix: ($x) {*} 635 | my proto prefix: ($x) {*} 636 | my proto infix:<,> ($x,$y) {*} 637 | my proto infix:<:> ($x,$y) {*} 638 | my proto infix: ($x,$y) {*} 639 | my proto infix: ($x,$y) {*} 640 | my proto infix: ($x,$y) {*} 641 | my proto infix:<...> ($x,$y) {*} 642 | my proto infix: ($x,$y) {*} 643 | my proto infix: ($x,$y) {*} 644 | my proto infix: ($x,$y) {*} 645 | my proto infix: ($x,$y) {*} 646 | my proto infix: ($x,$y) {*} 647 | my proto infix:« <== » ($x,$y) {*} 648 | my proto infix:« ==> » ($x,$y) {*} 649 | my proto infix:« <<== » ($x,$y) {*} 650 | my proto infix:« ==>> » ($x,$y) {*} 651 | 652 | my proto sub infix:<∈>($, $ --> Bool) is equiv(&infix:<==>) is export {*} 653 | my proto sub infix:<(elem)>($a, $b --> Bool) {*} 654 | my proto sub infix:<∉>($a, $b --> Bool) is equiv(&infix:<==>) is export {*} 655 | 656 | my proto sub infix:<∋>($, $ --> Bool) is equiv(&infix:<==>) is export {*} 657 | my proto sub infix:<(cont)>($a, $b --> Bool) {*} 658 | my proto sub infix:<∌>($a, $b --> Bool) is equiv(&infix:<==>) is export {*} 659 | 660 | my proto sub infix:<∪>(Any $a, Any $b --> Set) is equiv(&infix:<|>) is export {*} 661 | my proto sub infix:<(|)>($a, $b --> Set) is equiv(&infix:<|>) is export {*} 662 | 663 | my proto sub infix:<∩>(Any $a, Any $b --> Set) is equiv(&infix:<&>) is export {*} 664 | my proto sub infix:<(&)>($a, $b --> Set) is equiv(&infix:<&>) is export {*} 665 | 666 | my proto sub infix:<(-)>(Any $a, Any $b --> Set) is equiv(&infix:<^>) is export {*} 667 | 668 | my proto sub infix:<(^)>(Any $a, Any $b --> Set) is equiv(&infix:<^>) is export {*} 669 | 670 | my proto sub infix:<⊆>($, $ --> Bool) is equiv(&infix:<==>) is export {*} 671 | my proto sub infix:['(<=)']($a, $b --> Bool) is equiv(&infix:<==>) is export {*} 672 | my proto sub infix:<⊈>($a, $b --> Bool) is equiv(&infix:<==>) is export {*} 673 | 674 | my proto sub infix:<⊂>($, $ --> Bool) is equiv(&infix:<==>) is export {*} 675 | my proto sub infix:['(<)']($a, $b --> Bool) is equiv(&infix:<==>) is export {*} 676 | my proto sub infix:<⊄>($a, $b --> Bool) is equiv(&infix:<==>) is export {*} 677 | 678 | my proto sub infix:<⊇>($, $ --> Bool) is equiv(&infix:<==>) is export {*} 679 | my proto sub infix:['(>=)']($a, $b --> Bool) is equiv(&infix:<==>) is export {*} 680 | my proto sub infix:<⊉>($a, $b --> Bool) is equiv(&infix:<==>) is export {*} 681 | 682 | my proto sub infix:<⊃>($, $ --> Bool) is equiv(&infix:<==>) is export {*} 683 | my proto sub infix:['(>)']($a, $b --> Bool) is equiv(&infix:<==>) is export {*} 684 | my proto sub infix:<⊅>($a, $b --> Bool) is equiv(&infix:<==>) is export {*} 685 | 686 | my package PROCESS { 687 | my %ENV is export; 688 | } 689 | 690 | {YOU_ARE_HERE}; 691 | -------------------------------------------------------------------------------- /CORE5.setting: -------------------------------------------------------------------------------- 1 | # CORE.setting 2 | # 3 | # Copyright 2009-2010, Larry Wall 4 | # 5 | # You may copy this software under the terms of the Artistic License, 6 | # version 2.0 or later. 7 | 8 | my proto WHAT {*} 9 | my proto WHERE {*} 10 | my proto HOW {*} 11 | my proto WHICH {*} 12 | my proto VAR {*} 13 | my proto WHO {*} 14 | my proto WHENCE {*} 15 | my proto fail {*} 16 | my proto temp {*} 17 | my proto let {*} 18 | my proto any {*} 19 | my proto all {*} 20 | my proto none {*} 21 | my proto one {*} 22 | my proto not {*} 23 | my proto so {*} 24 | my proto next {*} 25 | my proto last {*} 26 | my proto redo {*} 27 | my proto succeed {*} 28 | my proto goto {*} 29 | 30 | my proto die {*} 31 | my proto exit {*} 32 | my proto warn {*} 33 | my proto note {*} 34 | my proto caller {*} 35 | my proto callframe {*} 36 | my proto eval {*} 37 | my proto evalfile {*} 38 | my proto callsame {*} 39 | my proto callwith {*} 40 | my proto nextsame {*} 41 | my proto nextwith {*} 42 | my proto lastcall {*} 43 | my proto defined {*} 44 | my proto notdef {*} 45 | my proto undefine {*} 46 | my proto item {*} 47 | my proto list {*} 48 | my proto flat {*} 49 | my proto lol {*} 50 | my proto eager {*} 51 | my proto hyper {*} 52 | 53 | my proto cat {*} 54 | my proto classify {*} 55 | my proto categorize {*} 56 | my proto quotemeta {*} 57 | my proto chr {*} 58 | my proto ord {*} 59 | my proto chrs {*} 60 | my proto ords {*} 61 | my proto chop {*} 62 | my proto chomp {*} 63 | my proto trim {*} 64 | my proto trim-leading {*} 65 | my proto trim-trailing {*} 66 | my proto index {*} 67 | my proto rindex {*} 68 | my proto substr {*} 69 | my proto join {*} 70 | my proto split {*} 71 | my proto comb {*} 72 | my proto pack {*} 73 | my proto unpack {*} 74 | my proto uc {*} 75 | my proto ucfirst {*} 76 | my proto lc {*} 77 | my proto lcfirst {*} 78 | my proto normalize {*} 79 | my proto nfc {*} 80 | my proto nfd {*} 81 | my proto nfkc {*} 82 | my proto nfkd {*} 83 | my proto samecase {*} 84 | my proto sameaccent {*} 85 | my proto capitalize {*} 86 | my proto chars {*} 87 | my proto graphs {*} 88 | my proto codes {*} 89 | my proto bytes {*} 90 | 91 | my proto say {*} 92 | my proto print {*} 93 | my proto gist {*} 94 | my proto open {*} 95 | my proto close {*} 96 | my proto printf {*} 97 | my proto sprintf {*} 98 | my proto unlink {*} 99 | my proto link {*} 100 | my proto symlink {*} 101 | my proto elems {*} 102 | my proto end {*} 103 | my proto grep {*} 104 | my proto map {*} 105 | my proto first {*} 106 | my proto reduce {*} 107 | my proto sort {*} 108 | my proto min {*} 109 | my proto max {*} 110 | my proto minmax {*} 111 | my proto uniq {*} 112 | my proto push {*} 113 | my proto rotate {*} 114 | my proto reverse {*} 115 | my proto flip {*} 116 | my proto take {*} 117 | my proto splice {*} 118 | my proto slurp {*} 119 | my proto get {*} 120 | my proto lines {*} 121 | my proto getc {*} 122 | my proto prompt {*} 123 | my proto chdir {*} 124 | my proto chmod {*} 125 | 126 | my proto zip {*} 127 | my proto each {*} 128 | my proto roundrobin {*} 129 | my proto return {*} 130 | my proto leave {*} 131 | my proto make {*} 132 | my proto pop {*} 133 | my proto shift {*} 134 | my proto unshift {*} 135 | my proto keys {*} 136 | my proto values {*} 137 | my proto hash {*} 138 | my proto kv {*} 139 | my proto key {*} 140 | my proto value {*} 141 | my proto pairs {*} 142 | my proto invert {*} 143 | my proto pair {*} 144 | my proto enum {*} 145 | my proto set {*} 146 | my proto bag {*} 147 | 148 | my proto sign {*} 149 | my proto abs {*} 150 | my proto floor {*} 151 | my proto ceiling {*} 152 | my proto round {*} 153 | my proto truncate {*} 154 | my proto exp {*} 155 | my proto log {*} 156 | my proto log10 {*} 157 | my proto sqrt {*} 158 | my proto roots {*} 159 | my proto rand {*} 160 | my proto srand {*} 161 | my proto pick {*} 162 | my proto roll {*} 163 | my proto cis {*} 164 | my proto unpolar {*} 165 | 166 | my proto sin {*} 167 | my proto cos {*} 168 | my proto tan {*} 169 | my proto asin {*} 170 | my proto acos {*} 171 | my proto atan {*} 172 | my proto sec {*} 173 | my proto cosec {*} 174 | my proto cotan {*} 175 | my proto asec {*} 176 | my proto acosec {*} 177 | my proto acotan {*} 178 | my proto sinh {*} 179 | my proto cosh {*} 180 | my proto tanh {*} 181 | my proto asinh {*} 182 | my proto acosh {*} 183 | my proto atanh {*} 184 | my proto sech {*} 185 | my proto cosech {*} 186 | my proto cotanh {*} 187 | my proto asech {*} 188 | my proto acosech {*} 189 | my proto acotanh {*} 190 | my proto atan2 {*} 191 | 192 | my proto today {*} 193 | 194 | my proto gmtime {*} 195 | my proto localtime {*} 196 | my proto times {*} 197 | my proto gethost {*} 198 | my proto getpw {*} 199 | my proto chroot {*} 200 | my proto getlogin {*} 201 | my proto shell {*} 202 | my proto run {*} 203 | my proto runinstead {*} 204 | my proto fork {*} 205 | my proto wait {*} 206 | my proto kill {*} 207 | my proto sleep {*} 208 | my proto dir {*} 209 | 210 | my proto postfix: ($x) {*} 211 | my proto infix:<.> ($x,$y) {*} 212 | my proto postfix:['->'] ($x) {*} 213 | my proto postfix:<++> ($x) {*} 214 | my proto postfix:«--» ($x) {*} 215 | my proto prefix:<++> ($x) {*} 216 | my proto prefix:«--» ($x) {*} 217 | my proto infix:<**> ($x,$y) {*} 218 | my proto prefix: ($x) {*} 219 | my proto prefix:<+> ($x) {*} 220 | my proto prefix:<-> ($x) {*} 221 | my proto prefix:<~~> ($x) {*} 222 | my proto prefix:<~> ($x) {*} 223 | my proto prefix: ($x) {*} 224 | my proto prefix: ($x) {*} 225 | my proto prefix:<~^> ($x) {*} 226 | my proto prefix:<+^> ($x) {*} 227 | my proto prefix: ($x) {*} 228 | my proto prefix:<^^> ($x) {*} 229 | my proto prefix:<^> ($x) {*} 230 | my proto prefix:<||> ($x) {*} 231 | my proto prefix:<|> ($x) {*} 232 | my proto infix:<*> ($x,$y) {*} 233 | my proto infix: ($x,$y) {*} 234 | my proto infix:
($x,$y) {*} 235 | my proto infix:<%> ($x,$y) {*} 236 | my proto infix: ($x,$y) {*} 237 | my proto infix:<+&> ($x,$y) {*} 238 | my proto infix:« << » ($x,$y) {*} 239 | my proto infix:« >> » ($x,$y) {*} 240 | my proto infix:<~&> ($x,$y) {*} 241 | my proto infix: ($x,$y) {*} 242 | my proto infix:« ~< » ($x,$y) {*} 243 | my proto infix:« ~> » ($x,$y) {*} 244 | my proto infix:« +< » ($x,$y) {*} 245 | my proto infix:« +> » ($x,$y) {*} 246 | my proto infix:<+> ($x,$y) {*} 247 | my proto infix:<-> ($x,$y) {*} 248 | my proto infix:<+|> ($x,$y) {*} 249 | my proto infix:<+^> ($x,$y) {*} 250 | my proto infix:<~|> ($x,$y) {*} 251 | my proto infix:<~^> ($x,$y) {*} 252 | my proto infix: ($x,$y) {*} 253 | my proto infix: ($x,$y) {*} 254 | my proto infix: ($x,$y) {*} 255 | my proto infix: ($x,$y) {*} 256 | my proto infix:<~> ($x,$y) {*} 257 | my proto infix:<&> ($x,$y) {*} 258 | my proto infix:<|> ($x,$y) {*} 259 | my proto infix:<^> ($x,$y) {*} 260 | my proto infix:« <=> » ($x,$y) {*} 261 | my proto infix:<..> ($x,$y) {*} 262 | my proto infix:<^..> ($x,$y) {*} 263 | my proto infix:<..^> ($x,$y) {*} 264 | my proto infix:<^..^> ($x,$y) {*} 265 | my proto infix:<==> ($x,$y) {*} 266 | my proto infix: ($x,$y) {*} 267 | my proto infix:« < » ($x,$y) {*} 268 | my proto infix:« <= » ($x,$y) {*} 269 | my proto infix:« > » ($x,$y) {*} 270 | my proto infix:« >= » ($x,$y) {*} 271 | my proto infix:<~~> ($x,$y) {*} 272 | my proto infix: ($x,$y) {*} 273 | my proto infix:<=~> ($x,$y) {*} 274 | my proto infix: ($x,$y) {*} 275 | my proto infix: ($x,$y) {*} 276 | my proto infix: ($x,$y) {*} 277 | my proto infix: ($x,$y) {*} 278 | my proto infix: ($x,$y) {*} 279 | my proto infix: ($x,$y) {*} 280 | my proto infix:<=:=> ($x,$y) {*} 281 | my proto infix:<===> ($x,$y) {*} 282 | my proto infix: ($x,$y) {*} 283 | my proto infix: ($x,$y) {*} 284 | my proto infix: ($x,$y) {*} 285 | my proto infix:<&&> ($x,$y) {*} 286 | my proto infix:<||> ($x,$y) {*} 287 | my proto infix:<^^> ($x,$y) {*} 288 | my proto infix: ($x,$y) {*} 289 | my proto infix: ($x,$y) {*} 290 | my proto infix: ($x,$y) {*} 291 | my proto infix: ($x,$y) {*} 292 | my proto infix: ($x,$y) {*} 293 | my proto infix: ($x,$y) {*} 294 | my proto infix: ($x,$y) {*} 295 | my proto infix:<^ff> ($x,$y) {*} 296 | my proto infix: ($x,$y) {*} 297 | my proto infix:<^ff^> ($x,$y) {*} 298 | my proto infix: ($x,$y) {*} 299 | my proto infix:<^fff> ($x,$y) {*} 300 | my proto infix: ($x,$y) {*} 301 | my proto infix:<^fff^> ($x,$y) {*} 302 | my proto infix:<=> ($x,$y) {*} 303 | my proto infix:<:=> ($x,$y) {*} 304 | my proto infix:<::=> ($x,$y) {*} 305 | my proto infix:<.=> ($x,$y) {*} 306 | my proto infix:« => » ($x,$y) {*} 307 | my proto prefix: ($x) {*} 308 | my proto prefix: ($x) {*} 309 | my proto infix:<,> ($x,$y) {*} 310 | my proto infix:<:> ($x,$y) {*} 311 | my proto infix: ($x,$y) {*} 312 | my proto infix: ($x,$y) {*} 313 | my proto infix: ($x,$y) {*} 314 | my proto infix:<...> ($x,$y) {*} 315 | my proto infix: ($x,$y) {*} 316 | my proto infix: ($x,$y) {*} 317 | my proto infix: ($x,$y) {*} 318 | my proto infix: ($x,$y) {*} 319 | my proto infix: ($x,$y) {*} 320 | my proto infix:« <== » ($x,$y) {*} 321 | my proto infix:« ==> » ($x,$y) {*} 322 | my proto infix:« <<== » ($x,$y) {*} 323 | my proto infix:« ==>> » ($x,$y) {*} 324 | 325 | my package PROCESS { 326 | my %ENV is export; 327 | } 328 | 329 | our %SIG; 330 | package DB { 331 | our $deep; 332 | } 333 | 334 | {YOU_ARE_HERE}; 335 | -------------------------------------------------------------------------------- /Cursor.pm6: -------------------------------------------------------------------------------- 1 | # Cursor.pm 2 | # 3 | # Copyright 2007-2010, Larry Wall 4 | # 5 | # You may copy this software under the terms of the Artistic License, 6 | # version 2.0 or later. 7 | 8 | use CursorBase; 9 | class Cursor is CursorBase; 10 | our $BLUE = $CursorBase::BLUE; 11 | our $GREEN = $CursorBase::GREEN; 12 | our $CYAN = $CursorBase::CYAN; 13 | our $MAGENTA = $CursorBase::MAGENTA; 14 | our $YELLOW = $CursorBase::YELLOW; 15 | our $RED = $CursorBase::RED; 16 | our $CLEAR = $CursorBase::CLEAR; 17 | 18 | method panic (Str $s) { 19 | self.deb("panic $s") if $*DEBUG; 20 | my $m; 21 | my $here = self; 22 | 23 | $m ~= $s; 24 | $m ~= $here.locmess; 25 | $m ~= "\n" unless $m ~~ /\n$/; 26 | 27 | note $Cursor::RED, '===', $Cursor::CLEAR, 'SORRY!', $Cursor::RED, '===', $Cursor::CLEAR, "\n"; 28 | note $m; 29 | 30 | die "Parse failed\n"; 31 | } 32 | 33 | method worry (Str $s) { 34 | my $m = $s ~ self.locmess; 35 | push @*WORRIES, $m unless %*WORRIES{$s}++; 36 | self; 37 | } 38 | 39 | method sorry (Str $s) { 40 | self.deb("sorry $s") if $*DEBUG; 41 | note $Cursor::RED, '===', $Cursor::CLEAR, 'SORRY!', $Cursor::RED, '===', $Cursor::CLEAR, "\n" 42 | unless $*IN_SUPPOSE or $*FATALS++; 43 | if $s { 44 | my $m = $s; 45 | $m ~= self.locmess ~ "\n" unless $m ~~ /\n$/; 46 | if $*FATALS > 10 or $*IN_SUPPOSE { 47 | die $m; 48 | } 49 | else { 50 | note $m unless %*WORRIES{$m}++; 51 | } 52 | } 53 | self; 54 | } 55 | 56 | method locmess () { 57 | my $pos = self.pos; 58 | my $line = self.lineof($pos); 59 | 60 | # past final newline? 61 | if $pos >= @*MEMOS - 1 { 62 | $pos = $pos - 1; 63 | $line = $line ~ " (EOF)"; 64 | } 65 | 66 | my $pre = substr($*ORIG, 0, $pos); 67 | $pre = substr($pre, -40, 40); 68 | 1 while $pre ~~ s!.*\n!!; 69 | $pre = '' if $pre eq ''; 70 | my $post = substr($*ORIG, $pos, 40); 71 | 1 while $post ~~ s!(\n.*)!!; 72 | $post = '' if $post eq ''; 73 | " at " ~ $*FILE ~ " line $line:\n------> " ~ $Cursor::GREEN ~ $pre ~ $Cursor::YELLOW ~ $*PERL6HERE ~ $Cursor::RED ~ 74 | "$post$Cursor::CLEAR"; 75 | } 76 | 77 | method line { 78 | self.lineof(self.pos); 79 | } 80 | 81 | method lineof ($p) { 82 | return 1 unless defined $p; 83 | my $line = @*MEMOS[$p]; 84 | return $line if $line; 85 | $line = 0; 86 | my $pos = 0; 87 | my @text = split(/^/,$*ORIG); # XXX p5ism, should be ^^ 88 | for @text { 89 | $line++; 90 | @*MEMOS[$pos++] = $line 91 | for 1 .. chars($_); 92 | } 93 | @*MEMOS[$pos++] = $line; 94 | return @*MEMOS[$p] // 0; 95 | } 96 | 97 | method SETGOAL { } 98 | method FAILGOAL (Str $stop, Str $name, $startpos) { 99 | my $s = "'$stop'"; 100 | $s = '"\'"' if $s eq "'''"; 101 | self.panic("Unable to parse $name" ~ $startpos.locmess ~ "\nCouldn't find final $s; gave up"); 102 | } 103 | ## vim: expandtab sw=4 ft=perl6 104 | -------------------------------------------------------------------------------- /CursorBase.pm6: -------------------------------------------------------------------------------- 1 | # Just a stub to fake out viv/STD.pm6 2 | class CursorBase; 3 | our $RED; 4 | our $GREEN; 5 | our $BLUE; 6 | our $CYAN; 7 | our $MAGENTA; 8 | our $YELLOW; 9 | our $CLEAR; 10 | -------------------------------------------------------------------------------- /DEBUG.pmc: -------------------------------------------------------------------------------- 1 | # DEBUG.pmc 2 | # 3 | # Copyright 2008-2010, Larry Wall 4 | # 5 | # You may copy this software under the terms of the Artistic License, 6 | # version 2.0 or later. 7 | 8 | package DEBUG; 9 | our @EXPORTS = qw( 10 | autolexer 11 | symtab 12 | fixed_length 13 | fates 14 | longest_token_pattern_generation 15 | EXPR 16 | matchers 17 | trace_call 18 | cursors 19 | try_processing 20 | mixins 21 | callm_show_subnames 22 | use_color 23 | ); 24 | use constant { 25 | autolexer => 1, 26 | symtab => 2, 27 | fixed_length => 4, 28 | fates => 8, 29 | longest_token_pattern_generation => 16, 30 | EXPR => 32, 31 | matchers => 64, 32 | trace_call=> 128, 33 | cursors => 256, 34 | try_processing => 1024, 35 | mixins => 2048, 36 | callm_show_subnames => 16384, 37 | use_color => 32768 38 | }; 39 | -------------------------------------------------------------------------------- /LazyMap.pm: -------------------------------------------------------------------------------- 1 | package LazyMap; 2 | use 5.010; 3 | 4 | # LazyMap.pm 5 | # 6 | # Copyright 2007-2010, Larry Wall 7 | # 8 | # You may copy this software under the terms of the Artistic License, 9 | # version 2.0 or later. 10 | 11 | # LazyMap implements backtracking for the Cursor parsing engine. It does this 12 | # in a very similar manner to the List monad in Haskell. Notionally, Cursor 13 | # processes lists of all results, however only the first result is immediately 14 | # calculated; the other results are suspended, and only generated when later 15 | # code needs to refer to them. The standard operation on lazy objects is to 16 | # map a function over them; this function can return other objects, or lazy 17 | # objects which will be lazily flattened in the result. 18 | 19 | # A lazy object has the iterator nature, and is destroyed by use. Lazy objects 20 | # support two methods; iter returns the next value (or undef), the bool 21 | # overload returns true if more values are available. 22 | 23 | # Lazy values can be associated with transactions. These are used in lieu 24 | # of stack unwinding to implement deep cut operators; when a deep cut is 25 | # performed, values are set on the transaction object, causing further iteration 26 | # (i.e. backtracking) to fail for associated lazies. 27 | 28 | use strict; 29 | use warnings; 30 | no warnings 'recursion'; 31 | 32 | use Exporter; 33 | 34 | our @ISA = 'Exporter'; 35 | 36 | our @EXPORT = qw(lazymap eager); 37 | 38 | our $AUTOLOAD; 39 | 40 | # Calling an unrecognized method on a lazy delegates to the shifted value, and 41 | # additionally returns the rest... 42 | sub AUTOLOAD { 43 | (my $meth = $AUTOLOAD) =~ s/.*:://; 44 | return if $meth eq 'DESTROY'; 45 | print STDERR "AUTOLOAD $meth\n"; 46 | my $self = shift; 47 | if (my ($eager) = $self->iter) { 48 | return $eager->$meth(@_), $self; 49 | } 50 | return (); 51 | } 52 | 53 | use overload 'bool' => 'true'; 54 | 55 | # A lazy map represents the lazy result of a concatenating map operation. 56 | # As a microoptimization, we shorten field names for the benefit of strcmp. 57 | # 58 | # B: the function to call to transform each incoming value; it is called in 59 | # list context and it should return multiple values to create a choice 60 | # point. It can also return a lazy list, which is treated as a lazy 61 | # choice point. 62 | # C: The values which were generated by the last block call, if it returned 63 | # >1 (since iter only removes one at a time, but they don't arrive that way) 64 | # L: The values input to the map which have not yet been fed to the block 65 | # N: Number of values so far returned - this is used to ignore cuts if we 66 | # haven't delivered our first value yet (somewhat of a hack). 67 | # 68 | # Values returned by a LazyMap are expected to be cursors, or at least have 69 | # an _xact field that can be checked for cutness. 70 | 71 | # Construct a lazymap - block, then a list of inputs (concatenated if lazies) 72 | sub new { 73 | my $class = shift; 74 | my $block = shift; 75 | return bless { 'B' => $block, 'C' => [], 'L' => [@_], 'N' => 0 }, $class; 76 | } 77 | 78 | # The fundamental operation on lazies, sometimes spelled concatMap. In list 79 | # context, returns the first value eagerly (this pairing is equivalent to the 80 | # rolled lazymap in lazycat context). 81 | sub lazymap (&@) { 82 | my $block = shift; 83 | return () unless @_; 84 | my $lazy = bless { 'B' => $block, 'C' => [], 'L' => [@_], 'N' => 0 }, 'LazyMap'; 85 | if (wantarray) { 86 | if (my @retval = iter($lazy)) { 87 | push @retval, $lazy if @{$lazy->{C}} || @{$lazy->{L}}; 88 | return @retval; 89 | } 90 | return; 91 | } 92 | else { 93 | $lazy; 94 | } 95 | } 96 | 97 | # Destructively extract the next value from a lazy, or undef. 98 | sub iter { 99 | my $self = shift; 100 | my $lazies = $self->{L}; 101 | my $called = $self->{C}; 102 | while (@$called or @$lazies) { 103 | # pull from lazy list only when forced to 104 | while (not @$called) { 105 | return () unless @$lazies; 106 | my $lazy = $$lazies[0]; 107 | # recursive lazies? delegate to lower ->iter 108 | if (ref($lazy) =~ /^Lazy/) { 109 | my $todo = $lazy->iter; 110 | if (defined $todo) { 111 | @$called = $self->{B}->($todo); 112 | } 113 | else { 114 | shift @$lazies; 115 | } 116 | } 117 | elsif (defined $lazy) { # just call our own block 118 | @$called = $self->{B}->(shift @$lazies); 119 | } 120 | else { # undef snuck into the list somehow 121 | shift @$lazies; 122 | } 123 | } 124 | 125 | # evaluating the blocks may have returned something lazy, so delegate again 126 | while (@$called and ref($$called[0]) =~ /^Lazy/) { 127 | my $really = $$called[0]->iter; 128 | if ($really) { 129 | unshift @$called, $really; 130 | } 131 | else { 132 | shift @$called; 133 | } 134 | } 135 | 136 | # finally have at least one real cursor, grep for first with live transaction 137 | while (@$called and ref($$called[0]) !~ /^Lazy/) { 138 | my $candidate = shift @$called; 139 | # make sure its transaction doesn't have a prior commitment 140 | my $xact = $candidate->{_xact}; 141 | my $n = $self->{N}++; 142 | return $candidate unless $xact->[-2] and $n; 143 | } 144 | } 145 | return (); 146 | } 147 | 148 | sub true { 149 | my $self = shift(); 150 | my $called = $self->{C}; 151 | return 1 if @$called; 152 | my $lazies = $self->{L}; 153 | return 0 unless @$lazies; 154 | return 0 unless my ($c) = $self->iter; 155 | unshift(@$called, $c); 156 | return 1; 157 | } 158 | 159 | # Destructively convert a lazies into a list; equivalently, places lazycat 160 | # context on the interior. Only useful in list context 161 | sub eager { 162 | my @out; 163 | while (@_) { 164 | my $head = shift; 165 | if (ref($head) eq 'LazyMap') { # don't unroll LazyConst 166 | while (my ($next) = $head->iter) { 167 | push @out, $next; 168 | } 169 | } 170 | else { 171 | push @out, $head; 172 | } 173 | } 174 | # print STDERR ::Dump(@out); 175 | @out; 176 | } 177 | 178 | # LazyConst produces an infinite list, which stubbornly tries the same value 179 | # over and over 180 | { package LazyConst; 181 | sub new { 182 | my $self = shift; 183 | my $xact = shift; 184 | bless { 'K' => shift, 'X' => $xact }, 'LazyConst'; 185 | } 186 | sub true { 187 | 1; 188 | } 189 | sub iter { 190 | return () if $_[0]->{X}->[-2]; 191 | $_[0]->{K}; 192 | } 193 | } 194 | 195 | # LazyRange lazily produces each value in a sequence - useful for quantifiers 196 | { package LazyRange; 197 | sub new { 198 | my $class = shift; 199 | my $xact = shift; 200 | my $start = shift; 201 | my $end = shift; 202 | bless { 'N' => $start, 'E' => $end, 'X' => $xact }, $class; 203 | } 204 | sub true { 205 | 1; 206 | } 207 | sub iter { 208 | my $self = shift; 209 | if ($self->{X}->[-2]) { 210 | () 211 | } 212 | elsif ((my $n = $self->{N}++) <= $self->{E}) { 213 | $n; 214 | } 215 | else { 216 | (); 217 | } 218 | } 219 | } 220 | 221 | # Like above, but reverse 222 | { package LazyRangeRev; 223 | sub new { 224 | my $class = shift; 225 | my $xact = shift; 226 | my $start = shift; 227 | my $end = shift; 228 | bless { 'N' => $start, 'E' => $end, 'X' => $xact }, $class; 229 | } 230 | sub true { 231 | 1; 232 | } 233 | sub iter { 234 | my $self = shift; 235 | if ($self->{X}->[-2]) { 236 | () 237 | } 238 | elsif ((my $n = $self->{N}--) >= $self->{E}) { 239 | $n; 240 | } 241 | else { 242 | (); 243 | } 244 | } 245 | } 246 | 247 | 1; 248 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for STD.pm6 viv etcetera in pugs/src/perl6 2 | .PHONY: six five all sixfast clean snap snaptest 3 | 4 | INVARIANT=Actions.pm CORE.setting CursorBase.pmc DEBUG.pmc LazyMap.pm NAME.pmc\ 5 | RE_ast.pmc Stash.pmc mangle.pl uniprops viv 6 | GENERATE=STD.pmc Cursor.pmc 7 | BOOTFILES=boot/STD.pmc boot/Cursor.pmc 8 | 9 | STD_SOURCE=STD.pm6 Cursor.pm6 CursorBase.pm6 lib/Stash.pm6 lib/NAME.pm6\ 10 | lib/DEBUG.pm6 11 | CURSOR_SOURCE=Cursor.pm6 CursorBase.pm6 12 | 13 | PERL=perl 14 | 15 | RM_RF=$(PERL) -MExtUtils::Command -e rm_rf 16 | CP=$(PERL) -MExtUtils::Command -e cp 17 | MV=$(PERL) -MExtUtils::Command -e mv 18 | MKDIR=mkdir 19 | GIT=git 20 | # no snaptest on win32 just yet 21 | CP_R=cp -r 22 | 23 | all: syml/CORE.syml STD_P5.pmc syml/CORE5.syml 24 | six: syml/CORE.syml 25 | five: syml/CORE5.syml 26 | 27 | clean: 28 | $(RM_RF) syml STD_P5.pmc $(GENERATE) boot/syml boot/.stamp .stamp\ 29 | STD_P5.pm5 STD.pm5 Cursor.pm5 snap.old snap.new 30 | 31 | ######################################## 32 | # */syml/CORE.syml indicates that the corresponding compiler is "usable" 33 | boot/syml/CORE.syml: $(INVARIANT) $(BOOTFILES) 34 | $(RM_RF) boot/syml 35 | $(PERL) ./viv --boot --noperl6lib --compile-setting CORE.setting 36 | 37 | STD.pmc: $(STD_SOURCE) boot/syml/CORE.syml $(INVARIANT) 38 | $(PERL) ./viv --boot --noperl6lib -5 -o STD.pm5 STD.pm6 39 | $(PERL) tools/compact_pmc < STD.pm5 > STD.pmc 40 | STD_P5.pmc: STD_P5.pm6 boot/syml/CORE.syml $(INVARIANT) 41 | $(PERL) ./viv --boot --noperl6lib -5 -o STD_P5.pm5 STD_P5.pm6 42 | $(PERL) tools/compact_pmc < STD_P5.pm5 > STD_P5.pmc 43 | Cursor.pmc: $(CURSOR_SOURCE) boot/syml/CORE.syml $(INVARIANT) 44 | $(PERL) ./viv --boot --noperl6lib -5 -o Cursor.pm5 Cursor.pm6 45 | $(PERL) tools/compact_pmc < Cursor.pm5 > Cursor.pmc 46 | syml/CORE.syml: STD.pmc Cursor.pmc $(INVARIANT) 47 | $(RM_RF) syml 48 | $(PERL) ./viv --noperl6lib --compile-setting CORE.setting 49 | $(CP) boot/syml/CursorBase.syml boot/syml/Cursor.syml boot/syml/DEBUG.syml boot/syml/NAME.syml boot/syml/Stash.syml boot/syml/STD.syml syml 50 | 51 | syml/CORE5.syml: STD.pmc CORE5.setting Cursor.pmc $(INVARIANT) 52 | $(PERL) ./viv --noperl6lib --compile-setting CORE5.setting 53 | 54 | # reboot after incompatibly changing syml format 55 | reboot: six 56 | $(CP) $(GENERATE) boot 57 | $(RM_RF) boot/syml 58 | 59 | snap: all 60 | $(RM_RF) snap.new 61 | $(MKDIR) snap.new 62 | $(GIT) log -1 --pretty="format:%h" > snap.new/revision 63 | $(CP_R) $(INVARIANT) $(GENERATE) syml STD_P5.pmc lib tools/tryfile tools/teststd snap.new 64 | -$(RM_RF) snap.old 65 | -$(MV) snap snap.old 66 | $(MV) snap.new snap 67 | 68 | snaptest: snap 69 | cd snap && $(PERL) teststd $(realpath ../roast) 70 | 71 | #List all targets with brief descriptions. 72 | # Gradual shaving of targets with Occam's Razor would be a Good Thing. 73 | help: 74 | @echo 75 | @echo 'In pugs/src/perl6 you can make these targets:' 76 | @echo 77 | @echo 'six (default) builds viv for Perl6' 78 | @echo 'all builds viv for Perl5 too' 79 | @echo 'reboot builds and updates boot; test first!' 80 | @echo 'clean removes generated files' 81 | @echo 'help show this list' 82 | @echo 'snaptest run snapshot teststd on pugs/t/*' 83 | @echo 84 | -------------------------------------------------------------------------------- /NAME.pmc: -------------------------------------------------------------------------------- 1 | # NAME.pmc 2 | # 3 | # Copyright 2007-2010, Larry Wall 4 | # 5 | # You may copy this software under the terms of the Artistic License, 6 | # version 2.0 or later. 7 | 8 | use 5.010; 9 | package NAME; 10 | sub new { 11 | my $class = shift; 12 | my %attrs = @_; 13 | bless \%attrs, $class; 14 | } 15 | sub name { my $self = shift; return $self->{name} }; 16 | sub file { my $self = shift; return $self->{file} }; 17 | sub line { my $self = shift; return $self->{line} }; 18 | sub xlex { my $self = shift; return $self->{xlex} }; 19 | sub olex { my $self = shift; return $self->{olex} }; 20 | sub of { my $self = shift; return $self->{of} }; 21 | 1; 22 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | =head1 Perl 6 Parser Stuff in the Pugs Repo 2 | 3 | Welcome to pugs/src/perl6. This is the home of STD.pm6, the canonical 4 | Perl 6 grammar, which is written in Perl 6 (of course). It is also the 5 | home of viv, a retargettable Perl 6 metacompiler which can translate 6 | STD.pm6 into Perl 5 (and eventually other things). The metacompiler 7 | relies on STD.pm6 to parse itself, requiring a stored bootstrap version 8 | of the compiled STD.pm. This is also the home of Cursor, the canonical 9 | implementation of the Perl 6 rules engine; it co-evolves with viv and 10 | executes the actual rules. This is also the home of a collection of 11 | minor tools used in the development of STD.pm6 and viv. 12 | 13 | =head1 Prerequisites 14 | 15 | You'll need the following Perl bits to run stuff: 16 | 17 | * Perl 5.10.0 or later in PATH 18 | 19 | * YAML::XS (e.g. sudo apt-get install libyaml-libyaml-perl) 20 | 21 | * Moose (e.g. sudo apt-get install libmoose-perl) 22 | 23 | * File::ShareDir 24 | 25 | =head1 Running Stuff 26 | 27 | You can get started by using the Makefile command, C. This will convert 28 | the Perl 6 grammar into a Perl 5 module, C. C has a fairly simple 29 | API; just call C as a class method with the source you want to parse as 30 | a parameter, and look at the result. Another module, C, is provided 31 | which converts C's output into a more object-oriented form; see C's 32 | source for an example of the latter's use. (Both methods have more options 33 | when you need them.) 34 | 35 | The following tools are provided which leverage the power of C: 36 | 37 | * C parses a file of Perl 6 code and reports 'ok' or 'FAILED', plus the 38 | time taken and memory used. 39 | 40 | * C does the same, but also tests Actions. 41 | 42 | * C parses a file, reporting what rules matched which tokens. 43 | 44 | * C appears to be an older, non-working version of redspans. 45 | 46 | * C uses STD to check the syntax of the Perl 6 Specification Tests. 47 | 48 | * C is an interactive STD syntax checker. 49 | 50 | * C is a prototype STD-based LLVM-based Perl 6 JIT compiler. 51 | 52 | * C is a retargettable metacompiler for the static subset of Perl 6. 53 | 54 | * C is a syntax highlighter with multiple output formats. 55 | 56 | See the headers of the respective programs for more details, and don't hesitate 57 | to ask around as quite a bit of this is underdocumented. 58 | 59 | =head1 Working the Makefile 60 | 61 | To regenerate perl 5 files from perl 6 STD.pm6, STD_P5.pm6, and Cursor.pm6 62 | changes: 63 | 64 | make 65 | 66 | To do that, but without running the self test (bootstrap): 67 | 68 | make fast 69 | 70 | To remake only one file: 71 | 72 | make STD.pmc 73 | 74 | To update the first stage, allowing new STD.pm6 or Cursor.pm6 features to be 75 | used while building future versions of STD.pm6 or Cursor.pm6: 76 | 77 | make reboot 78 | 79 | To remove all generated files: 80 | 81 | make clean 82 | 83 | To test the ability to parse the Perl 6 test suite (this is a very effective 84 | regression test, but B - 20-75 minutes; also, it runs in a snapshot of 85 | the current directory, so you can continue hacking): 86 | 87 | make snaptest 88 | 89 | -------------------------------------------------------------------------------- /RE_ast.pmc: -------------------------------------------------------------------------------- 1 | # RE_ast.pmc 2 | # 3 | # Copyright 2009-2010, Larry Wall 4 | # 5 | # You may copy this software under the terms of the Artistic License, 6 | # version 2.0 or later. 7 | 8 | package main; 9 | use utf8; 10 | use strict; use warnings; 11 | use DEBUG; 12 | use Encode; 13 | 14 | # The DFA engine has two priorities; top priority is to generate the correct 15 | # pattern prefixes; second is to generate as much fate as it can. 16 | 17 | # [conjectural] 18 | # We use two data structures to represent NFAs. The NFA description tree 19 | # (NFA::* but not NFA::Node, NFA::Lazy) is statically built; it is a near 1:1 20 | # mapping of the RE_ast structure. The NFA description tree is used to 21 | # generate the NFA construction tree, which is lazily built. 22 | { 23 | package NFA::Lazy; 24 | sub new { bless [ @_ ], 'NFA::Lazy' } 25 | sub reify { 26 | my $self = shift; 27 | my ($node, $prefix, $continue) = splice @$self; 28 | bless $self, 'NFA::Node'; 29 | $node->construct($self, $prefix, $continue); 30 | } 31 | } 32 | 33 | { 34 | package NFA::Node; 35 | sub reify { } 36 | } 37 | 38 | { 39 | package NFA::seq; 40 | sub new { 41 | my ($left, $right) = @_; 42 | my $literal = $left->{literal}; 43 | my $litlen = $left->{litlen}; 44 | if ($literal) { 45 | $literal &&= $right->{literal}; 46 | $litlen += ($right->{litlen} // 0); 47 | } 48 | bless { left => $left, right => $right, literal => $literal, 49 | litlen => $litlen, fates => ($left->{fates} || $right->{fates}) }, 50 | 'NFA::seq'; 51 | } 52 | 53 | sub construct { 54 | my ($self, $node, $pre_fates, $continue) = @_; 55 | 56 | $self->{left}->construct($node, $pre_fates, sub { 57 | my $mid_fates = shift; 58 | NFA::Lazy->new($self->{right}, $mid_fates, $continue); 59 | }); 60 | } 61 | } 62 | 63 | ############################################################# 64 | # longest token set generator 65 | ############################################################# 66 | 67 | # $::DEBUG |= -1; 68 | sub qm { my $s = shift; 69 | $s = $s->[0] if ref $s eq 'ARRAY'; # only count first token of circumfix or postcircumfix 70 | my $r = ''; 71 | for (split(//,$s)) { 72 | if ($_ eq " ") { $r .= '\x20' } 73 | elsif ($_ eq "\t") { $r .= '\t' } 74 | elsif ($_ eq "\n") { $r .= '\n' } 75 | elsif ($_ =~ m/^\w$/) { $r .= $_ } 76 | elsif ($_ eq '<' | $_ eq '>') { $r .= $_ } 77 | else { $r .= '\\' . $_ } 78 | } 79 | $r; 80 | } 81 | 82 | sub here { 83 | return unless $::DEBUG & DEBUG::longest_token_pattern_generation; 84 | my $arg = shift; 85 | my $lvl = 0; 86 | while (caller($lvl)) { $lvl++ } 87 | my ($package, $file, $line, $subname, $hasargs) = caller(0); 88 | 89 | my $name = $package; # . '::' . substr($subname,1); 90 | if (defined $arg) { 91 | $name .= " " . $arg; 92 | } 93 | ::deb("\t", ':' x $lvl, ' ', $name, " [", $file, ":", $line, "]") if $::DEBUG & DEBUG::longest_token_pattern_generation; 94 | } 95 | 96 | { package nfa; 97 | 98 | # Rules: Don't call $cont more than once with the same fate. Don't instantiate 99 | # a node more than once with the same fate. 100 | sub node { 101 | my $id = @::NFANODES; 102 | #::deb("creating direct node $id") if $::DEBUG & DEBUG::longest_token_pattern_generation; 103 | push @::NFANODES, [ $id, @_ ]; 104 | $id; 105 | } 106 | 107 | sub gnode { 108 | my $id = @::NFANODES; 109 | #::deb("creating node $id via " . ref($_[0])) if $::DEBUG & DEBUG::longest_token_pattern_generation; 110 | push @::NFANODES, [ $id ]; 111 | $_[0]->construct($::NFANODES[$id], $_[1], $_[2]); 112 | $id; 113 | } 114 | 115 | sub rgnode { my ($ob, $n, $f, $c) = @_; 116 | #::deb("forwarding node " . $n->[0] . " to " . ref($ob)) if $::DEBUG & DEBUG::longest_token_pattern_generation; 117 | $ob->construct($n, $f, $c); 118 | } 119 | 120 | sub nfa::null::construct { my ($self, $node, $fate, $cont) = @_; 121 | push @$node, $cont ? (undef, undef, $cont->($fate)) : ($fate); 122 | } 123 | 124 | sub nfa::imp::construct { my ($self, $node, $fate, $cont) = @_; 125 | push @$node, $fate; 126 | } 127 | 128 | our $NULL = bless({ m => [], nr => 0, l => 1, ll => 0 }, 'nfa::null'); 129 | our $IMP = bless({ m => [], nr => 1, l => 0, ll => 0 }, 'nfa::imp'); 130 | 131 | # When a non-LTM alternation or quantifier is applied to a subregex, it becomes 132 | # impossible to control where subsequent tokens match, so we can't copy fates. 133 | sub nfa::horizon::construct { my ($self, $node, $fate, $cont) = @_; 134 | my @fate = @$fate; 135 | $fate[0] = 1; 136 | nfa::rgnode($self->{i}, $node, \@fate, $cont); 137 | } 138 | sub horizon { my ($inner) = @_; 139 | bless({ m => $inner->{m}, nr => $inner->{nr}, l => $inner->{l}, 140 | ll => $inner->{ll}, i => $inner }, 'nfa::horizon'); 141 | } 142 | 143 | sub method { my ($mp, $inner) = @_; 144 | bless({ %$inner, m => [ @{ $inner->{m} }, $mp ] }, ref($inner)); 145 | } 146 | 147 | sub noreturn { $_[0]{nr} } 148 | 149 | sub nfa::seq::construct { my ($self, $node, $fate, $cont) = @_; 150 | nfa::rgnode($self->{fst}, $node, $fate, sub { 151 | nfa::gnode($self->{snd}, $_[0], $cont) }); 152 | } 153 | sub seq { my ($fst, $snd) = @_; 154 | bless({ m => [ @{ $fst->{m} }, @{ $snd->{m} } ], 155 | nr => $fst->{nr} || $snd->{nr}, l => $fst->{l} && $snd->{l}, 156 | ll => ($fst->{l} ? $fst->{ll} + $snd->{ll} : $fst->{ll}), 157 | fst => $fst, snd => $snd }, 'nfa::seq'); 158 | } 159 | 160 | sub nfa::star::construct { my ($self, $node, $fate, $cont) = @_; 161 | my @fate = @$fate; 162 | $fate[0] = 1; 163 | push @$node, ($cont ? (undef, undef, $cont->(\@fate)) : (\@fate)), 164 | undef, nfa::gnode($self->{i}, \@fate, sub { $node->[0] }); 165 | } 166 | sub star { my ($in) = @_; 167 | bless({ m => $in->{m}, nr => 0, l => 0, ll => 0, i => $in }, 168 | 'nfa::star'); 169 | } 170 | 171 | sub nfa::opt::construct { my ($self, $node, $fate, $cont) = @_; 172 | my @fate = @$fate; 173 | $fate[0] = 1; 174 | my $end = $cont ? $cont->(\@fate) : nfa::node(\@fate); 175 | push @$node, undef, undef, $end, 176 | undef, nfa::gnode($self->{i}, \@fate, sub { $end }); 177 | } 178 | sub opt { my ($in) = @_; 179 | bless({ m => $in->{m}, nr => 0, l => 0, ll => 0, i => $in }, 180 | 'nfa::opt'); 181 | } 182 | 183 | sub nfa::ltm::construct { my ($self, $node, $fate, $cont) = @_; 184 | push @$node, undef; 185 | if ($fate->[0]) { 186 | my $end; 187 | for my $br (@{ $self->{br} }) { 188 | push @$node, undef, nfa::gnode($br->[1], $fate, 189 | sub { $end //= $cont->($fate) }); 190 | } 191 | } else { 192 | my $ix; 193 | for my $br (@{ $self->{br} }) { 194 | my @fate = @$fate; 195 | push @fate, $self->{t}, $br->[0], pack("NN", 196 | ~($br->[1]{ll}), $ix++); 197 | push @$node, undef, nfa::gnode($br->[1], \@fate, $cont); 198 | } 199 | } 200 | } 201 | sub ltm { my ($tag, @branches) = @_; 202 | my $nr = 1; 203 | my @m; 204 | for (@branches) { 205 | $nr &&= $_->[1]{nr}; 206 | push @m, @{ $_->[1]{m} }; 207 | } 208 | bless({ m => \@m, nr => $nr, l => 0, ll => 0, t => $tag, br => \@branches }, 209 | 'nfa::ltm'); 210 | } 211 | 212 | sub nfa::cclass::construct { my ($self, $node, $fate, $cont) = @_; 213 | my $end = $cont ? $cont->($fate) : nfa::node($fate); 214 | push @$node, undef, map { $_, $end } @{ $self->{t} }; 215 | } 216 | sub cclass { my @terms = @_; 217 | bless({ m => [], nr => 0, l => 0, ll => 0, t => \@terms }, 'nfa::cclass'); 218 | } 219 | 220 | sub nfa::string::construct { my ($self, $node, $fate, $cont) = @_; 221 | my ($i, $t) = @{ $self }{ 'i', 't' }; 222 | if ($t eq '') { 223 | nfa::rgnode($NULL, $node, $fate, $cont); 224 | } else { 225 | my @nexts = ((map { nfa::node() } (1 .. length($t) - 1)), 226 | ($cont ? $cont->($fate) : nfa::node($fate))); 227 | for my $ch (split //, $t) { 228 | push @$node, undef, map { [$_], $nexts[0] } 229 | ($i ? (uc($ch), lc($ch)) : $ch); 230 | $node = $::NFANODES[$nexts[0]]; 231 | shift @nexts; 232 | } 233 | } 234 | } 235 | sub string { my ($i, $text) = @_; 236 | bless({ m => [], nr => 0, l => 1, ll => length($text), i => $i, 237 | t => $text }, 'nfa::string'); 238 | } 239 | } 240 | 241 | my $IMP = $nfa::IMP; 242 | my $NULL = $nfa::NULL; 243 | 244 | { package REbase; 245 | } 246 | 247 | { package RE_ast; our @ISA = 'REbase'; 248 | sub nfa { my $self = shift; my $C = shift; 249 | ::here(); 250 | $self->{'re'}->nfa($C); 251 | } 252 | } 253 | 254 | { package RE_assertion; our @ISA = 'REbase'; 255 | sub nfa { my ($self, $C) = @_; 256 | if ($self->{assert} eq '?') { 257 | my $re = $self->{re}; 258 | return nfa::seq($re->nfa($C), $IMP); 259 | } 260 | return $NULL; 261 | } 262 | } 263 | 264 | { package RE_assertvar; our @ISA = 'REbase'; 265 | sub nfa { $IMP } 266 | } 267 | 268 | { package RE_block; our @ISA = 'REbase'; 269 | sub nfa { $IMP } 270 | } 271 | 272 | { package RE_bindvar; our @ISA = 'REbase'; 273 | sub nfa { my $self = shift; my $C = shift; ::here(); 274 | $self->{'atom'}->nfa($C); 275 | } 276 | } 277 | 278 | { package RE_bindnamed; our @ISA = 'REbase'; 279 | sub nfa { my $self = shift; my $C = shift; ::here(); 280 | $self->{'atom'}->nfa($C); 281 | } 282 | } 283 | 284 | { package RE_bindpos; our @ISA = 'REbase'; 285 | sub nfa { my $self = shift; my $C = shift; ::here(); 286 | $self->{'atom'}->nfa($C); 287 | } 288 | } 289 | 290 | { package RE_bracket; our @ISA = 'REbase'; 291 | sub nfa { my $self = shift; my $C = shift; ::here(); 292 | $self->{'re'}->nfa($C); 293 | } 294 | } 295 | 296 | { package RE_cclass; our @ISA = 'REbase'; 297 | sub _get_char { 298 | if ($_[0] =~ s/^([^\\])//s) { return ord($1) } 299 | if ($_[0] =~ s/^\\n//) { return 10 } 300 | if ($_[0] =~ s/^\\t//) { return 9 } 301 | if ($_[0] =~ s/^\\x\{(.*?)\}//s) { return hex($1); } 302 | if ($_[0] =~ s/^\\x(..)//s) { return hex($1); } 303 | if ($_[0] =~ s/^\\(.)//s) { return ord($1) } 304 | 305 | return undef; 306 | } 307 | 308 | sub nfa { my ($self, $C) = @_; ::here($self->{text}); 309 | $CursorBase::fakepos++; 310 | my $cc = $self->{'text'}; 311 | Encode::_utf8_on($cc); 312 | my ($neg, $text) = $cc =~ /^(-?)\[(.*)\]$/s; 313 | die "whoops! $cc" unless defined $text; 314 | 315 | #XXX this ought to be pre parsed 316 | my ($ch, $ch2); 317 | my @chs; 318 | while (1) { 319 | $text =~ s/^\s+//; 320 | if ($text =~ s/^\\s//) { 321 | push @chs, 'Space/Y'; 322 | next; 323 | } 324 | if ($text =~ s/^\\w//) { 325 | push @chs, '_', 'Gc/L', 'Gc/N'; 326 | next; 327 | } 328 | last if $text eq ''; 329 | $ch = _get_char($text); 330 | if ($text =~ s/^\s*\.\.//) { 331 | $ch2 = _get_char($text); 332 | } else { 333 | $ch2 = $ch; 334 | } 335 | push @chs, map { chr $_ } ($ch .. $ch2); 336 | } 337 | 338 | if ($self->{i}) { 339 | @chs = map { uc($_), lc($_) } @chs; 340 | } 341 | 342 | $neg ? nfa::cclass(['ALL', @chs]) : nfa::cclass(map { [$_] } @chs); 343 | } 344 | } 345 | 346 | { package RE_decl; our @ISA = 'REbase'; 347 | sub nfa { $NULL } 348 | } 349 | 350 | { package RE_double; our @ISA = 'REbase'; 351 | # XXX inadequate for "\n" without interpolation 352 | sub nfa { my ($self, $C) = @_; 353 | my $text = $self->{'text'}; 354 | Encode::_utf8_on($text); 355 | ::here($text); 356 | $Cursor::fakepos++ if $text ne ''; 357 | my ($fixed, $imp); 358 | if ( $text =~ /^(.*?)[\$\@\%\&\{]/ ) { 359 | $fixed = $1; $imp = 1; 360 | } 361 | else { 362 | $fixed = $text; 363 | } 364 | $fixed = nfa::string($self->{i}, $fixed); 365 | $fixed = nfa::seq($fixed, $IMP) if $imp; 366 | $fixed; 367 | } 368 | } 369 | 370 | { package RE_meta; our @ISA = 'REbase'; 371 | my %meta_nfa = ( 372 | # XXX I don't think these are quite right 373 | '^' => $NULL, '^^' => $NULL, '$$' => $NULL, '$' => $NULL, 374 | '«' => $NULL, '<<' => $NULL, '>>' => $NULL, '»' => $NULL, 375 | # what? 376 | '\\\\' => nfa::cclass(['\\']), 377 | '\\"' => nfa::cclass(['"']), 378 | '\\\'' => nfa::cclass(["'"]), 379 | '\D' => nfa::cclass(['ALL', 'Gc/N']), 380 | '\d' => nfa::cclass(['Gc/N']), 381 | '\H' => nfa::cclass(['ALL', 'Perl/Blank']), 382 | '\h' => nfa::cclass(['Perl/Blank'], ["\015"]), 383 | '\N' => nfa::cclass(['ALL', "\n"]), 384 | '\n' => nfa::cclass(["\n"]), 385 | '\S' => nfa::cclass(['ALL', 'Space/Y']), 386 | '\s' => nfa::cclass(['Space/Y']), 387 | '\V' => nfa::cclass(['ALL', 'Perl/VertSpac']), 388 | '\v' => nfa::cclass(['Perl/VertSpac']), 389 | '\W' => nfa::cclass(['ALL', '_', 'Gc/L', 'Gc/N']), 390 | '\w' => nfa::cclass(['_'], ['Gc/L'], ['Gc/N']), 391 | '.' => nfa::cclass(['ALL']), 392 | '::' => $IMP, 393 | ':::' => $IMP, 394 | '.*?' => $IMP, 395 | '.*' => nfa::star(nfa::cclass(['ALL'])), 396 | ); 397 | 398 | sub nfa { my $self = shift; my ($C) = @_; 399 | my $text = $self->{'text'}; 400 | Encode::_utf8_on($text); 401 | ::here($text); 402 | return $meta_nfa{$text} // die "unhandled meta $text"; 403 | } 404 | } 405 | 406 | { package RE_method; our @ISA = 'REbase'; 407 | sub nfa { my ($self, $C) = @_; 408 | my $name = $self->{'name'}; 409 | return $IMP if $self->{'rest'}; 410 | Encode::_utf8_on($name); 411 | ::here($name); 412 | 413 | if ($name eq 'null' or $name eq 'ww') { return $NULL } 414 | if ($name eq 'ws') { return $IMP; } 415 | if ($name eq 'alpha') { $CursorBase::fakepos++; return nfa::cclass(['_'], ['Gc/L']); } 416 | if ($name eq 'sym') { 417 | $CursorBase::fakepos++; 418 | my $sym = $self->{'sym'}; 419 | Encode::_utf8_on($sym); 420 | return nfa::string($self->{i}, $sym); 421 | } 422 | 423 | # XXX 424 | $name = 'termish' if $name eq 'EXPR'; 425 | 426 | my $mname = $name . '__PEEK'; 427 | my $lexer = $C->can($mname) ? $C->$mname()->{NFAT} : $IMP; 428 | return nfa::method($name, $lexer); 429 | } 430 | } 431 | 432 | { package RE_method_internal; our @ISA = 'REbase'; 433 | sub nfa { $IMP } 434 | } 435 | 436 | { package RE_method_re; our @ISA = 'REbase'; 437 | sub nfa { my ($self, $C) = @_; 438 | my $name = $self->{name}; 439 | Encode::_utf8_on($name); 440 | ::here($name); 441 | my $re = $self->{re}; 442 | if ($name eq '') { 443 | return $IMP; 444 | } elsif ($name eq 'after') { 445 | return $NULL; 446 | } elsif ($name eq 'before') { 447 | return nfa::seq($re->nfa($C), $IMP); 448 | } else { 449 | my $mname = $name . '__PEEK'; 450 | my $lexer = $C->can($mname) ? $C->$mname($re) : $IMP; 451 | return nfa::method($name, $lexer->{NFAT}); 452 | } 453 | } 454 | } 455 | 456 | { package RE_noop; our @ISA = 'REbase'; 457 | sub nfa { $NULL } 458 | } 459 | 460 | { package RE_every; our @ISA = 'REbase'; 461 | sub nfa { $IMP } 462 | } 463 | 464 | { package RE_first; our @ISA = 'REbase'; 465 | sub nfa { my ($self, $C) = @_; 466 | my $alts = $self->{'zyg'}; 467 | ::here(0+@$alts); 468 | nfa::horizon($alts->[0]->nfa($C)); 469 | } 470 | } 471 | 472 | { package RE_paren; our @ISA = 'REbase'; 473 | sub nfa { my $self = shift; my $C = shift; ::here(); 474 | $self->{'re'}->nfa($C); 475 | } 476 | } 477 | 478 | { package RE_quantified_atom; our @ISA = 'REbase'; 479 | sub nfa { my ($self, $C) = @_; ::here(); 480 | my $oldfakepos = $CursorBase::fakepos++; 481 | my $subnfa = $self->{atom}->nfa($C); 482 | #return $IMP if $self->{quant}[1]; XXX viv omits this currently 483 | # XXX S05 is not quite clear; it could be read as saying to cut LTM 484 | # *after* the atom 485 | return $IMP if $self->{quant}[2] 486 | && $self->{quant}[2]->isa('RE_block'); 487 | 488 | my $k = $self->{quant}[0]; 489 | if ($k eq '?') { 490 | return nfa::opt($subnfa); 491 | } elsif ($k eq '*') { 492 | return nfa::star($subnfa); 493 | } elsif ($k eq '+') { 494 | return nfa::seq($subnfa, nfa::star($subnfa)); 495 | } elsif ($k eq '**') { 496 | my $subnfa2 = $self->{quant}[2]->nfa($C); 497 | return nfa::seq($subnfa, nfa::star(nfa::seq($subnfa2, $subnfa))); 498 | } else { 499 | die "unknown quantifier $k"; 500 | } 501 | } 502 | } 503 | 504 | { package RE_qw; our @ISA = 'REbase'; 505 | sub nfa { my ($self, $C) = @_; 506 | my $text = $self->{'text'}; 507 | Encode::_utf8_on($text); 508 | ::here($text); 509 | $CursorBase::fakepos++; 510 | $text =~ s/^<\s*//; 511 | $text =~ s/\s*>$//; 512 | 513 | nfa::horizon(nfa::ltm("", map { ["", nfa::string($self->{i}, $_)] } split(/\s+/, $text))); 514 | } 515 | } 516 | 517 | { package RE_sequence; our @ISA = 'REbase'; 518 | sub nfa { my ($self, $C) = @_; ::here; 519 | my @zyg; 520 | for my $k (@{ $self->{zyg} }) { 521 | push @zyg, $k->nfa($C); 522 | last if nfa::noreturn($zyg[-1]); 523 | } 524 | push @zyg, $NULL if !@zyg; 525 | while (@zyg > 1) { 526 | push @zyg, nfa::seq(splice(@zyg, -2, 2)); 527 | } 528 | $zyg[0]; 529 | } 530 | } 531 | 532 | { package RE_string; our @ISA = 'REbase'; 533 | sub nfa { my ($self, $C) = @_; 534 | my $text = $self->{'text'}; 535 | Encode::_utf8_on($text); 536 | ::here($text); 537 | $CursorBase::fakepos++ if $text ne ''; 538 | nfa::string($self->{i}, $text); 539 | } 540 | } 541 | 542 | { package RE_submatch; our @ISA = 'REbase'; 543 | sub nfa { $IMP } 544 | } 545 | 546 | { package RE_all; our @ISA = 'REbase'; 547 | sub nfa { $IMP } 548 | } 549 | 550 | { package RE_any; our @ISA = 'REbase'; 551 | sub nfa { my $self = shift; my ($C) = @_; 552 | my $alts = $self->{'zyg'}; 553 | ::here(0+@$alts); 554 | my @outs; 555 | my $oldfakepos = $CursorBase::fakepos; 556 | my $minfakepos = $CursorBase::fakepos + 1; 557 | my $ix = 0; 558 | 559 | for my $alt (@$alts) { 560 | $CursorBase::fakepos = $oldfakepos; 561 | 562 | push @outs, [ $ix++, $alt->nfa($C) ]; 563 | 564 | $minfakepos = $oldfakepos if $CursorBase::fakepos == $oldfakepos; 565 | } 566 | $CursorBase::fakepos = $minfakepos; # Did all branches advance? 567 | nfa::ltm($self->{altname}, @outs); 568 | } 569 | } 570 | 571 | { package RE_var; our @ISA = 'REbase'; 572 | sub nfa { my ($self, $C) = @_; 573 | my $var = $self->{var}; 574 | if (my $p = $C->_PARAMS) { 575 | my $text = $p->{$var} || return $IMP; 576 | $CursorBase::fakepos++ if length($text); 577 | return nfa::string($self->{i}, $text); 578 | } 579 | return $IMP; 580 | } 581 | } 582 | 583 | 1; 584 | -------------------------------------------------------------------------------- /STD.pm: -------------------------------------------------------------------------------- 1 | #This file was renamed to STD.pm6 recently, but not all the links in the world have caught up. 2 | #Apparently yours is one of those... 3 | die "Did you run make in src/perl6?"; 4 | -------------------------------------------------------------------------------- /Stash.pmc: -------------------------------------------------------------------------------- 1 | # Stash.pmc 2 | # 3 | # Copyright 2009-2010, Larry Wall 4 | # 5 | # You may copy this software under the terms of the Artistic License, 6 | # version 2.0 or later. 7 | 8 | use 5.010; 9 | package Stash; 10 | sub new { 11 | my $class = shift; 12 | my %attrs = @_; 13 | bless \%attrs, $class; 14 | } 15 | sub idref { return $_[0]->{'!id'} }; 16 | sub id { return $_[0]->{'!id'}->[0] // '???' }; 17 | sub file { return $_[0]->{'!file'} }; 18 | sub line { return $_[0]->{'!line'} }; 19 | 1; 20 | -------------------------------------------------------------------------------- /boot/Cursor.pmc: -------------------------------------------------------------------------------- 1 | use v5.14; 2 | use utf8; 3 | use CursorBase; 4 | { package Cursor; 5 | use Moose ':all' => { -prefix => "moose_" }; 6 | use Encode; 7 | moose_extends('CursorBase'); 8 | our $ALLROLES = { 'Cursor', 1 }; 9 | our $REGEXES = { 10 | ALL => [ qw// ], 11 | }; 12 | 13 | 14 | no warnings 'qw', 'recursion'; 15 | my $retree; 16 | 17 | $DB::deep = $DB::deep = 1000; # suppress used-once warning 18 | 19 | use YAML::XS; 20 | 21 | ; 22 | our $BLUE = $CursorBase::BLUE; 23 | our $GREEN = $CursorBase::GREEN; 24 | our $CYAN = $CursorBase::CYAN; 25 | our $MAGENTA = $CursorBase::MAGENTA; 26 | our $YELLOW = $CursorBase::YELLOW; 27 | our $RED = $CursorBase::RED; 28 | our $CLEAR = $CursorBase::CLEAR; 29 | ## method panic (Str $s) 30 | sub panic { 31 | no warnings 'recursion', 'experimental'; 32 | my $self = shift; 33 | die 'Required argument s omitted' unless @_; 34 | my $s = @_ ? shift() : undef; 35 | $self->deb("panic $s") if $::DEBUG; 36 | my $m; 37 | my $here = $self; 38 | $m .= $s; 39 | $m .= $here->locmess; 40 | $m .= "\n" unless $m =~ /\n$/; 41 | print STDERR $Cursor::RED, '===', $Cursor::CLEAR, 'SORRY!', $Cursor::RED, '===', $Cursor::CLEAR, "\n"; 42 | print STDERR $m; 43 | die "Parse failed\n"; 44 | }; 45 | ## method worry (Str $s) 46 | sub worry { 47 | no warnings 'recursion', 'experimental'; 48 | my $self = shift; 49 | die 'Required argument s omitted' unless @_; 50 | my $s = @_ ? shift() : undef; 51 | my $m = $s . $self->locmess; 52 | push @::WORRIES, $m unless $::WORRIES{$s}++; 53 | $self; 54 | }; 55 | ## method sorry (Str $s) 56 | sub sorry { 57 | no warnings 'recursion', 'experimental'; 58 | my $self = shift; 59 | die 'Required argument s omitted' unless @_; 60 | my $s = @_ ? shift() : undef; 61 | $self->deb("sorry $s") if $::DEBUG; 62 | print STDERR $Cursor::RED, '===', $Cursor::CLEAR, 'SORRY!', $Cursor::RED, '===', $Cursor::CLEAR, "\n" 63 | unless $::IN_SUPPOSE or $::FATALS++; 64 | if ($s) { 65 | my $m = $s; 66 | $m .= $self->locmess . "\n" unless $m =~ /\n$/; 67 | if ($::FATALS > 10 or $::IN_SUPPOSE) { 68 | die $m} 69 | else { 70 | print STDERR $m unless $::WORRIES{$m}++}; 71 | }; 72 | $self; 73 | }; 74 | ## method locmess () 75 | sub locmess { 76 | no warnings 'recursion', 'experimental'; 77 | my $self = shift; 78 | my $pos = $self->{'_pos'}; 79 | my $line = $self->lineof($pos); 80 | if ($pos >= @::MEMOS - 1) { 81 | $pos = $pos - 1; 82 | $line = $line . " (EOF)"; 83 | }; 84 | my $pre = substr($::ORIG, 0, $pos); 85 | $pre = substr($pre, -40, 40); 86 | 1 while $pre =~ s!.*\n!!; 87 | $pre = '' if $pre eq ''; 88 | my $post = substr($::ORIG, $pos, 40); 89 | 1 while $post =~ s!(\n.*)!!; 90 | $post = '' if $post eq ''; 91 | " at " . $::FILE->{'name'} . " line $line:\n------> " . $Cursor::GREEN . $pre . $Cursor::YELLOW . $::PERL6HERE . $Cursor::RED . 92 | "$post$Cursor::CLEAR"; 93 | }; 94 | ## method line 95 | sub line { 96 | no warnings 'recursion', 'experimental'; 97 | my $self = shift; 98 | $self->lineof($self->{'_pos'})}; 99 | ## method lineof ($p) 100 | sub lineof { 101 | no warnings 'recursion', 'experimental'; 102 | my $self = shift; 103 | die 'Required argument p omitted' unless @_; 104 | my $p = @_ ? shift() : undef; 105 | return 1 unless defined $p; 106 | my $line = $::MEMOS[$p]->{'L'}; 107 | return $line if $line; 108 | $line = 0; 109 | my $pos = 0; 110 | my @text = split(/^/,$::ORIG); 111 | for (@text) { 112 | $line++; 113 | $::MEMOS[$pos++]->{'L'} = $line 114 | for 1 .. length($_); 115 | } 116 | ; 117 | $::MEMOS[$pos++]->{'L'} = $line; 118 | return $::MEMOS[$p]->{'L'} // 0; 119 | }; 120 | ## method SETGOAL 121 | sub SETGOAL { 122 | no warnings 'recursion', 'experimental'; 123 | my $self = shift; 124 | }; 125 | ## method FAILGOAL (Str $stop, Str $name, $startpos) 126 | sub FAILGOAL { 127 | no warnings 'recursion', 'experimental'; 128 | my $self = shift; 129 | die 'Required argument stop omitted' unless @_; 130 | my $stop = @_ ? shift() : undef; 131 | die 'Required argument name omitted' unless @_; 132 | my $name = @_ ? shift() : undef; 133 | die 'Required argument startpos omitted' unless @_; 134 | my $startpos = @_ ? shift() : undef; 135 | my $s = "'$stop'"; 136 | $s = '"\'"' if $s eq "'''"; 137 | $self->panic("Unable to parse $name" . $startpos->locmess . "\nCouldn't find final $s; gave up"); 138 | }; 139 | 1; }; 140 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = STD 2 | license = Artistic_2_0 3 | version = 20101111 4 | 5 | author = Larry Wall 6 | author = Stefan O'Rear 7 | author = Pawel Murias 8 | copyright_holder = Larry Wall 9 | abstract = The Standard Perl 6 Grammar 10 | 11 | [ShareDir] 12 | dir = data 13 | [MetaYAML] 14 | [ModuleBuild] 15 | mb_class = MyBuilder 16 | [Manifest] 17 | [STD] 18 | [ExecDir] 19 | dir = bin 20 | [Prereq] 21 | File::ShareDir = 1.02 22 | Moose = 0 23 | YAML::XS = 0 24 | perl = v5.10 25 | [PruneCruft] 26 | [License] 27 | [UploadToCPAN] 28 | -------------------------------------------------------------------------------- /inc/MyBuilder.pm: -------------------------------------------------------------------------------- 1 | package MyBuilder; 2 | use base 'Module::Build'; 3 | 4 | use warnings; 5 | use strict; 6 | 7 | 8 | use v5.10; 9 | 10 | sub new { 11 | my ($self,@args) = @_; 12 | $self->SUPER::new('pm_files'=>{map {$_ => $_} grep {! -d $_} ,},@args); 13 | } 14 | 1; 15 | -------------------------------------------------------------------------------- /lib/DEBUG.pm6: -------------------------------------------------------------------------------- 1 | my module DEBUG; 2 | constant autolexer is export = 1; 3 | constant symtab is export = 2; 4 | constant fixed_length is export = 4; 5 | constant fates is export = 8; 6 | constant longest_token_pattern_generation is export = 16; 7 | constant EXPR is export = 32; 8 | constant matchers is export = 64; 9 | constant trace_call is export = 128; 10 | constant cursors is export = 256; 11 | constant try_processing is export = 1024; 12 | constant mixins is export = 2048; 13 | constant callm_show_subnames is export = 16384; 14 | constant use_color is export = 32768; 15 | 16 | -------------------------------------------------------------------------------- /lib/FindBin.pm6: -------------------------------------------------------------------------------- 1 | my module FindBin; 2 | -------------------------------------------------------------------------------- /lib/MONKEY_TYPING.pm6: -------------------------------------------------------------------------------- 1 | module MONKEY_TYPING; 2 | -------------------------------------------------------------------------------- /lib/NAME.pm6: -------------------------------------------------------------------------------- 1 | my class NAME; 2 | -------------------------------------------------------------------------------- /lib/Stash.pm6: -------------------------------------------------------------------------------- 1 | my class Stash; 2 | -------------------------------------------------------------------------------- /lib/Test.pm6: -------------------------------------------------------------------------------- 1 | class Test; 2 | proto plan is export {*} 3 | proto done is export {*} 4 | proto is is export {*} 5 | proto ok is export {*} 6 | proto nok is export {*} 7 | proto dies_ok is export {*} 8 | proto lives_ok is export {*} 9 | proto skip is export {*} 10 | proto todo is export {*} 11 | proto pass is export {*} 12 | proto flunk is export {*} 13 | proto force_todo is export {*} 14 | proto use_ok is export {*} 15 | proto isa_ok is export {*} 16 | proto cmp_ok is export {*} 17 | proto diag is export {*} 18 | proto is_deeply is export {*} 19 | proto isnt is export {*} 20 | proto like is export {*} 21 | proto unlike is export {*} 22 | proto skip_rest is export {*} 23 | proto eval_dies_ok is export {*} 24 | proto eval_lives_ok is export {*} 25 | proto approx is export {*} 26 | proto is_approx is export {*} 27 | proto throws_ok is export {*} 28 | proto version_lt is export {*} 29 | -------------------------------------------------------------------------------- /lib/class.pm6: -------------------------------------------------------------------------------- 1 | my module class; 2 | -------------------------------------------------------------------------------- /lib/fatal.pm6: -------------------------------------------------------------------------------- 1 | my module fatal; 2 | -------------------------------------------------------------------------------- /lib/lib.pm6: -------------------------------------------------------------------------------- 1 | my module lib; 2 | -------------------------------------------------------------------------------- /lib/oo.pm6: -------------------------------------------------------------------------------- 1 | my module oo; 2 | -------------------------------------------------------------------------------- /mangle.pl: -------------------------------------------------------------------------------- 1 | package main; 2 | use utf8; 3 | 4 | sub mangle { 5 | my @list = @_; 6 | for (@list) { 7 | s/\`/Grave/g; 8 | s/\~/Tilde/g; 9 | s/\!/Bang/g; 10 | s/\@/At/g; 11 | s/\#/Sharp/g; 12 | s/\$/Dollar/g; 13 | s/\%/Percent/g; 14 | s/\^/Caret/g; 15 | s/\&/Amp/g; 16 | s/\*/Star/g; 17 | s/\(/Paren/g; 18 | s/\)/Thesis/g; 19 | s/\-/Minus/g; 20 | s/\+/Plus/g; 21 | s/\=/Equal/g; 22 | s/\{/Cur/g; 23 | s/\}/Ly/g; 24 | s/\[/Bra/g; 25 | s/\]/Ket/g; 26 | s/\|/Vert/g; 27 | s/\\/Back/g; 28 | s/\:/Colon/g; 29 | s/\;/Semi/g; 30 | s/\'/Single/g; 31 | s/\"/Double/g; 32 | s/\/Gt/g; 34 | s/\«/Fre/g; 35 | s/\»/Nch/g; 36 | s/\,/Comma/g; 37 | s/\./Dot/g; 38 | s/\?/Question/g; 39 | s/\//Slash/g; 40 | s/([^a-zA-Z_0-9])/sprintf("_%02x_",ord($1))/eg; 41 | } 42 | join '_', @list; 43 | } 44 | 1; 45 | -------------------------------------------------------------------------------- /std_hilite/STD_syntax_highlight: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | # Core modules 4 | use strict; 5 | use warnings; 6 | use utf8; 7 | use feature qw(say switch); 8 | use English; 9 | use Getopt::Long; 10 | use lib '..'; 11 | 12 | # CPAN modules 13 | use File::Slurp; 14 | use Term::ANSIColor; 15 | use YAML::Dumper; 16 | 17 | # And finally our modules 18 | use STD; 19 | 20 | =head1 NAME 21 | 22 | STD_syntax_highlight - Highlights Perl 6 source code using STD.pm 23 | 24 | =head1 SYNOPSIS 25 | 26 | # read from standard input 27 | STD_syntax_highlight 28 | 29 | # print ansi-escaped text for 'TOP' 30 | STD_syntax_highlight foo.pl 31 | 32 | # print separate html, css and javascript files 33 | STD_syntax_highlight --full-html=foo.full.html --clean-html foo.pl 34 | 35 | # print ansi-escaped text for with 'statementlist' as the top-level rule 36 | STD_syntax_highlight foo.pl statementlist 37 | 38 | # write simple html output to foo.pl.html 39 | STD_syntax_highlight --simple-html=foo.pl.html foo.pl 40 | 41 | # write simple snippet html output to foo.pl.html 42 | STD_syntax_highlight --snippet-html=foo.pl.html foo.pl 43 | 44 | # write simple ansi-colored output to STDOUT 45 | STD_syntax_highlight --ansi-text=- foo.pl 46 | 47 | # write output with mIRC color codes to STDOUT 48 | STD_syntax_highlight --mirc-text=- foo.pl 49 | 50 | # write yaml output to STDOUT (can be useful to build filters) 51 | STD_syntax_highlight --yaml=- foo.pl 52 | =head1 SUBROUTINES 53 | 54 | =over 55 | 56 | =cut 57 | 58 | my ($clean_html,$help) = (0,0); 59 | my ($full_html,$simple_html,$snippet_html,$ansi_text,$mirc_text,$yaml) 60 | = (0,0,0,0,0,0); 61 | my ($file, $parser, $src_text); 62 | 63 | # These are needed for redspans 64 | my @loc; 65 | 66 | =item main 67 | 68 | Your standard main method 69 | =cut 70 | sub main { 71 | #process the command line 72 | GetOptions( 73 | "clean-html"=>\$clean_html, 74 | "full-html=s"=>\$full_html, 75 | "simple-html=s"=>\$simple_html, 76 | "snippet-html=s"=>\$snippet_html, 77 | "ansi-text=s"=>\$ansi_text, 78 | "mirc-text=s"=>\$mirc_text, 79 | "yaml=s"=>\$yaml, 80 | "help"=>\$help 81 | ); 82 | 83 | if ($help) { 84 | die <<"HELP"; 85 | USAGE: 86 | $PROGRAM_NAME [options] [file] [rule] 87 | 88 | where 'file' is optional; if omitted or is '-' then 89 | STDIN will be used. And 'options' can be one of the following: 90 | 91 | --clean-html 92 | generates separate html,css and javascript 93 | 94 | --full-html=filename 95 | write full-mode html to filename (- for STDOUT) 96 | 97 | --simple-html=filename 98 | write simple-mode html to filename (- for STDOUT) 99 | 100 | --snippet-html=filename 101 | This is typically ideal for inline html code. (- for STDOUT) 102 | 103 | --ansi-text=filename 104 | write simple-mode ansi color text to filename (- for STDOUT) 105 | 106 | --yaml=filename 107 | writes a dump of redspans to filename (- for STDOUT) 108 | HELP 109 | } 110 | 111 | #default is --simple-html=- if no option is selected 112 | if(!($simple_html || $full_html || $snippet_html || $yaml) && !$ansi_text && !$mirc_text) { 113 | $ansi_text = '-'; 114 | } 115 | 116 | #start parsing... 117 | $file = shift @ARGV; 118 | my $what = shift @ARGV // 'TOP'; 119 | 120 | my $fh; 121 | #what is the meaning of your input file? 122 | if(!$file || $file eq '-') { 123 | # i think you mean standard input 124 | $fh = \*STDIN; # Cursor already set encoding 125 | } else { 126 | # no it is should be a file, let me check 127 | unless(open $fh, '<:utf8', $file) { 128 | die "Could not open '$file' for reading\n"; 129 | } 130 | } 131 | 132 | # slurp the file for parsing and redspans 133 | $src_text = read_file($fh); 134 | $loc[length($src_text) - 1] = []; 135 | $parser = STD->parse($src_text,rule=>$what,actions => 'Actions', syml_search_path => ['.','..']); 136 | 137 | # and finally print out the html code 138 | highlight_match(); 139 | } 140 | 141 | =item write_output 142 | 143 | Writes the output to a file or STDOUT 144 | =cut 145 | sub write_output { 146 | my ($file, $output) = @ARG; 147 | if($file eq '-') { 148 | say $output; 149 | } else { 150 | use open OUT => ':utf8'; 151 | open FILE, ">$file" or 152 | die "Cannot open $file for writing: $OS_ERROR\n"; 153 | say FILE $output; 154 | close FILE; 155 | } 156 | } 157 | 158 | =item highlight_match 159 | 160 | Returns the generated Perl6 highlighted HTML from C 161 | subroutine using redspans. 162 | =cut 163 | sub highlight_match { 164 | if($full_html) { 165 | my $html = highlight_perl6_full(); 166 | write_output $full_html, $html; 167 | } 168 | if($simple_html) { 169 | my $html = highlight_perl6_simple(); 170 | write_output $simple_html, $html; 171 | } 172 | if($snippet_html) { 173 | my $html = highlight_perl6_snippet_html(); 174 | write_output $snippet_html, $html; 175 | } 176 | if($ansi_text) { 177 | my $text = highlight_perl6_ansi(); 178 | write_output $ansi_text, $text; 179 | } 180 | if($mirc_text) { 181 | my $text = highlight_perl6_mirc(); 182 | write_output $mirc_text, $text; 183 | } 184 | if($yaml) { 185 | my $text = highlight_perl6_yaml(); 186 | write_output $yaml, $text; 187 | } 188 | } 189 | 190 | =item highlight_perl6_full 191 | 192 | Generates the Perl6 highlighted HTML string for STD parse tree provided. 193 | The resources can be inlined (by default) or externalized (--clean-html). 194 | =cut 195 | sub highlight_perl6_full { 196 | my $str = ""; 197 | 198 | # slurp libraries and javascript to inline them 199 | my ($JQUERY_JS,$JS,$CSS) = ( 200 | 'jquery-1.4.2.min.js', 201 | 'STD_syntax_highlight.js', 202 | 'STD_syntax_highlight.css'); 203 | my %colors = (); 204 | my $line; 205 | open CSS_FILE, "std_hilite/$CSS" 206 | or die "Could not open $CSS: $OS_ERROR\n"; 207 | while($line = ) { 208 | if($line =~ /^\s*\.(\w+)\s*{\s*color\s*:\s*(\w+)/) { 209 | $colors{$1} = $2; 210 | } 211 | } 212 | close CSS_FILE; 213 | 214 | my $jquery_js = qq{}; 215 | my $js = qq{}; 216 | my $css = qq{}; 217 | if(!$clean_html) { 218 | $jquery_js = read_file("std_hilite/$JQUERY_JS") 219 | or die "Error while slurping file: $OS_ERROR\n"; 220 | $js = read_file("std_hilite/$JS") 221 | or die "Error while slurping file: $OS_ERROR\n"; 222 | $css = read_file("std_hilite/$CSS") 223 | or die "Error while slurping file: $OS_ERROR\n"; 224 | $jquery_js = qq{}; 225 | $js = qq{}; 226 | $css = qq{}; 227 | } 228 | 229 | my $timestamp = localtime; 230 | $str .= <<"HTML"; 231 | 232 | 233 | $file 234 | 237 | 238 | $css 239 | $jquery_js 240 | $js 241 | 242 | 243 |
244 | 245 | 246 | 247 |
248 |
249 | 
250 | HTML
251 | 
252 |     local *spit_full_html = sub {
253 |         my ($i, $buffer, $rule, $tree) = @ARG;
254 |         $buffer = escape_html($buffer);
255 |         $str .= qq{};
256 |         if($rule) {
257 |             $str .= qq{$buffer};
258 |         } else {
259 |             $str .= $buffer;
260 |         }
261 |     };
262 | 
263 |     redspans_traverse(\&spit_full_html,%colors); 
264 | 
265 |     $str .= <<"HTML";
266 |
267 | 268 | 269 | HTML 270 | 271 | $str; 272 | } 273 | 274 | =item highlight_perl6_simple 275 | 276 | This is same as C when --simple-html is used. 277 | No more javascript tree viewer or anything fancy. 278 | Only nodes that have a color are printed. Not optimal but works ;-) 279 | =cut 280 | sub highlight_perl6_simple { 281 | my $str = ""; 282 | my %colors = (); 283 | 284 | my $CSS = "STD_syntax_highlight.css"; 285 | open CSS_FILE, "std_hilite/$CSS" 286 | or die "Could not open $CSS: $OS_ERROR\n"; 287 | my $line; 288 | while($line = ) { 289 | if($line =~ /^\s*\.(\w+)\s*{\s*color\s*:\s*(\w+)/) { 290 | $colors{$1} = $2; 291 | } 292 | } 293 | close CSS_FILE; 294 | 295 | # slurp css inline it 296 | my $css = qq{}; 297 | if(!$clean_html) { 298 | $css = read_file("std_hilite/$CSS") 299 | or die "Error while slurping file: $OS_ERROR\n"; 300 | $css = qq{}; 301 | } 302 | 303 | my $timestamp = localtime; 304 | $str .= <<"HTML"; 305 | 306 | 307 | $file 308 | 311 | $css 312 | 313 | 314 | 
315 | HTML
316 | 
317 |     local *spit_simple_html = sub {
318 |         my ($i, $buffer, $rule, $tree) = @ARG;
319 |         $buffer = escape_html($buffer);
320 |         if($rule) {
321 |             $str .= qq{$buffer};
322 |         } else {
323 |             $str .= $buffer;
324 |         }
325 |     };
326 | 
327 |     redspans_traverse(\&spit_simple_html,%colors); 
328 | 
329 |     $str .= <<"HTML";
330 |
331 | 332 | 333 | HTML 334 | 335 | $str; 336 | } 337 | 338 | =item highlight_perl6_snippet_html 339 | 340 | This is same as C when --snippet-html is used. 341 | No more javascript tree viewer or anything fancy. 342 | Only nodes that have a color are printed. Not optimal but works ;-) 343 | =cut 344 | sub highlight_perl6_snippet_html { 345 | my $str = ""; 346 | my %colors = (); 347 | 348 | my $CSS = "STD_syntax_highlight.css"; 349 | open CSS_FILE, "std_hilite/$CSS" 350 | or die "Could not open $CSS: $OS_ERROR\n"; 351 | my $line; 352 | while($line = ) { 353 | if($line =~ /^\s*\.(\w+)\s*{\s*(.+?)\s*}/) { 354 | $colors{$1} = $2; 355 | } 356 | } 357 | close CSS_FILE; 358 | 359 | $str .= "
";
360 | 
361 |     local *spit_snippet_html = sub {
362 |         my ($i, $buffer, $rule, $tree) = @ARG;
363 |         $buffer = escape_html($buffer);
364 |         my $style = $colors{$rule};
365 |         if($rule) {
366 |             $str .= qq{$buffer};
367 |         } else {
368 |             $str .= $buffer;
369 |         }
370 |     };
371 | 
372 |     redspans_traverse(\&spit_snippet_html,%colors); 
373 | 
374 |     $str .= "
"; 375 | 376 | $str; 377 | } 378 | 379 | 380 | =item highlight_perl6_ansi 381 | 382 | This is same as C when --ansi-text is used. 383 | No more javascript tree viewer or anything fancy. 384 | Only nodes that have a color are printed. Not optimal but works ;-) 385 | =cut 386 | sub highlight_perl6_ansi { 387 | my $str = ""; 388 | my %colors = (); 389 | 390 | my $ANSI = "STD_syntax_highlight.ansi"; 391 | open ANSI_FILE, $ANSI 392 | or die "Could not open $ANSI: $OS_ERROR\n"; 393 | my $line; 394 | while($line = ) { 395 | if($line =~ /^(\w+)=(.+)$/) { 396 | $colors{$1} = $2; 397 | } 398 | } 399 | close ANSI_FILE; 400 | 401 | local *spit_ansi_text = sub { 402 | my ($i, $buffer, $rule, $tree) = @ARG; 403 | if($rule) { 404 | my $color = $colors{$rule}; 405 | $str .= (color $color) . $buffer. (color 'reset'); 406 | } else { 407 | $str .= $buffer; 408 | } 409 | }; 410 | 411 | redspans_traverse(\&spit_ansi_text,%colors); 412 | 413 | $str; 414 | } 415 | 416 | 417 | =item highlight_perl6_mirc 418 | 419 | This is same as C when --mirc-text is used. 420 | No more javascript tree viewer or anything fancy. 421 | Only nodes that have a color are printed. Not optimal but works ;-) 422 | =cut 423 | sub highlight_perl6_mirc { 424 | my $str = ""; 425 | my %colors = (); 426 | 427 | require String::IRC; 428 | 429 | my $MIRC = "STD_syntax_highlight.mirc"; 430 | open MIRC_FILE, $MIRC 431 | or die "Could not open $MIRC: $OS_ERROR\n"; 432 | my $line; 433 | while($line = ) { 434 | if($line =~ /^(\w+)=(.+)$/) { 435 | $colors{$1} = $2; 436 | } 437 | } 438 | close MIRC_FILE; 439 | 440 | local *spit_mirc_text = sub { 441 | my ($i, $buffer, $rule, $tree) = @ARG; 442 | if($rule) { 443 | my $color = $colors{$rule}; 444 | $str .= String::IRC->new($buffer)->$color; 445 | } else { 446 | $str .= $buffer; 447 | } 448 | }; 449 | 450 | redspans_traverse(\&spit_mirc_text,%colors); 451 | 452 | $str; 453 | } 454 | 455 | 456 | =item highlight_perl6_yaml 457 | 458 | Spits out YAML that can be useful for the future 459 | =cut 460 | sub highlight_perl6_yaml { 461 | my $str = ""; 462 | my %colors = (); 463 | 464 | my $ANSI = "STD_syntax_highlight.ansi"; 465 | open ANSI_FILE, $ANSI 466 | or die "Could not open $ANSI: $OS_ERROR\n"; 467 | my $line; 468 | while($line = ) { 469 | if($line =~ /^(\w+)=(.+)$/) { 470 | $colors{$1} = $2; 471 | } 472 | } 473 | close ANSI_FILE; 474 | 475 | my @yaml = (); 476 | local *spit_yaml = sub { 477 | push @yaml, @ARG; 478 | }; 479 | 480 | redspans_traverse(\&spit_yaml,%colors); 481 | 482 | my $dumper = YAML::Dumper->new; 483 | $dumper->indent_width(4); 484 | $str .= $dumper->dump(@yaml); 485 | 486 | $str; 487 | } 488 | 489 | 490 | =item redspans_traverse 491 | 492 | Walk the path that no one wanted to travel ;) 493 | =cut 494 | sub redspans_traverse($%) { 495 | my ($process_buffer,%colors) = @ARG; 496 | 497 | my ($last_tree,$buffer, $last_type) = ("","",""); 498 | for my $i (0 .. @loc-1) { 499 | next unless defined $loc[$i]; 500 | my $c = substr($src_text,$i,1); 501 | my $tree = ""; 502 | for my $action_ref (@{$loc[$i]}) { 503 | $tree .= ${$action_ref} . " "; 504 | } 505 | if($tree ne $last_tree) { 506 | my $rule; 507 | my $rule_to_color = 0; 508 | $buffer = $buffer; 509 | my @rules = (); 510 | @rules = reverse(split / /,$last_tree) if $last_tree ne ''; 511 | for $rule (@rules) { 512 | if($rule eq 'unv') { 513 | $rule_to_color = '_comment'; 514 | last; 515 | } elsif($colors{$rule} && $buffer ne '') { 516 | $rule_to_color = $rule; 517 | last; 518 | } 519 | } 520 | if($rule_to_color) { 521 | if($last_tree =~ /\sidentifier/) { 522 | if($last_type ne '') { 523 | $rule_to_color = $last_type; 524 | $last_type = ''; 525 | } #elsif($parser->is_type($buffer)) { 526 | #$rule_to_color = '_type'; 527 | #} elsif($parser->is_routine($buffer)) { 528 | #$rule_to_color = '_routine'; 529 | #} 530 | } elsif($last_tree =~ /\ssigil/) { 531 | given($buffer) { 532 | when ('$') { $last_type = '_scalar'; } 533 | when ('@') { $last_type = '_array'; } 534 | when ('%') { $last_type = '_hash'; } 535 | default { $last_type = ''; } 536 | } 537 | $rule_to_color = $last_type if $last_type ne ''; 538 | } 539 | } 540 | #now delegate printing to a callback 541 | $process_buffer->($i, $buffer, $rule_to_color, $last_tree); 542 | $buffer = $c; 543 | } else { 544 | $buffer .= $c; 545 | } 546 | $last_tree = $tree; 547 | } 548 | } 549 | 550 | ################################################################### 551 | # R E D S P A N S 552 | { 553 | package Actions; 554 | 555 | our $AUTOLOAD; 556 | 557 | my %action_refs = (); 558 | 559 | sub AUTOLOAD { 560 | my $self = shift; 561 | my $C = shift; 562 | my $F = $C->{_from}; 563 | my $P = $C->{_pos}; 564 | $AUTOLOAD =~ s/^Actions:://; 565 | $loc[$P] = [] if $loc[$P]; # in case we backtracked to here 566 | my $action = $AUTOLOAD; 567 | my $action_ref = $action_refs{$action}; 568 | if(!$action_ref) { 569 | $action_refs{$action} = $action_ref = \$action; 570 | } 571 | for ($F..$P-1) { 572 | unshift @{$loc[$_]}, $action_ref; 573 | } 574 | } 575 | 576 | } 577 | 578 | 579 | =item escape_html 580 | 581 | Converts some characters to their equivalent html entities 582 | =cut 583 | sub escape_html { 584 | my $str = shift; 585 | my %esc = ( 586 | '<' => '<', 587 | '>' => '>', 588 | '"' => '"', 589 | '&' => '&' 590 | ); 591 | my $re = join '|', map quotemeta, keys %esc; 592 | $str =~ s/($re)/$esc{$1}/g; 593 | return $str; 594 | } 595 | 596 | =back 597 | 598 | =head1 AUTHOR 599 | 600 | Written by Ahmad M. Zawawi (azawawi), Moritz Lenz and Paweł Murias (pmurias) 601 | 602 | The project idea was inspired by Moritz Lenz (moritz) 603 | See http://www.nntp.perl.org/group/perl.perl6.users/2008/07/msg788.html 604 | 605 | The initial STD tree traversal code was written by Paweł Murias (pmurias). 606 | 607 | The redspans traversal code was written by Larry Wall (TimToady). 608 | redspans stands for "...'red' for "reductions", and 'spans' from the 609 | from/to span calculations" 610 | 611 | The browser code was written by Ahmad M. Zawawi (azawawi) 612 | =cut 613 | 614 | main @ARGV; 615 | -------------------------------------------------------------------------------- /std_hilite/STD_syntax_highlight.ansi: -------------------------------------------------------------------------------- 1 | comp_unit=blue 2 | scope_declarator=bold red 3 | routine_declarator=bold red 4 | regex_declarator=bold red 5 | package_declarator=bold red 6 | statement_control=bold red 7 | block=white 8 | regex_block=white 9 | noun=white 10 | sigil=bold green 11 | variable=bold green 12 | assertion=bold green 13 | quote=yellow 14 | number=magenta 15 | infix=blue 16 | methodop=bold white 17 | pod_comment=bold green 18 | param_var=bold cyan 19 | 20 | _routine=bold red 21 | _type=bold blue 22 | _scalar=bold blue 23 | _array=bold magenta 24 | _hash=bold yellow 25 | _comment=bold green 26 | -------------------------------------------------------------------------------- /std_hilite/STD_syntax_highlight.css: -------------------------------------------------------------------------------- 1 | .comp_unit { color: Blue; } 2 | .scope_declarator { color: DarkRed; } 3 | .routine_declarator { color: DarkRed; } 4 | .regex_declarator { color: DarkRed; } 5 | .package_declarator { color DarkRed; } 6 | .statement_control { color: DarkRed; } 7 | .block { color: Black; } 8 | .regex_block { color: Black; } 9 | .noun { color: Black; } 10 | .sigil { color: DarkGreen; } 11 | .variable { color: DarkGreen; } 12 | .assertion { color: Darkgreen; } 13 | .quote { color: DarkMagenta; } 14 | .number { color: DarkOrange; } 15 | .infix { color: DimGray; } 16 | .methodop { color: black; font-weight: bold; } 17 | .pod_comment { color: DarkGreen; font-weight: bold; } 18 | .param_var { color: Crimson; } 19 | 20 | ._routine { color: DarkRed; font-weight: bold; } 21 | ._type { color: DarkBlue; font-weight: bold; } 22 | ._scalar { color: DarkBlue; font-weight: bold; } 23 | ._array { color: Brown; font-weight: bold; } 24 | ._hash { color: DarkOrange; font-weight: bold; } 25 | ._comment { color: DarkGreen; font-weight: bold; } 26 | 27 | #parse_tree { position: absolute; right: 10px; top: 10px; font: 14px Verdana; } 28 | #parse_tree_output { color: black; background-color: #FFF5DF; border: 1px solid Orange; } 29 | -------------------------------------------------------------------------------- /std_hilite/STD_syntax_highlight.js: -------------------------------------------------------------------------------- 1 | $(document.body).ready(function() { 2 | //find first span after pre and use it as top-level node 3 | var lastSelectedNode = null; 4 | var keepResults = false; 5 | var timeoutId = null; 6 | 7 | $("#parse_tree_output").html("Found " + $("span").size() + " node(s)"); 8 | 9 | function updateTree(node) { 10 | if(lastSelectedNode) { 11 | $(lastSelectedNode).css("border",""); 12 | $(lastSelectedNode).css("background-color",""); 13 | } 14 | $(node).css("border","1px solid orange"); 15 | $(node).css("background-color","#FFF5DF"); 16 | lastSelectedNode = node; 17 | var output = ""; 18 | var ident = ""; 19 | var rules = $("#" + node.id.replace("node","tree")).text().split(/ /); 20 | for(var i = 0; i < rules.length; i++) { 21 | var r = rules[i]; 22 | output += ident + '' + r + '
'; 23 | ident += " "; 24 | } 25 | $("#parse_tree_output").html(output); 26 | } 27 | 28 | function bind_node_highlighter() { 29 | $(document.body).mousemove(function(e) { 30 | if(keepResults) { 31 | return false; 32 | } 33 | var node = $.browser.msie ? e.srcElement : e.target; 34 | if(node.nodeName == "PRE") { 35 | if(lastSelectedNode) { 36 | $(lastSelectedNode).css("border",""); 37 | $(lastSelectedNode).css("background-color",""); 38 | lastSelectedNode = null; 39 | } 40 | $("#parse_tree_output").html("... "); 41 | return false; 42 | } 43 | if (lastSelectedNode == node || node.nodeName != "SPAN") { 44 | return false; 45 | } 46 | 47 | clearTimeout(timeoutId); 48 | timeoutId = setTimeout(function() { updateTree(node) }, 100); 49 | return false; 50 | }); 51 | } 52 | 53 | function bind_clicks() { 54 | $(document.body).click(function(e) { 55 | var node = $.browser.msie ? e.srcElement : e.target; 56 | if(node.nodeName == "SPAN") { 57 | if(keepResults) { 58 | if(lastSelectedNode) { 59 | $(lastSelectedNode).css("border",""); 60 | $(lastSelectedNode).css("background-color",""); 61 | } 62 | } else { 63 | $(node).css("border","1px solid black"); 64 | lastSelectedNode = node; 65 | } 66 | keepResults = !keepResults; 67 | } else { 68 | if(lastSelectedNode) { 69 | $(lastSelectedNode).css("border",""); 70 | $(lastSelectedNode).css("background-color",""); 71 | } 72 | keepResults = false; 73 | } 74 | return false; 75 | }); 76 | } 77 | 78 | function bind_events() { 79 | bind_node_highlighter(); 80 | bind_clicks(); 81 | } 82 | 83 | $(window).scroll(function() { 84 | $("#parse_tree").css("top", "" + document.body.scrollTop + "px"); 85 | }); 86 | 87 | function unbind_events() { 88 | $("#parse_tree_output").html("Unbinding events... Please wait"); 89 | $(document.body).unbind(); 90 | } 91 | 92 | $("#parse_tree_collapse").hide(); 93 | 94 | $("#parse_tree_expand").click(function() { 95 | bind_events(); 96 | $("#parse_tree_output").show(); 97 | $("#parse_tree_expand").hide(); 98 | $("#parse_tree_collapse").show(); 99 | $("#parse_tree_output").html("..."); 100 | }); 101 | $("#parse_tree_collapse").click(function() { 102 | unbind_events(); 103 | $("#parse_tree_output").hide(); 104 | $("#parse_tree_expand").show(); 105 | $("#parse_tree_collapse").hide(); 106 | $("#parse_tree_output").empty(); 107 | }); 108 | $("#parse_tree_help").click(function() { 109 | 110 | alert( 111 | "**** Help ****\n" + 112 | "\n1. Click on the 'Show Syntax Tree' button, and then hover over the Perl 6 code to see its syntax tree.\n" + 113 | "\n2. Click on the highlighted code if you need to keep the results.\n" + 114 | "Click again anywhere and this behavior will be reset.\n" + 115 | "\nNote: Some browsers exhibit problems with unloading pages with too many nodes. "+ 116 | "If you encounter that simply wait for it or kill it." 117 | ); 118 | }); 119 | 120 | }); 121 | 122 | -------------------------------------------------------------------------------- /std_hilite/STD_syntax_highlight.mirc: -------------------------------------------------------------------------------- 1 | comp_unit=blue 2 | scope_declarator=red 3 | routine_declarator=red 4 | regex_declarator=red 5 | package_declarator=red 6 | statement_control=red 7 | block=silver 8 | regex_block=silver 9 | noun=silver 10 | sigil=lime 11 | variable=lime 12 | assertion=lime 13 | quote=orange 14 | number=purple 15 | infix=blue 16 | methodop=white 17 | pod_comment=lime 18 | param_var=cyan 19 | 20 | _routine=pink 21 | _type=navy 22 | _scalar=navy 23 | _array=pink 24 | _hash=yellow 25 | _comment=lime 26 | -------------------------------------------------------------------------------- /std_hilite/cron_spec_highlight: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | use English; 6 | use feature qw(say); 7 | 8 | # act nice 9 | use POSIX qw(nice); 10 | nice 19; 11 | 12 | my $WEB_ROOT='~/public_html'; 13 | 14 | print <<"INTRO"; 15 | 16 | Hi my name is $PROGRAM_NAME. 17 | I am usually run as a cron job to generate Perl 6 syntax highlighted htmls. 18 | 19 | INTRO 20 | 21 | my $status; 22 | 23 | say "\n--Running 'git pull' for std"; 24 | $status = system('cd ..; git pull'); 25 | die "Could not git pull for std\n" if $status != 0; 26 | 27 | say "\n--Running 'make clean all' for STD.pm"; 28 | $status = system('cd ..; make clean all'); 29 | die "Could not make STD.pm\n" if $status != 0; 30 | 31 | say "\n-- Running syntax highlighter"; 32 | $status = system("cd ..; std_hilite/spec_highlight"); 33 | #die "Could not run spec_highlight\n" if $status != 0; 34 | 35 | say "\n-- Copying the result to $WEB_ROOT/html"; 36 | $status = system("/bin/cp -R ../html $WEB_ROOT/"); 37 | die "Could not copy the output\n" if $status != 0; 38 | 39 | say "\n-- I am done... Thanks for your valuable time"; 40 | 41 | =head1 sample usage in cron 42 | 43 | PATH=/bin:/usr/bin:/usr/local/bin 44 | LANG=en_US.UTF-8 45 | 46 | # m h dom mon dow command 47 | 1 */5 * * * (cd ~/std/std_hilite; ./cron_spec_highlight 2>&1 | tee html/log.txt) 48 | 49 | =cut 50 | -------------------------------------------------------------------------------- /std_hilite/jquery-1.4.2.min.js: -------------------------------------------------------------------------------- 1 | /*! 2 | * jQuery JavaScript Library v1.4.2 3 | * http://jquery.com/ 4 | * 5 | * Copyright 2010, John Resig 6 | * Dual licensed under the MIT or GPL Version 2 licenses. 7 | * http://jquery.org/license 8 | * 9 | * Includes Sizzle.js 10 | * http://sizzlejs.com/ 11 | * Copyright 2010, The Dojo Foundation 12 | * Released under the MIT, BSD, and GPL Licenses. 13 | * 14 | * Date: Sat Feb 13 22:33:48 2010 -0500 15 | */ 16 | (function(A,w){function ma(){if(!c.isReady){try{s.documentElement.doScroll("left")}catch(a){setTimeout(ma,1);return}c.ready()}}function Qa(a,b){b.src?c.ajax({url:b.src,async:false,dataType:"script"}):c.globalEval(b.text||b.textContent||b.innerHTML||"");b.parentNode&&b.parentNode.removeChild(b)}function X(a,b,d,f,e,j){var i=a.length;if(typeof b==="object"){for(var o in b)X(a,o,b[o],f,e,d);return a}if(d!==w){f=!j&&f&&c.isFunction(d);for(o=0;o)[^>]*$|^#([\w-]+)$/,Ua=/^.[^:#\[\.,]*$/,Va=/\S/, 21 | Wa=/^(\s|\u00A0)+|(\s|\u00A0)+$/g,Xa=/^<(\w+)\s*\/?>(?:<\/\1>)?$/,P=navigator.userAgent,xa=false,Q=[],L,$=Object.prototype.toString,aa=Object.prototype.hasOwnProperty,ba=Array.prototype.push,R=Array.prototype.slice,ya=Array.prototype.indexOf;c.fn=c.prototype={init:function(a,b){var d,f;if(!a)return this;if(a.nodeType){this.context=this[0]=a;this.length=1;return this}if(a==="body"&&!b){this.context=s;this[0]=s.body;this.selector="body";this.length=1;return this}if(typeof a==="string")if((d=Ta.exec(a))&& 22 | (d[1]||!b))if(d[1]){f=b?b.ownerDocument||b:s;if(a=Xa.exec(a))if(c.isPlainObject(b)){a=[s.createElement(a[1])];c.fn.attr.call(a,b,true)}else a=[f.createElement(a[1])];else{a=sa([d[1]],[f]);a=(a.cacheable?a.fragment.cloneNode(true):a.fragment).childNodes}return c.merge(this,a)}else{if(b=s.getElementById(d[2])){if(b.id!==d[2])return T.find(a);this.length=1;this[0]=b}this.context=s;this.selector=a;return this}else if(!b&&/^\w+$/.test(a)){this.selector=a;this.context=s;a=s.getElementsByTagName(a);return c.merge(this, 23 | a)}else return!b||b.jquery?(b||T).find(a):c(b).find(a);else if(c.isFunction(a))return T.ready(a);if(a.selector!==w){this.selector=a.selector;this.context=a.context}return c.makeArray(a,this)},selector:"",jquery:"1.4.2",length:0,size:function(){return this.length},toArray:function(){return R.call(this,0)},get:function(a){return a==null?this.toArray():a<0?this.slice(a)[0]:this[a]},pushStack:function(a,b,d){var f=c();c.isArray(a)?ba.apply(f,a):c.merge(f,a);f.prevObject=this;f.context=this.context;if(b=== 24 | "find")f.selector=this.selector+(this.selector?" ":"")+d;else if(b)f.selector=this.selector+"."+b+"("+d+")";return f},each:function(a,b){return c.each(this,a,b)},ready:function(a){c.bindReady();if(c.isReady)a.call(s,c);else Q&&Q.push(a);return this},eq:function(a){return a===-1?this.slice(a):this.slice(a,+a+1)},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},slice:function(){return this.pushStack(R.apply(this,arguments),"slice",R.call(arguments).join(","))},map:function(a){return this.pushStack(c.map(this, 25 | function(b,d){return a.call(b,d,b)}))},end:function(){return this.prevObject||c(null)},push:ba,sort:[].sort,splice:[].splice};c.fn.init.prototype=c.fn;c.extend=c.fn.extend=function(){var a=arguments[0]||{},b=1,d=arguments.length,f=false,e,j,i,o;if(typeof a==="boolean"){f=a;a=arguments[1]||{};b=2}if(typeof a!=="object"&&!c.isFunction(a))a={};if(d===b){a=this;--b}for(;b
a"; 34 | var e=d.getElementsByTagName("*"),j=d.getElementsByTagName("a")[0];if(!(!e||!e.length||!j)){c.support={leadingWhitespace:d.firstChild.nodeType===3,tbody:!d.getElementsByTagName("tbody").length,htmlSerialize:!!d.getElementsByTagName("link").length,style:/red/.test(j.getAttribute("style")),hrefNormalized:j.getAttribute("href")==="/a",opacity:/^0.55$/.test(j.style.opacity),cssFloat:!!j.style.cssFloat,checkOn:d.getElementsByTagName("input")[0].value==="on",optSelected:s.createElement("select").appendChild(s.createElement("option")).selected, 35 | parentNode:d.removeChild(d.appendChild(s.createElement("div"))).parentNode===null,deleteExpando:true,checkClone:false,scriptEval:false,noCloneEvent:true,boxModel:null};b.type="text/javascript";try{b.appendChild(s.createTextNode("window."+f+"=1;"))}catch(i){}a.insertBefore(b,a.firstChild);if(A[f]){c.support.scriptEval=true;delete A[f]}try{delete b.test}catch(o){c.support.deleteExpando=false}a.removeChild(b);if(d.attachEvent&&d.fireEvent){d.attachEvent("onclick",function k(){c.support.noCloneEvent= 36 | false;d.detachEvent("onclick",k)});d.cloneNode(true).fireEvent("onclick")}d=s.createElement("div");d.innerHTML="";a=s.createDocumentFragment();a.appendChild(d.firstChild);c.support.checkClone=a.cloneNode(true).cloneNode(true).lastChild.checked;c(function(){var k=s.createElement("div");k.style.width=k.style.paddingLeft="1px";s.body.appendChild(k);c.boxModel=c.support.boxModel=k.offsetWidth===2;s.body.removeChild(k).style.display="none"});a=function(k){var n= 37 | s.createElement("div");k="on"+k;var r=k in n;if(!r){n.setAttribute(k,"return;");r=typeof n[k]==="function"}return r};c.support.submitBubbles=a("submit");c.support.changeBubbles=a("change");a=b=d=e=j=null}})();c.props={"for":"htmlFor","class":"className",readonly:"readOnly",maxlength:"maxLength",cellspacing:"cellSpacing",rowspan:"rowSpan",colspan:"colSpan",tabindex:"tabIndex",usemap:"useMap",frameborder:"frameBorder"};var G="jQuery"+J(),Ya=0,za={};c.extend({cache:{},expando:G,noData:{embed:true,object:true, 38 | applet:true},data:function(a,b,d){if(!(a.nodeName&&c.noData[a.nodeName.toLowerCase()])){a=a==A?za:a;var f=a[G],e=c.cache;if(!f&&typeof b==="string"&&d===w)return null;f||(f=++Ya);if(typeof b==="object"){a[G]=f;e[f]=c.extend(true,{},b)}else if(!e[f]){a[G]=f;e[f]={}}a=e[f];if(d!==w)a[b]=d;return typeof b==="string"?a[b]:a}},removeData:function(a,b){if(!(a.nodeName&&c.noData[a.nodeName.toLowerCase()])){a=a==A?za:a;var d=a[G],f=c.cache,e=f[d];if(b){if(e){delete e[b];c.isEmptyObject(e)&&c.removeData(a)}}else{if(c.support.deleteExpando)delete a[c.expando]; 39 | else a.removeAttribute&&a.removeAttribute(c.expando);delete f[d]}}}});c.fn.extend({data:function(a,b){if(typeof a==="undefined"&&this.length)return c.data(this[0]);else if(typeof a==="object")return this.each(function(){c.data(this,a)});var d=a.split(".");d[1]=d[1]?"."+d[1]:"";if(b===w){var f=this.triggerHandler("getData"+d[1]+"!",[d[0]]);if(f===w&&this.length)f=c.data(this[0],a);return f===w&&d[1]?this.data(d[0]):f}else return this.trigger("setData"+d[1]+"!",[d[0],b]).each(function(){c.data(this, 40 | a,b)})},removeData:function(a){return this.each(function(){c.removeData(this,a)})}});c.extend({queue:function(a,b,d){if(a){b=(b||"fx")+"queue";var f=c.data(a,b);if(!d)return f||[];if(!f||c.isArray(d))f=c.data(a,b,c.makeArray(d));else f.push(d);return f}},dequeue:function(a,b){b=b||"fx";var d=c.queue(a,b),f=d.shift();if(f==="inprogress")f=d.shift();if(f){b==="fx"&&d.unshift("inprogress");f.call(a,function(){c.dequeue(a,b)})}}});c.fn.extend({queue:function(a,b){if(typeof a!=="string"){b=a;a="fx"}if(b=== 41 | w)return c.queue(this[0],a);return this.each(function(){var d=c.queue(this,a,b);a==="fx"&&d[0]!=="inprogress"&&c.dequeue(this,a)})},dequeue:function(a){return this.each(function(){c.dequeue(this,a)})},delay:function(a,b){a=c.fx?c.fx.speeds[a]||a:a;b=b||"fx";return this.queue(b,function(){var d=this;setTimeout(function(){c.dequeue(d,b)},a)})},clearQueue:function(a){return this.queue(a||"fx",[])}});var Aa=/[\n\t]/g,ca=/\s+/,Za=/\r/g,$a=/href|src|style/,ab=/(button|input)/i,bb=/(button|input|object|select|textarea)/i, 42 | cb=/^(a|area)$/i,Ba=/radio|checkbox/;c.fn.extend({attr:function(a,b){return X(this,a,b,true,c.attr)},removeAttr:function(a){return this.each(function(){c.attr(this,a,"");this.nodeType===1&&this.removeAttribute(a)})},addClass:function(a){if(c.isFunction(a))return this.each(function(n){var r=c(this);r.addClass(a.call(this,n,r.attr("class")))});if(a&&typeof a==="string")for(var b=(a||"").split(ca),d=0,f=this.length;d-1)return true;return false},val:function(a){if(a===w){var b=this[0];if(b){if(c.nodeName(b,"option"))return(b.attributes.value||{}).specified?b.value:b.text;if(c.nodeName(b,"select")){var d=b.selectedIndex,f=[],e=b.options;b=b.type==="select-one";if(d<0)return null;var j=b?d:0;for(d=b?d+1:e.length;j=0;else if(c.nodeName(this,"select")){var u=c.makeArray(r);c("option",this).each(function(){this.selected= 47 | c.inArray(c(this).val(),u)>=0});if(!u.length)this.selectedIndex=-1}else this.value=r}})}});c.extend({attrFn:{val:true,css:true,html:true,text:true,data:true,width:true,height:true,offset:true},attr:function(a,b,d,f){if(!a||a.nodeType===3||a.nodeType===8)return w;if(f&&b in c.attrFn)return c(a)[b](d);f=a.nodeType!==1||!c.isXMLDoc(a);var e=d!==w;b=f&&c.props[b]||b;if(a.nodeType===1){var j=$a.test(b);if(b in a&&f&&!j){if(e){b==="type"&&ab.test(a.nodeName)&&a.parentNode&&c.error("type property can't be changed"); 48 | a[b]=d}if(c.nodeName(a,"form")&&a.getAttributeNode(b))return a.getAttributeNode(b).nodeValue;if(b==="tabIndex")return(b=a.getAttributeNode("tabIndex"))&&b.specified?b.value:bb.test(a.nodeName)||cb.test(a.nodeName)&&a.href?0:w;return a[b]}if(!c.support.style&&f&&b==="style"){if(e)a.style.cssText=""+d;return a.style.cssText}e&&a.setAttribute(b,""+d);a=!c.support.hrefNormalized&&f&&j?a.getAttribute(b,2):a.getAttribute(b);return a===null?w:a}return c.style(a,b,d)}});var O=/\.(.*)$/,db=function(a){return a.replace(/[^\w\s\.\|`]/g, 49 | function(b){return"\\"+b})};c.event={add:function(a,b,d,f){if(!(a.nodeType===3||a.nodeType===8)){if(a.setInterval&&a!==A&&!a.frameElement)a=A;var e,j;if(d.handler){e=d;d=e.handler}if(!d.guid)d.guid=c.guid++;if(j=c.data(a)){var i=j.events=j.events||{},o=j.handle;if(!o)j.handle=o=function(){return typeof c!=="undefined"&&!c.event.triggered?c.event.handle.apply(o.elem,arguments):w};o.elem=a;b=b.split(" ");for(var k,n=0,r;k=b[n++];){j=e?c.extend({},e):{handler:d,data:f};if(k.indexOf(".")>-1){r=k.split("."); 50 | k=r.shift();j.namespace=r.slice(0).sort().join(".")}else{r=[];j.namespace=""}j.type=k;j.guid=d.guid;var u=i[k],z=c.event.special[k]||{};if(!u){u=i[k]=[];if(!z.setup||z.setup.call(a,f,r,o)===false)if(a.addEventListener)a.addEventListener(k,o,false);else a.attachEvent&&a.attachEvent("on"+k,o)}if(z.add){z.add.call(a,j);if(!j.handler.guid)j.handler.guid=d.guid}u.push(j);c.event.global[k]=true}a=null}}},global:{},remove:function(a,b,d,f){if(!(a.nodeType===3||a.nodeType===8)){var e,j=0,i,o,k,n,r,u,z=c.data(a), 51 | C=z&&z.events;if(z&&C){if(b&&b.type){d=b.handler;b=b.type}if(!b||typeof b==="string"&&b.charAt(0)==="."){b=b||"";for(e in C)c.event.remove(a,e+b)}else{for(b=b.split(" ");e=b[j++];){n=e;i=e.indexOf(".")<0;o=[];if(!i){o=e.split(".");e=o.shift();k=new RegExp("(^|\\.)"+c.map(o.slice(0).sort(),db).join("\\.(?:.*\\.)?")+"(\\.|$)")}if(r=C[e])if(d){n=c.event.special[e]||{};for(B=f||0;B=0){a.type= 53 | e=e.slice(0,-1);a.exclusive=true}if(!d){a.stopPropagation();c.event.global[e]&&c.each(c.cache,function(){this.events&&this.events[e]&&c.event.trigger(a,b,this.handle.elem)})}if(!d||d.nodeType===3||d.nodeType===8)return w;a.result=w;a.target=d;b=c.makeArray(b);b.unshift(a)}a.currentTarget=d;(f=c.data(d,"handle"))&&f.apply(d,b);f=d.parentNode||d.ownerDocument;try{if(!(d&&d.nodeName&&c.noData[d.nodeName.toLowerCase()]))if(d["on"+e]&&d["on"+e].apply(d,b)===false)a.result=false}catch(j){}if(!a.isPropagationStopped()&& 54 | f)c.event.trigger(a,b,f,true);else if(!a.isDefaultPrevented()){f=a.target;var i,o=c.nodeName(f,"a")&&e==="click",k=c.event.special[e]||{};if((!k._default||k._default.call(d,a)===false)&&!o&&!(f&&f.nodeName&&c.noData[f.nodeName.toLowerCase()])){try{if(f[e]){if(i=f["on"+e])f["on"+e]=null;c.event.triggered=true;f[e]()}}catch(n){}if(i)f["on"+e]=i;c.event.triggered=false}}},handle:function(a){var b,d,f,e;a=arguments[0]=c.event.fix(a||A.event);a.currentTarget=this;b=a.type.indexOf(".")<0&&!a.exclusive; 55 | if(!b){d=a.type.split(".");a.type=d.shift();f=new RegExp("(^|\\.)"+d.slice(0).sort().join("\\.(?:.*\\.)?")+"(\\.|$)")}e=c.data(this,"events");d=e[a.type];if(e&&d){d=d.slice(0);e=0;for(var j=d.length;e-1?c.map(a.options,function(f){return f.selected}).join("-"):"";else if(a.nodeName.toLowerCase()==="select")d=a.selectedIndex;return d},fa=function(a,b){var d=a.target,f,e;if(!(!da.test(d.nodeName)||d.readOnly)){f=c.data(d,"_change_data");e=Fa(d);if(a.type!=="focusout"||d.type!=="radio")c.data(d,"_change_data", 63 | e);if(!(f===w||e===f))if(f!=null||e){a.type="change";return c.event.trigger(a,b,d)}}};c.event.special.change={filters:{focusout:fa,click:function(a){var b=a.target,d=b.type;if(d==="radio"||d==="checkbox"||b.nodeName.toLowerCase()==="select")return fa.call(this,a)},keydown:function(a){var b=a.target,d=b.type;if(a.keyCode===13&&b.nodeName.toLowerCase()!=="textarea"||a.keyCode===32&&(d==="checkbox"||d==="radio")||d==="select-multiple")return fa.call(this,a)},beforeactivate:function(a){a=a.target;c.data(a, 64 | "_change_data",Fa(a))}},setup:function(){if(this.type==="file")return false;for(var a in ea)c.event.add(this,a+".specialChange",ea[a]);return da.test(this.nodeName)},teardown:function(){c.event.remove(this,".specialChange");return da.test(this.nodeName)}};ea=c.event.special.change.filters}s.addEventListener&&c.each({focus:"focusin",blur:"focusout"},function(a,b){function d(f){f=c.event.fix(f);f.type=b;return c.event.handle.call(this,f)}c.event.special[b]={setup:function(){this.addEventListener(a, 65 | d,true)},teardown:function(){this.removeEventListener(a,d,true)}}});c.each(["bind","one"],function(a,b){c.fn[b]=function(d,f,e){if(typeof d==="object"){for(var j in d)this[b](j,f,d[j],e);return this}if(c.isFunction(f)){e=f;f=w}var i=b==="one"?c.proxy(e,function(k){c(this).unbind(k,i);return e.apply(this,arguments)}):e;if(d==="unload"&&b!=="one")this.one(d,f,e);else{j=0;for(var o=this.length;j0){y=t;break}}t=t[g]}m[q]=y}}}var f=/((?:\((?:\([^()]+\)|[^()]+)+\)|\[(?:\[[^[\]]*\]|['"][^'"]*['"]|[^[\]'"]+)+\]|\\.|[^ >+~,(\[\\]+)+|[>+~])(\s*,\s*)?((?:.|\r|\n)*)/g, 71 | e=0,j=Object.prototype.toString,i=false,o=true;[0,0].sort(function(){o=false;return 0});var k=function(g,h,l,m){l=l||[];var q=h=h||s;if(h.nodeType!==1&&h.nodeType!==9)return[];if(!g||typeof g!=="string")return l;for(var p=[],v,t,y,S,H=true,M=x(h),I=g;(f.exec(""),v=f.exec(I))!==null;){I=v[3];p.push(v[1]);if(v[2]){S=v[3];break}}if(p.length>1&&r.exec(g))if(p.length===2&&n.relative[p[0]])t=ga(p[0]+p[1],h);else for(t=n.relative[p[0]]?[h]:k(p.shift(),h);p.length;){g=p.shift();if(n.relative[g])g+=p.shift(); 72 | t=ga(g,t)}else{if(!m&&p.length>1&&h.nodeType===9&&!M&&n.match.ID.test(p[0])&&!n.match.ID.test(p[p.length-1])){v=k.find(p.shift(),h,M);h=v.expr?k.filter(v.expr,v.set)[0]:v.set[0]}if(h){v=m?{expr:p.pop(),set:z(m)}:k.find(p.pop(),p.length===1&&(p[0]==="~"||p[0]==="+")&&h.parentNode?h.parentNode:h,M);t=v.expr?k.filter(v.expr,v.set):v.set;if(p.length>0)y=z(t);else H=false;for(;p.length;){var D=p.pop();v=D;if(n.relative[D])v=p.pop();else D="";if(v==null)v=h;n.relative[D](y,v,M)}}else y=[]}y||(y=t);y||k.error(D|| 73 | g);if(j.call(y)==="[object Array]")if(H)if(h&&h.nodeType===1)for(g=0;y[g]!=null;g++){if(y[g]&&(y[g]===true||y[g].nodeType===1&&E(h,y[g])))l.push(t[g])}else for(g=0;y[g]!=null;g++)y[g]&&y[g].nodeType===1&&l.push(t[g]);else l.push.apply(l,y);else z(y,l);if(S){k(S,q,l,m);k.uniqueSort(l)}return l};k.uniqueSort=function(g){if(B){i=o;g.sort(B);if(i)for(var h=1;h":function(g,h){var l=typeof h==="string";if(l&&!/\W/.test(h)){h=h.toLowerCase();for(var m=0,q=g.length;m=0))l||m.push(v);else if(l)h[p]=false;return false},ID:function(g){return g[1].replace(/\\/g,"")},TAG:function(g){return g[1].toLowerCase()}, 80 | CHILD:function(g){if(g[1]==="nth"){var h=/(-?)(\d*)n((?:\+|-)?\d*)/.exec(g[2]==="even"&&"2n"||g[2]==="odd"&&"2n+1"||!/\D/.test(g[2])&&"0n+"+g[2]||g[2]);g[2]=h[1]+(h[2]||1)-0;g[3]=h[3]-0}g[0]=e++;return g},ATTR:function(g,h,l,m,q,p){h=g[1].replace(/\\/g,"");if(!p&&n.attrMap[h])g[1]=n.attrMap[h];if(g[2]==="~=")g[4]=" "+g[4]+" ";return g},PSEUDO:function(g,h,l,m,q){if(g[1]==="not")if((f.exec(g[3])||"").length>1||/^\w/.test(g[3]))g[3]=k(g[3],null,null,h);else{g=k.filter(g[3],h,l,true^q);l||m.push.apply(m, 81 | g);return false}else if(n.match.POS.test(g[0])||n.match.CHILD.test(g[0]))return true;return g},POS:function(g){g.unshift(true);return g}},filters:{enabled:function(g){return g.disabled===false&&g.type!=="hidden"},disabled:function(g){return g.disabled===true},checked:function(g){return g.checked===true},selected:function(g){return g.selected===true},parent:function(g){return!!g.firstChild},empty:function(g){return!g.firstChild},has:function(g,h,l){return!!k(l[3],g).length},header:function(g){return/h\d/i.test(g.nodeName)}, 82 | text:function(g){return"text"===g.type},radio:function(g){return"radio"===g.type},checkbox:function(g){return"checkbox"===g.type},file:function(g){return"file"===g.type},password:function(g){return"password"===g.type},submit:function(g){return"submit"===g.type},image:function(g){return"image"===g.type},reset:function(g){return"reset"===g.type},button:function(g){return"button"===g.type||g.nodeName.toLowerCase()==="button"},input:function(g){return/input|select|textarea|button/i.test(g.nodeName)}}, 83 | setFilters:{first:function(g,h){return h===0},last:function(g,h,l,m){return h===m.length-1},even:function(g,h){return h%2===0},odd:function(g,h){return h%2===1},lt:function(g,h,l){return hl[3]-0},nth:function(g,h,l){return l[3]-0===h},eq:function(g,h,l){return l[3]-0===h}},filter:{PSEUDO:function(g,h,l,m){var q=h[1],p=n.filters[q];if(p)return p(g,l,h,m);else if(q==="contains")return(g.textContent||g.innerText||a([g])||"").indexOf(h[3])>=0;else if(q==="not"){h= 84 | h[3];l=0;for(m=h.length;l=0}},ID:function(g,h){return g.nodeType===1&&g.getAttribute("id")===h},TAG:function(g,h){return h==="*"&&g.nodeType===1||g.nodeName.toLowerCase()===h},CLASS:function(g,h){return(" "+(g.className||g.getAttribute("class"))+" ").indexOf(h)>-1},ATTR:function(g,h){var l=h[1];g=n.attrHandle[l]?n.attrHandle[l](g):g[l]!=null?g[l]:g.getAttribute(l);l=g+"";var m=h[2];h=h[4];return g==null?m==="!=":m=== 86 | "="?l===h:m==="*="?l.indexOf(h)>=0:m==="~="?(" "+l+" ").indexOf(h)>=0:!h?l&&g!==false:m==="!="?l!==h:m==="^="?l.indexOf(h)===0:m==="$="?l.substr(l.length-h.length)===h:m==="|="?l===h||l.substr(0,h.length+1)===h+"-":false},POS:function(g,h,l,m){var q=n.setFilters[h[2]];if(q)return q(g,l,h,m)}}},r=n.match.POS;for(var u in n.match){n.match[u]=new RegExp(n.match[u].source+/(?![^\[]*\])(?![^\(]*\))/.source);n.leftMatch[u]=new RegExp(/(^(?:.|\r|\n)*?)/.source+n.match[u].source.replace(/\\(\d+)/g,function(g, 87 | h){return"\\"+(h-0+1)}))}var z=function(g,h){g=Array.prototype.slice.call(g,0);if(h){h.push.apply(h,g);return h}return g};try{Array.prototype.slice.call(s.documentElement.childNodes,0)}catch(C){z=function(g,h){h=h||[];if(j.call(g)==="[object Array]")Array.prototype.push.apply(h,g);else if(typeof g.length==="number")for(var l=0,m=g.length;l";var l=s.documentElement;l.insertBefore(g,l.firstChild);if(s.getElementById(h)){n.find.ID=function(m,q,p){if(typeof q.getElementById!=="undefined"&&!p)return(q=q.getElementById(m[1]))?q.id===m[1]||typeof q.getAttributeNode!=="undefined"&& 90 | q.getAttributeNode("id").nodeValue===m[1]?[q]:w:[]};n.filter.ID=function(m,q){var p=typeof m.getAttributeNode!=="undefined"&&m.getAttributeNode("id");return m.nodeType===1&&p&&p.nodeValue===q}}l.removeChild(g);l=g=null})();(function(){var g=s.createElement("div");g.appendChild(s.createComment(""));if(g.getElementsByTagName("*").length>0)n.find.TAG=function(h,l){l=l.getElementsByTagName(h[1]);if(h[1]==="*"){h=[];for(var m=0;l[m];m++)l[m].nodeType===1&&h.push(l[m]);l=h}return l};g.innerHTML=""; 91 | if(g.firstChild&&typeof g.firstChild.getAttribute!=="undefined"&&g.firstChild.getAttribute("href")!=="#")n.attrHandle.href=function(h){return h.getAttribute("href",2)};g=null})();s.querySelectorAll&&function(){var g=k,h=s.createElement("div");h.innerHTML="

";if(!(h.querySelectorAll&&h.querySelectorAll(".TEST").length===0)){k=function(m,q,p,v){q=q||s;if(!v&&q.nodeType===9&&!x(q))try{return z(q.querySelectorAll(m),p)}catch(t){}return g(m,q,p,v)};for(var l in g)k[l]=g[l];h=null}}(); 92 | (function(){var g=s.createElement("div");g.innerHTML="
";if(!(!g.getElementsByClassName||g.getElementsByClassName("e").length===0)){g.lastChild.className="e";if(g.getElementsByClassName("e").length!==1){n.order.splice(1,0,"CLASS");n.find.CLASS=function(h,l,m){if(typeof l.getElementsByClassName!=="undefined"&&!m)return l.getElementsByClassName(h[1])};g=null}}})();var E=s.compareDocumentPosition?function(g,h){return!!(g.compareDocumentPosition(h)&16)}: 93 | function(g,h){return g!==h&&(g.contains?g.contains(h):true)},x=function(g){return(g=(g?g.ownerDocument||g:0).documentElement)?g.nodeName!=="HTML":false},ga=function(g,h){var l=[],m="",q;for(h=h.nodeType?[h]:h;q=n.match.PSEUDO.exec(g);){m+=q[0];g=g.replace(n.match.PSEUDO,"")}g=n.relative[g]?g+"*":g;q=0;for(var p=h.length;q=0===d})};c.fn.extend({find:function(a){for(var b=this.pushStack("","find",a),d=0,f=0,e=this.length;f0)for(var j=d;j0},closest:function(a,b){if(c.isArray(a)){var d=[],f=this[0],e,j= 96 | {},i;if(f&&a.length){e=0;for(var o=a.length;e-1:c(f).is(e)){d.push({selector:i,elem:f});delete j[i]}}f=f.parentNode}}return d}var k=c.expr.match.POS.test(a)?c(a,b||this.context):null;return this.map(function(n,r){for(;r&&r.ownerDocument&&r!==b;){if(k?k.index(r)>-1:c(r).is(a))return r;r=r.parentNode}return null})},index:function(a){if(!a||typeof a=== 97 | "string")return c.inArray(this[0],a?c(a):this.parent().children());return c.inArray(a.jquery?a[0]:a,this)},add:function(a,b){a=typeof a==="string"?c(a,b||this.context):c.makeArray(a);b=c.merge(this.get(),a);return this.pushStack(qa(a[0])||qa(b[0])?b:c.unique(b))},andSelf:function(){return this.add(this.prevObject)}});c.each({parent:function(a){return(a=a.parentNode)&&a.nodeType!==11?a:null},parents:function(a){return c.dir(a,"parentNode")},parentsUntil:function(a,b,d){return c.dir(a,"parentNode", 98 | d)},next:function(a){return c.nth(a,2,"nextSibling")},prev:function(a){return c.nth(a,2,"previousSibling")},nextAll:function(a){return c.dir(a,"nextSibling")},prevAll:function(a){return c.dir(a,"previousSibling")},nextUntil:function(a,b,d){return c.dir(a,"nextSibling",d)},prevUntil:function(a,b,d){return c.dir(a,"previousSibling",d)},siblings:function(a){return c.sibling(a.parentNode.firstChild,a)},children:function(a){return c.sibling(a.firstChild)},contents:function(a){return c.nodeName(a,"iframe")? 99 | a.contentDocument||a.contentWindow.document:c.makeArray(a.childNodes)}},function(a,b){c.fn[a]=function(d,f){var e=c.map(this,b,d);eb.test(a)||(f=d);if(f&&typeof f==="string")e=c.filter(f,e);e=this.length>1?c.unique(e):e;if((this.length>1||gb.test(f))&&fb.test(a))e=e.reverse();return this.pushStack(e,a,R.call(arguments).join(","))}});c.extend({filter:function(a,b,d){if(d)a=":not("+a+")";return c.find.matches(a,b)},dir:function(a,b,d){var f=[];for(a=a[b];a&&a.nodeType!==9&&(d===w||a.nodeType!==1||!c(a).is(d));){a.nodeType=== 100 | 1&&f.push(a);a=a[b]}return f},nth:function(a,b,d){b=b||1;for(var f=0;a;a=a[d])if(a.nodeType===1&&++f===b)break;return a},sibling:function(a,b){for(var d=[];a;a=a.nextSibling)a.nodeType===1&&a!==b&&d.push(a);return d}});var Ja=/ jQuery\d+="(?:\d+|null)"/g,V=/^\s+/,Ka=/(<([\w:]+)[^>]*?)\/>/g,hb=/^(?:area|br|col|embed|hr|img|input|link|meta|param)$/i,La=/<([\w:]+)/,ib=/"},F={option:[1,""],legend:[1,"
","
"],thead:[1,"","
"],tr:[2,"","
"],td:[3,"","
"],col:[2,"","
"],area:[1,"",""],_default:[0,"",""]};F.optgroup=F.option;F.tbody=F.tfoot=F.colgroup=F.caption=F.thead;F.th=F.td;if(!c.support.htmlSerialize)F._default=[1,"div
","
"];c.fn.extend({text:function(a){if(c.isFunction(a))return this.each(function(b){var d= 102 | c(this);d.text(a.call(this,b,d.text()))});if(typeof a!=="object"&&a!==w)return this.empty().append((this[0]&&this[0].ownerDocument||s).createTextNode(a));return c.text(this)},wrapAll:function(a){if(c.isFunction(a))return this.each(function(d){c(this).wrapAll(a.call(this,d))});if(this[0]){var b=c(a,this[0].ownerDocument).eq(0).clone(true);this[0].parentNode&&b.insertBefore(this[0]);b.map(function(){for(var d=this;d.firstChild&&d.firstChild.nodeType===1;)d=d.firstChild;return d}).append(this)}return this}, 103 | wrapInner:function(a){if(c.isFunction(a))return this.each(function(b){c(this).wrapInner(a.call(this,b))});return this.each(function(){var b=c(this),d=b.contents();d.length?d.wrapAll(a):b.append(a)})},wrap:function(a){return this.each(function(){c(this).wrapAll(a)})},unwrap:function(){return this.parent().each(function(){c.nodeName(this,"body")||c(this).replaceWith(this.childNodes)}).end()},append:function(){return this.domManip(arguments,true,function(a){this.nodeType===1&&this.appendChild(a)})}, 104 | prepend:function(){return this.domManip(arguments,true,function(a){this.nodeType===1&&this.insertBefore(a,this.firstChild)})},before:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,false,function(b){this.parentNode.insertBefore(b,this)});else if(arguments.length){var a=c(arguments[0]);a.push.apply(a,this.toArray());return this.pushStack(a,"before",arguments)}},after:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,false,function(b){this.parentNode.insertBefore(b, 105 | this.nextSibling)});else if(arguments.length){var a=this.pushStack(this,"after",arguments);a.push.apply(a,c(arguments[0]).toArray());return a}},remove:function(a,b){for(var d=0,f;(f=this[d])!=null;d++)if(!a||c.filter(a,[f]).length){if(!b&&f.nodeType===1){c.cleanData(f.getElementsByTagName("*"));c.cleanData([f])}f.parentNode&&f.parentNode.removeChild(f)}return this},empty:function(){for(var a=0,b;(b=this[a])!=null;a++)for(b.nodeType===1&&c.cleanData(b.getElementsByTagName("*"));b.firstChild;)b.removeChild(b.firstChild); 106 | return this},clone:function(a){var b=this.map(function(){if(!c.support.noCloneEvent&&!c.isXMLDoc(this)){var d=this.outerHTML,f=this.ownerDocument;if(!d){d=f.createElement("div");d.appendChild(this.cloneNode(true));d=d.innerHTML}return c.clean([d.replace(Ja,"").replace(/=([^="'>\s]+\/)>/g,'="$1">').replace(V,"")],f)[0]}else return this.cloneNode(true)});if(a===true){ra(this,b);ra(this.find("*"),b.find("*"))}return b},html:function(a){if(a===w)return this[0]&&this[0].nodeType===1?this[0].innerHTML.replace(Ja, 107 | ""):null;else if(typeof a==="string"&&!ta.test(a)&&(c.support.leadingWhitespace||!V.test(a))&&!F[(La.exec(a)||["",""])[1].toLowerCase()]){a=a.replace(Ka,Ma);try{for(var b=0,d=this.length;b0||e.cacheable||this.length>1?k.cloneNode(true):k)}o.length&&c.each(o,Qa)}return this}});c.fragments={};c.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(a,b){c.fn[a]=function(d){var f=[];d=c(d);var e=this.length===1&&this[0].parentNode;if(e&&e.nodeType===11&&e.childNodes.length===1&&d.length===1){d[b](this[0]); 111 | return this}else{e=0;for(var j=d.length;e0?this.clone(true):this).get();c.fn[b].apply(c(d[e]),i);f=f.concat(i)}return this.pushStack(f,a,d.selector)}}});c.extend({clean:function(a,b,d,f){b=b||s;if(typeof b.createElement==="undefined")b=b.ownerDocument||b[0]&&b[0].ownerDocument||s;for(var e=[],j=0,i;(i=a[j])!=null;j++){if(typeof i==="number")i+="";if(i){if(typeof i==="string"&&!jb.test(i))i=b.createTextNode(i);else if(typeof i==="string"){i=i.replace(Ka,Ma);var o=(La.exec(i)||["", 112 | ""])[1].toLowerCase(),k=F[o]||F._default,n=k[0],r=b.createElement("div");for(r.innerHTML=k[1]+i+k[2];n--;)r=r.lastChild;if(!c.support.tbody){n=ib.test(i);o=o==="table"&&!n?r.firstChild&&r.firstChild.childNodes:k[1]===""&&!n?r.childNodes:[];for(k=o.length-1;k>=0;--k)c.nodeName(o[k],"tbody")&&!o[k].childNodes.length&&o[k].parentNode.removeChild(o[k])}!c.support.leadingWhitespace&&V.test(i)&&r.insertBefore(b.createTextNode(V.exec(i)[0]),r.firstChild);i=r.childNodes}if(i.nodeType)e.push(i);else e= 113 | c.merge(e,i)}}if(d)for(j=0;e[j];j++)if(f&&c.nodeName(e[j],"script")&&(!e[j].type||e[j].type.toLowerCase()==="text/javascript"))f.push(e[j].parentNode?e[j].parentNode.removeChild(e[j]):e[j]);else{e[j].nodeType===1&&e.splice.apply(e,[j+1,0].concat(c.makeArray(e[j].getElementsByTagName("script"))));d.appendChild(e[j])}return e},cleanData:function(a){for(var b,d,f=c.cache,e=c.event.special,j=c.support.deleteExpando,i=0,o;(o=a[i])!=null;i++)if(d=o[c.expando]){b=f[d];if(b.events)for(var k in b.events)e[k]? 114 | c.event.remove(o,k):Ca(o,k,b.handle);if(j)delete o[c.expando];else o.removeAttribute&&o.removeAttribute(c.expando);delete f[d]}}});var kb=/z-?index|font-?weight|opacity|zoom|line-?height/i,Na=/alpha\([^)]*\)/,Oa=/opacity=([^)]*)/,ha=/float/i,ia=/-([a-z])/ig,lb=/([A-Z])/g,mb=/^-?\d+(?:px)?$/i,nb=/^-?\d/,ob={position:"absolute",visibility:"hidden",display:"block"},pb=["Left","Right"],qb=["Top","Bottom"],rb=s.defaultView&&s.defaultView.getComputedStyle,Pa=c.support.cssFloat?"cssFloat":"styleFloat",ja= 115 | function(a,b){return b.toUpperCase()};c.fn.css=function(a,b){return X(this,a,b,true,function(d,f,e){if(e===w)return c.curCSS(d,f);if(typeof e==="number"&&!kb.test(f))e+="px";c.style(d,f,e)})};c.extend({style:function(a,b,d){if(!a||a.nodeType===3||a.nodeType===8)return w;if((b==="width"||b==="height")&&parseFloat(d)<0)d=w;var f=a.style||a,e=d!==w;if(!c.support.opacity&&b==="opacity"){if(e){f.zoom=1;b=parseInt(d,10)+""==="NaN"?"":"alpha(opacity="+d*100+")";a=f.filter||c.curCSS(a,"filter")||"";f.filter= 116 | Na.test(a)?a.replace(Na,b):b}return f.filter&&f.filter.indexOf("opacity=")>=0?parseFloat(Oa.exec(f.filter)[1])/100+"":""}if(ha.test(b))b=Pa;b=b.replace(ia,ja);if(e)f[b]=d;return f[b]},css:function(a,b,d,f){if(b==="width"||b==="height"){var e,j=b==="width"?pb:qb;function i(){e=b==="width"?a.offsetWidth:a.offsetHeight;f!=="border"&&c.each(j,function(){f||(e-=parseFloat(c.curCSS(a,"padding"+this,true))||0);if(f==="margin")e+=parseFloat(c.curCSS(a,"margin"+this,true))||0;else e-=parseFloat(c.curCSS(a, 117 | "border"+this+"Width",true))||0})}a.offsetWidth!==0?i():c.swap(a,ob,i);return Math.max(0,Math.round(e))}return c.curCSS(a,b,d)},curCSS:function(a,b,d){var f,e=a.style;if(!c.support.opacity&&b==="opacity"&&a.currentStyle){f=Oa.test(a.currentStyle.filter||"")?parseFloat(RegExp.$1)/100+"":"";return f===""?"1":f}if(ha.test(b))b=Pa;if(!d&&e&&e[b])f=e[b];else if(rb){if(ha.test(b))b="float";b=b.replace(lb,"-$1").toLowerCase();e=a.ownerDocument.defaultView;if(!e)return null;if(a=e.getComputedStyle(a,null))f= 118 | a.getPropertyValue(b);if(b==="opacity"&&f==="")f="1"}else if(a.currentStyle){d=b.replace(ia,ja);f=a.currentStyle[b]||a.currentStyle[d];if(!mb.test(f)&&nb.test(f)){b=e.left;var j=a.runtimeStyle.left;a.runtimeStyle.left=a.currentStyle.left;e.left=d==="fontSize"?"1em":f||0;f=e.pixelLeft+"px";e.left=b;a.runtimeStyle.left=j}}return f},swap:function(a,b,d){var f={};for(var e in b){f[e]=a.style[e];a.style[e]=b[e]}d.call(a);for(e in b)a.style[e]=f[e]}});if(c.expr&&c.expr.filters){c.expr.filters.hidden=function(a){var b= 119 | a.offsetWidth,d=a.offsetHeight,f=a.nodeName.toLowerCase()==="tr";return b===0&&d===0&&!f?true:b>0&&d>0&&!f?false:c.curCSS(a,"display")==="none"};c.expr.filters.visible=function(a){return!c.expr.filters.hidden(a)}}var sb=J(),tb=//gi,ub=/select|textarea/i,vb=/color|date|datetime|email|hidden|month|number|password|range|search|tel|text|time|url|week/i,N=/=\?(&|$)/,ka=/\?/,wb=/(\?|&)_=.*?(&|$)/,xb=/^(\w+:)?\/\/([^\/?#]+)/,yb=/%20/g,zb=c.fn.load;c.fn.extend({load:function(a,b,d){if(typeof a!== 120 | "string")return zb.call(this,a);else if(!this.length)return this;var f=a.indexOf(" ");if(f>=0){var e=a.slice(f,a.length);a=a.slice(0,f)}f="GET";if(b)if(c.isFunction(b)){d=b;b=null}else if(typeof b==="object"){b=c.param(b,c.ajaxSettings.traditional);f="POST"}var j=this;c.ajax({url:a,type:f,dataType:"html",data:b,complete:function(i,o){if(o==="success"||o==="notmodified")j.html(e?c("
").append(i.responseText.replace(tb,"")).find(e):i.responseText);d&&j.each(d,[i.responseText,o,i])}});return this}, 121 | serialize:function(){return c.param(this.serializeArray())},serializeArray:function(){return this.map(function(){return this.elements?c.makeArray(this.elements):this}).filter(function(){return this.name&&!this.disabled&&(this.checked||ub.test(this.nodeName)||vb.test(this.type))}).map(function(a,b){a=c(this).val();return a==null?null:c.isArray(a)?c.map(a,function(d){return{name:b.name,value:d}}):{name:b.name,value:a}}).get()}});c.each("ajaxStart ajaxStop ajaxComplete ajaxError ajaxSuccess ajaxSend".split(" "), 122 | function(a,b){c.fn[b]=function(d){return this.bind(b,d)}});c.extend({get:function(a,b,d,f){if(c.isFunction(b)){f=f||d;d=b;b=null}return c.ajax({type:"GET",url:a,data:b,success:d,dataType:f})},getScript:function(a,b){return c.get(a,null,b,"script")},getJSON:function(a,b,d){return c.get(a,b,d,"json")},post:function(a,b,d,f){if(c.isFunction(b)){f=f||d;d=b;b={}}return c.ajax({type:"POST",url:a,data:b,success:d,dataType:f})},ajaxSetup:function(a){c.extend(c.ajaxSettings,a)},ajaxSettings:{url:location.href, 123 | global:true,type:"GET",contentType:"application/x-www-form-urlencoded",processData:true,async:true,xhr:A.XMLHttpRequest&&(A.location.protocol!=="file:"||!A.ActiveXObject)?function(){return new A.XMLHttpRequest}:function(){try{return new A.ActiveXObject("Microsoft.XMLHTTP")}catch(a){}},accepts:{xml:"application/xml, text/xml",html:"text/html",script:"text/javascript, application/javascript",json:"application/json, text/javascript",text:"text/plain",_default:"*/*"}},lastModified:{},etag:{},ajax:function(a){function b(){e.success&& 124 | e.success.call(k,o,i,x);e.global&&f("ajaxSuccess",[x,e])}function d(){e.complete&&e.complete.call(k,x,i);e.global&&f("ajaxComplete",[x,e]);e.global&&!--c.active&&c.event.trigger("ajaxStop")}function f(q,p){(e.context?c(e.context):c.event).trigger(q,p)}var e=c.extend(true,{},c.ajaxSettings,a),j,i,o,k=a&&a.context||e,n=e.type.toUpperCase();if(e.data&&e.processData&&typeof e.data!=="string")e.data=c.param(e.data,e.traditional);if(e.dataType==="jsonp"){if(n==="GET")N.test(e.url)||(e.url+=(ka.test(e.url)? 125 | "&":"?")+(e.jsonp||"callback")+"=?");else if(!e.data||!N.test(e.data))e.data=(e.data?e.data+"&":"")+(e.jsonp||"callback")+"=?";e.dataType="json"}if(e.dataType==="json"&&(e.data&&N.test(e.data)||N.test(e.url))){j=e.jsonpCallback||"jsonp"+sb++;if(e.data)e.data=(e.data+"").replace(N,"="+j+"$1");e.url=e.url.replace(N,"="+j+"$1");e.dataType="script";A[j]=A[j]||function(q){o=q;b();d();A[j]=w;try{delete A[j]}catch(p){}z&&z.removeChild(C)}}if(e.dataType==="script"&&e.cache===null)e.cache=false;if(e.cache=== 126 | false&&n==="GET"){var r=J(),u=e.url.replace(wb,"$1_="+r+"$2");e.url=u+(u===e.url?(ka.test(e.url)?"&":"?")+"_="+r:"")}if(e.data&&n==="GET")e.url+=(ka.test(e.url)?"&":"?")+e.data;e.global&&!c.active++&&c.event.trigger("ajaxStart");r=(r=xb.exec(e.url))&&(r[1]&&r[1]!==location.protocol||r[2]!==location.host);if(e.dataType==="script"&&n==="GET"&&r){var z=s.getElementsByTagName("head")[0]||s.documentElement,C=s.createElement("script");C.src=e.url;if(e.scriptCharset)C.charset=e.scriptCharset;if(!j){var B= 127 | false;C.onload=C.onreadystatechange=function(){if(!B&&(!this.readyState||this.readyState==="loaded"||this.readyState==="complete")){B=true;b();d();C.onload=C.onreadystatechange=null;z&&C.parentNode&&z.removeChild(C)}}}z.insertBefore(C,z.firstChild);return w}var E=false,x=e.xhr();if(x){e.username?x.open(n,e.url,e.async,e.username,e.password):x.open(n,e.url,e.async);try{if(e.data||a&&a.contentType)x.setRequestHeader("Content-Type",e.contentType);if(e.ifModified){c.lastModified[e.url]&&x.setRequestHeader("If-Modified-Since", 128 | c.lastModified[e.url]);c.etag[e.url]&&x.setRequestHeader("If-None-Match",c.etag[e.url])}r||x.setRequestHeader("X-Requested-With","XMLHttpRequest");x.setRequestHeader("Accept",e.dataType&&e.accepts[e.dataType]?e.accepts[e.dataType]+", */*":e.accepts._default)}catch(ga){}if(e.beforeSend&&e.beforeSend.call(k,x,e)===false){e.global&&!--c.active&&c.event.trigger("ajaxStop");x.abort();return false}e.global&&f("ajaxSend",[x,e]);var g=x.onreadystatechange=function(q){if(!x||x.readyState===0||q==="abort"){E|| 129 | d();E=true;if(x)x.onreadystatechange=c.noop}else if(!E&&x&&(x.readyState===4||q==="timeout")){E=true;x.onreadystatechange=c.noop;i=q==="timeout"?"timeout":!c.httpSuccess(x)?"error":e.ifModified&&c.httpNotModified(x,e.url)?"notmodified":"success";var p;if(i==="success")try{o=c.httpData(x,e.dataType,e)}catch(v){i="parsererror";p=v}if(i==="success"||i==="notmodified")j||b();else c.handleError(e,x,i,p);d();q==="timeout"&&x.abort();if(e.async)x=null}};try{var h=x.abort;x.abort=function(){x&&h.call(x); 130 | g("abort")}}catch(l){}e.async&&e.timeout>0&&setTimeout(function(){x&&!E&&g("timeout")},e.timeout);try{x.send(n==="POST"||n==="PUT"||n==="DELETE"?e.data:null)}catch(m){c.handleError(e,x,null,m);d()}e.async||g();return x}},handleError:function(a,b,d,f){if(a.error)a.error.call(a.context||a,b,d,f);if(a.global)(a.context?c(a.context):c.event).trigger("ajaxError",[b,a,f])},active:0,httpSuccess:function(a){try{return!a.status&&location.protocol==="file:"||a.status>=200&&a.status<300||a.status===304||a.status=== 131 | 1223||a.status===0}catch(b){}return false},httpNotModified:function(a,b){var d=a.getResponseHeader("Last-Modified"),f=a.getResponseHeader("Etag");if(d)c.lastModified[b]=d;if(f)c.etag[b]=f;return a.status===304||a.status===0},httpData:function(a,b,d){var f=a.getResponseHeader("content-type")||"",e=b==="xml"||!b&&f.indexOf("xml")>=0;a=e?a.responseXML:a.responseText;e&&a.documentElement.nodeName==="parsererror"&&c.error("parsererror");if(d&&d.dataFilter)a=d.dataFilter(a,b);if(typeof a==="string")if(b=== 132 | "json"||!b&&f.indexOf("json")>=0)a=c.parseJSON(a);else if(b==="script"||!b&&f.indexOf("javascript")>=0)c.globalEval(a);return a},param:function(a,b){function d(i,o){if(c.isArray(o))c.each(o,function(k,n){b||/\[\]$/.test(i)?f(i,n):d(i+"["+(typeof n==="object"||c.isArray(n)?k:"")+"]",n)});else!b&&o!=null&&typeof o==="object"?c.each(o,function(k,n){d(i+"["+k+"]",n)}):f(i,o)}function f(i,o){o=c.isFunction(o)?o():o;e[e.length]=encodeURIComponent(i)+"="+encodeURIComponent(o)}var e=[];if(b===w)b=c.ajaxSettings.traditional; 133 | if(c.isArray(a)||a.jquery)c.each(a,function(){f(this.name,this.value)});else for(var j in a)d(j,a[j]);return e.join("&").replace(yb,"+")}});var la={},Ab=/toggle|show|hide/,Bb=/^([+-]=)?([\d+-.]+)(.*)$/,W,va=[["height","marginTop","marginBottom","paddingTop","paddingBottom"],["width","marginLeft","marginRight","paddingLeft","paddingRight"],["opacity"]];c.fn.extend({show:function(a,b){if(a||a===0)return this.animate(K("show",3),a,b);else{a=0;for(b=this.length;a").appendTo("body");f=e.css("display");if(f==="none")f="block";e.remove();la[d]=f}c.data(this[a],"olddisplay",f)}}a=0;for(b=this.length;a=0;f--)if(d[f].elem===this){b&&d[f](true);d.splice(f,1)}});b||this.dequeue();return this}});c.each({slideDown:K("show",1),slideUp:K("hide",1),slideToggle:K("toggle",1),fadeIn:{opacity:"show"},fadeOut:{opacity:"hide"}},function(a,b){c.fn[a]=function(d,f){return this.animate(b,d,f)}});c.extend({speed:function(a,b,d){var f=a&&typeof a==="object"?a:{complete:d||!d&&b||c.isFunction(a)&&a,duration:a,easing:d&&b||b&&!c.isFunction(b)&&b};f.duration=c.fx.off?0:typeof f.duration=== 139 | "number"?f.duration:c.fx.speeds[f.duration]||c.fx.speeds._default;f.old=f.complete;f.complete=function(){f.queue!==false&&c(this).dequeue();c.isFunction(f.old)&&f.old.call(this)};return f},easing:{linear:function(a,b,d,f){return d+f*a},swing:function(a,b,d,f){return(-Math.cos(a*Math.PI)/2+0.5)*f+d}},timers:[],fx:function(a,b,d){this.options=b;this.elem=a;this.prop=d;if(!b.orig)b.orig={}}});c.fx.prototype={update:function(){this.options.step&&this.options.step.call(this.elem,this.now,this);(c.fx.step[this.prop]|| 140 | c.fx.step._default)(this);if((this.prop==="height"||this.prop==="width")&&this.elem.style)this.elem.style.display="block"},cur:function(a){if(this.elem[this.prop]!=null&&(!this.elem.style||this.elem.style[this.prop]==null))return this.elem[this.prop];return(a=parseFloat(c.css(this.elem,this.prop,a)))&&a>-10000?a:parseFloat(c.curCSS(this.elem,this.prop))||0},custom:function(a,b,d){function f(j){return e.step(j)}this.startTime=J();this.start=a;this.end=b;this.unit=d||this.unit||"px";this.now=this.start; 141 | this.pos=this.state=0;var e=this;f.elem=this.elem;if(f()&&c.timers.push(f)&&!W)W=setInterval(c.fx.tick,13)},show:function(){this.options.orig[this.prop]=c.style(this.elem,this.prop);this.options.show=true;this.custom(this.prop==="width"||this.prop==="height"?1:0,this.cur());c(this.elem).show()},hide:function(){this.options.orig[this.prop]=c.style(this.elem,this.prop);this.options.hide=true;this.custom(this.cur(),0)},step:function(a){var b=J(),d=true;if(a||b>=this.options.duration+this.startTime){this.now= 142 | this.end;this.pos=this.state=1;this.update();this.options.curAnim[this.prop]=true;for(var f in this.options.curAnim)if(this.options.curAnim[f]!==true)d=false;if(d){if(this.options.display!=null){this.elem.style.overflow=this.options.overflow;a=c.data(this.elem,"olddisplay");this.elem.style.display=a?a:this.options.display;if(c.css(this.elem,"display")==="none")this.elem.style.display="block"}this.options.hide&&c(this.elem).hide();if(this.options.hide||this.options.show)for(var e in this.options.curAnim)c.style(this.elem, 143 | e,this.options.orig[e]);this.options.complete.call(this.elem)}return false}else{e=b-this.startTime;this.state=e/this.options.duration;a=this.options.easing||(c.easing.swing?"swing":"linear");this.pos=c.easing[this.options.specialEasing&&this.options.specialEasing[this.prop]||a](this.state,e,0,1,this.options.duration);this.now=this.start+(this.end-this.start)*this.pos;this.update()}return true}};c.extend(c.fx,{tick:function(){for(var a=c.timers,b=0;b
"; 149 | a.insertBefore(b,a.firstChild);d=b.firstChild;f=d.firstChild;e=d.nextSibling.firstChild.firstChild;this.doesNotAddBorder=f.offsetTop!==5;this.doesAddBorderForTableAndCells=e.offsetTop===5;f.style.position="fixed";f.style.top="20px";this.supportsFixedPosition=f.offsetTop===20||f.offsetTop===15;f.style.position=f.style.top="";d.style.overflow="hidden";d.style.position="relative";this.subtractsBorderForOverflowNotVisible=f.offsetTop===-5;this.doesNotIncludeMarginInBodyOffset=a.offsetTop!==j;a.removeChild(b); 150 | c.offset.initialize=c.noop},bodyOffset:function(a){var b=a.offsetTop,d=a.offsetLeft;c.offset.initialize();if(c.offset.doesNotIncludeMarginInBodyOffset){b+=parseFloat(c.curCSS(a,"marginTop",true))||0;d+=parseFloat(c.curCSS(a,"marginLeft",true))||0}return{top:b,left:d}},setOffset:function(a,b,d){if(/static/.test(c.curCSS(a,"position")))a.style.position="relative";var f=c(a),e=f.offset(),j=parseInt(c.curCSS(a,"top",true),10)||0,i=parseInt(c.curCSS(a,"left",true),10)||0;if(c.isFunction(b))b=b.call(a, 151 | d,e);d={top:b.top-e.top+j,left:b.left-e.left+i};"using"in b?b.using.call(a,d):f.css(d)}};c.fn.extend({position:function(){if(!this[0])return null;var a=this[0],b=this.offsetParent(),d=this.offset(),f=/^body|html$/i.test(b[0].nodeName)?{top:0,left:0}:b.offset();d.top-=parseFloat(c.curCSS(a,"marginTop",true))||0;d.left-=parseFloat(c.curCSS(a,"marginLeft",true))||0;f.top+=parseFloat(c.curCSS(b[0],"borderTopWidth",true))||0;f.left+=parseFloat(c.curCSS(b[0],"borderLeftWidth",true))||0;return{top:d.top- 152 | f.top,left:d.left-f.left}},offsetParent:function(){return this.map(function(){for(var a=this.offsetParent||s.body;a&&!/^body|html$/i.test(a.nodeName)&&c.css(a,"position")==="static";)a=a.offsetParent;return a})}});c.each(["Left","Top"],function(a,b){var d="scroll"+b;c.fn[d]=function(f){var e=this[0],j;if(!e)return null;if(f!==w)return this.each(function(){if(j=wa(this))j.scrollTo(!a?f:c(j).scrollLeft(),a?f:c(j).scrollTop());else this[d]=f});else return(j=wa(e))?"pageXOffset"in j?j[a?"pageYOffset": 153 | "pageXOffset"]:c.support.boxModel&&j.document.documentElement[d]||j.document.body[d]:e[d]}});c.each(["Height","Width"],function(a,b){var d=b.toLowerCase();c.fn["inner"+b]=function(){return this[0]?c.css(this[0],d,false,"padding"):null};c.fn["outer"+b]=function(f){return this[0]?c.css(this[0],d,false,f?"margin":"border"):null};c.fn[d]=function(f){var e=this[0];if(!e)return f==null?null:this;if(c.isFunction(f))return this.each(function(j){var i=c(this);i[d](f.call(this,j,i[d]()))});return"scrollTo"in 154 | e&&e.document?e.document.compatMode==="CSS1Compat"&&e.document.documentElement["client"+b]||e.document.body["client"+b]:e.nodeType===9?Math.max(e.documentElement["client"+b],e.body["scroll"+b],e.documentElement["scroll"+b],e.body["offset"+b],e.documentElement["offset"+b]):f===w?c.css(e,d):this.css(d,typeof f==="string"?f:f+"px")}});A.jQuery=A.$=c})(window); 155 | -------------------------------------------------------------------------------- /std_hilite/spec_highlight: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | use English; 6 | use feature qw(say); 7 | use Benchmark; 8 | use File::Path; 9 | use File::Basename; 10 | use File::Copy; 11 | use Cwd; 12 | use POSIX qw(nice); 13 | 14 | 15 | sub MAIN { 16 | 17 | #let us play nice with others 18 | nice(19); 19 | 20 | print <<"WARNING"; 21 | 22 | My job is to run STD_syntax_highlight over all the tests in t/. 23 | 24 | You can press CTRL-C when you feel bored. 25 | 26 | WARNING 27 | 28 | #sanity check: working directory should end with src/perl6 29 | my $cwd = getcwd(); 30 | unless($cwd =~ m{src/perl6$}) { 31 | die "Please run $PROGRAM_NAME in src/perl6\n"; 32 | } 33 | 34 | #sanity check: make sure STD.pm is correctly built 35 | unless(-r 'STD.pmc') { 36 | die "Could not find 'STD.pmc'. Maybe your forgot to 'make'\n"; 37 | } 38 | 39 | #sanity check: make sure unicode will work with your locale 40 | unless($ENV{LANG} =~ /\.UTF-8$/) { 41 | die "Unicode will not work. Please set your LANG environment variable.\n" . 42 | "(e.g. 'export LANG=en_US.UTF-8' in your ~/.bashrc)"; 43 | } 44 | 45 | #make sure that the output html directory is there 46 | unless(-d 'html') { 47 | print "Creating html directory...\n"; 48 | mkdir 'html' or die "Could not create html directory\n"; 49 | } 50 | 51 | my $dir_to_test = '../../t/'; 52 | my $fail = 0; 53 | my $success = 0; 54 | say "Finding *.t in $dir_to_test... Please wait"; 55 | my @files = sort `find $dir_to_test -name '*.t'`; 56 | chomp(@files); 57 | $OUTPUT_AUTOFLUSH = 1; 58 | 59 | my $total = 0+@files; 60 | say "Going to run $total tests... Maybe watch a movie meanwhile?"; 61 | 62 | my $HILITE = "std_hilite/STD_syntax_highlight"; 63 | my $JQUERY_JS = "jquery-1.4.2.min.js"; 64 | my $start_time = new Benchmark; 65 | my @failed; 66 | for my $file (@files) { 67 | my $myfile = $file; 68 | $myfile =~ s/^\.\.\/\.\.\/t/html/; 69 | my ($simple_html,$snippet_html, $full_html) = ( 70 | "$myfile.simple.html", 71 | "$myfile.snippet.html", 72 | "$myfile.html"); 73 | my ($html_filename,$html_path,$html_suffix) = fileparse($full_html); 74 | mkpath $html_path; 75 | 76 | my $dir = dirname(dirname($myfile)); 77 | copy_resource("std_hilite/$JQUERY_JS", $dir); 78 | copy_resource("std_hilite/$HILITE.js", $dir); 79 | copy_resource("std_hilite/$HILITE.css", $dir); 80 | 81 | #run the process and time it 82 | print <<"OUT"; 83 | 84 | $file 85 | -> $full_html 86 | -> $simple_html 87 | -> $snippet_html 88 | OUT 89 | my $t0 = new Benchmark; 90 | my $cmd = "./$HILITE --clean-html " . 91 | "--simple-html=$simple_html " . 92 | "--snippet-html=$snippet_html " . 93 | "--full-html=$full_html $file"; 94 | my $log = `$cmd 2>&1`; 95 | say "It took " . 96 | timestr(timediff(new Benchmark,$t0),"nop"); 97 | 98 | if ($CHILD_ERROR) { 99 | push(@failed,$file); 100 | $fail++; 101 | 102 | # let us write something useful into those htmls 103 | # when an error occurs 104 | write_error_html($simple_html, $file, $log, 1); 105 | write_error_html($snippet_html, $file, $log, 0); 106 | write_error_html($full_html, $file, $log, 1); 107 | 108 | say "error"; 109 | } else { 110 | $success++; 111 | say "ok"; 112 | } 113 | } 114 | 115 | printf "\nPassed $success/$total, %6.2f%%\n", $success/$total * 100; 116 | say "It took " . 117 | timestr(timediff(new Benchmark,$start_time),"noc"); 118 | 119 | if (@failed) { 120 | say "Failed tests:"; 121 | for my $file (@failed) { 122 | say $file; 123 | } 124 | } 125 | say "\nThe output is now in the html directory. Thanks for your time ;-)"; 126 | } 127 | 128 | # copy resource 129 | sub copy_resource { 130 | my ($src,$dir) = @_; 131 | my $dst = File::Spec->catfile( $dir, basename($src)); 132 | if(not -e $dst) { 133 | print "Copying $dst\n"; 134 | copy($src, $dst) or warn "WARN: Could not copy: $OS_ERROR\n"; 135 | } 136 | } 137 | 138 | 139 | # write the error log in the html file provided 140 | sub write_error_html { 141 | my ($html_file, $file, $log, $is_full) = @ARG; 142 | 143 | my $error_html = ""; 144 | if($is_full) { 145 | $error_html = "Error"; 146 | } 147 | 148 | $error_html .= <<"ERROR"; 149 | 
150 | 
151 | An error has occurred while processing this file:
152 | 
153 | filename: 
154 |     $file
155 | Reason:
156 |     $log
157 |
158 | ERROR 159 | 160 | if($is_full) { 161 | $error_html .= ""; 162 | } 163 | 164 | open FILE, ">$html_file" 165 | or die "Could not open $html_file for writing: $OS_ERROR\n"; 166 | print FILE $error_html; 167 | close FILE; 168 | } 169 | 170 | MAIN(@ARGV); 171 | 172 | -------------------------------------------------------------------------------- /tools/DumpMatch.pm: -------------------------------------------------------------------------------- 1 | package DumpMatch; 2 | use Term::ANSIColor; 3 | use strict; 4 | use warnings; 5 | 6 | use Exporter; 7 | 8 | our @ISA = 'Exporter'; 9 | our @EXPORT = qw(traverse_match dump_match); 10 | our @EXPORT_OK = qw(process_events); 11 | our $NOCOLOR; 12 | 13 | sub RESET() {$NOCOLOR ? '' : Term::ANSIColor::RESET()}; 14 | sub RED() {$NOCOLOR ? '' : Term::ANSIColor::RED() }; 15 | sub BLUE() {$NOCOLOR ? '' : Term::ANSIColor::BLUE() }; 16 | sub YELLOW() {$NOCOLOR ? '' : Term::ANSIColor::YELLOW() }; 17 | 18 | sub process_events { 19 | my ($orig,$events,$opt) = @_; 20 | my $str = ""; 21 | my $at = 0; 22 | my $indent=0; 23 | for (sort {$a->[0] <=> $b->[0] or $a->[4] <=> $b->[4]} @{$events}) { 24 | my $text = substr($orig,$at,$_->[0]-$at); 25 | if ($opt->{vertical}) { 26 | if ($text) { 27 | # not sure about that 28 | $text =~ s/\n/\\n/; 29 | $str .= " " x $indent . $text . "\n"; 30 | } 31 | } else { 32 | $str .= $text; 33 | } 34 | $at = $_->[0]; 35 | 36 | if ($_->[1] eq 'from') { 37 | if ($opt->{vertical}) { 38 | $str .= " " x $indent . BLUE.$_->[2].RED.":".RESET."\n"; 39 | $str .= " " x $indent . YELLOW.$opt->{actions}->($_->[3]->{''}).RESET."\n" if $opt->{actions} && $_->[3]->{''}; 40 | $indent++; 41 | } else { 42 | $str .= RED."<".BLUE.$_->[2].RED.">".RESET; 43 | } 44 | } elsif ($_->[1] eq 'to') { 45 | if ($opt->{vertical}) { 46 | $indent--; 47 | } else { 48 | $str .= RED."[2].RED.">".RESET; 49 | } 50 | } 51 | } 52 | $str; 53 | } 54 | our %seen; 55 | sub traverse_match { 56 | my ($r,$label,$depth,$events,$opt) = @_; 57 | 58 | 59 | return unless ref $r && ref $r ne 'SCALAR' && ref $r ne 'ARRAY'; 60 | 61 | if (defined $r->{_from}) { 62 | if ($r->{_from} == $r->{_to}) { 63 | push(@{$events},[$r->{_from},'empty',$label,$r,$depth]); 64 | } else { 65 | push(@{$events},[$r->{_from},'from',$label,$r,$depth]); 66 | push(@{$events},[$r->{_to},'to',$label,$r,-$depth]); 67 | } 68 | } 69 | return if $seen{$r};$seen{$r}++; 70 | for my $name (keys %$r) { 71 | next if $name eq ''; 72 | my $v = $r->{$name}; 73 | if (ref $v eq 'ARRAY') { 74 | $name = "[$name]" if $opt->{mark_arrays}; 75 | for my $i (0 .. scalar @{$v}) { 76 | traverse_match($v->[$i],$name,$depth+1,$events,$opt); 77 | } 78 | } elsif (ref $v eq 'SCALAR') { 79 | } elsif (ref $v) { 80 | traverse_match($v,$name,$depth+1,$events,$opt); 81 | } else { 82 | } 83 | } 84 | } 85 | sub dump_match { 86 | my $name = shift; 87 | my $r = shift; 88 | my $opt = shift || {}; 89 | my $events = []; 90 | local %seen; 91 | traverse_match($r,$name,0,$events,$opt); 92 | process_events($ORIG,$events,$opt); 93 | } 94 | 1; 95 | -------------------------------------------------------------------------------- /tools/STD5_dump_match: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use STD; 4 | use DumpMatch; 5 | use utf8; 6 | use YAML::XS; 7 | use Encode; 8 | use strict; 9 | use warnings; 10 | use Getopt::Long; 11 | my $nocolor = 0; 12 | my $horizontal = 0; 13 | my $yaml = 0; 14 | my $mark_arrays; 15 | GetOptions("nocolor"=>\$nocolor,"horizontal"=>\$horizontal,"yaml"=>\$yaml,"mark-arrays"=>\$mark_arrays); 16 | unless ($#ARGV <= 0) { 17 | die "USAGE: [--nocolor --horizontal --mark-arrays] filename [rule]\n"; 18 | } 19 | if ($nocolor) { 20 | $DumpMatch::NOCOLOR = 1; 21 | } 22 | my $file = shift; 23 | my $what = shift // 'comp_unit'; 24 | 25 | my $r = STD->parsefile($file,$what); 26 | if ($yaml) { 27 | print Dump($r); 28 | exit; 29 | } else { 30 | print dump_match($what=>$r,{vertical=>!$horizontal,mark_arrays=>$mark_arrays,visit_twice=>1}),"\n"; 31 | } 32 | 33 | -------------------------------------------------------------------------------- /tools/cleanlex.pl: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl -p 2 | s/__S_\d\d\d/__S_/g; s/([a-z]+)_\d+/$1/g; s/FATE\d+/FATE/g; 3 | -------------------------------------------------------------------------------- /tools/compact_pmc: -------------------------------------------------------------------------------- 1 | # would be a one liner, but platform quoting screws this up 2 | while (defined ($_ = <>)) { 3 | (/^---/../^RETREE_END/) || s/^ *//; 4 | print; 5 | } 6 | -------------------------------------------------------------------------------- /tools/gen-unicode-table.pl: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | use 5.012; # unicore format is unstable 3 | use strict; 4 | use warnings; 5 | use autodie; 6 | 7 | my @tables = (qw|Gc/N Gc/L Perl/Blank Space/Y Perl/VertSpac|); 8 | 9 | open DUMP, ">", "uniprops"; 10 | binmode DUMP; 11 | 12 | for my $propname (@tables) { 13 | my @top = (("\0" x 128) x 1088); 14 | my $used = "\0" x 136; 15 | for my $l (split("\n", (do "unicore/lib/$propname.pl"))) { 16 | my ($from, $to) = split("\t", $l); 17 | $from = hex $from; 18 | $to = hex $to || $from; 19 | 20 | for (my $x = $from; $x <= $to; $x++) { 21 | vec($top[$x >> 10], $x & 1023, 1) = 1; 22 | vec($used, $x >> 10, 1) = 1; 23 | } 24 | } 25 | 26 | print DUMP chr(length($propname)); 27 | print DUMP $propname; 28 | print DUMP $used; 29 | for (my $i = 0; $i < 1088; $i++) { 30 | if (vec($used, $i, 1)) { 31 | print DUMP $top[$i]; 32 | } 33 | } 34 | } 35 | 36 | close DUMP; 37 | -------------------------------------------------------------------------------- /tools/reds: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use FindBin; 4 | BEGIN { unshift @INC, $FindBin::Bin if -s "$FindBin::Bin/STD.pmc"; } 5 | 6 | use strict; 7 | use warnings; 8 | 9 | use STD; 10 | use utf8; 11 | use feature 'say'; 12 | 13 | $::ACTIONS = 'Actions'; 14 | 15 | sub MAIN { 16 | my $output = 'ast'; 17 | 18 | STD->parsefile($_[0]); 19 | } 20 | 21 | ################################################################### 22 | 23 | { package Actions; 24 | 25 | our $AUTOLOAD; 26 | 27 | sub AUTOLOAD { 28 | my $self = shift; 29 | my $C = shift; 30 | my $F = $C->{_from}; 31 | my $P = $C->{_pos}; 32 | $AUTOLOAD =~ s/^Actions:://; 33 | say "$AUTOLOAD $F $P"; 34 | } 35 | } 36 | 37 | MAIN(@ARGV); 38 | -------------------------------------------------------------------------------- /tools/redspans: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use FindBin; 4 | BEGIN { unshift @INC, $FindBin::Bin if -s "$FindBin::Bin/STD.pmc"; } 5 | 6 | use strict; 7 | use warnings; 8 | 9 | use STD; 10 | use utf8; 11 | use feature 'say'; 12 | 13 | #let us play nice with others 14 | use POSIX qw(nice); nice 19; 15 | 16 | my @loc; 17 | 18 | sub MAIN { 19 | my $output = 'ast'; 20 | my $file = shift; 21 | 22 | my $txt = Encode::decode('utf8', `cat $file`); 23 | $loc[length($txt) - 1] = []; 24 | 25 | STD->parsefile($file, actions => 'Actions'); 26 | 27 | my ($last_tree,$buffer) = ("",""); 28 | for my $i (0 .. @loc-1) { 29 | say("Undefined $i"),next unless defined $loc[$i]; 30 | my $c = substr($txt,$i,1); 31 | my $tree = ""; 32 | for my $action_ref (@{$loc[$i]}) { 33 | $tree .= ${$action_ref} . " "; 34 | } 35 | if($tree ne $last_tree) { 36 | say "\n'$buffer'\n$last_tree" if $buffer ne ''; 37 | $buffer = $c; 38 | } else { 39 | $buffer .= $c; 40 | } 41 | $last_tree = $tree; 42 | } 43 | } 44 | 45 | ################################################################### 46 | 47 | { package Actions; 48 | 49 | our $AUTOLOAD; 50 | my %actions = (); 51 | sub AUTOLOAD { 52 | my $self = shift; 53 | my $C = shift; 54 | my $F = $C->{_from}; 55 | my $P = $C->{_pos}; 56 | $AUTOLOAD =~ s/^Actions:://; 57 | $loc[$P] = [] if $loc[$P]; # in case we backtracked to here 58 | my $action = $AUTOLOAD; 59 | my $action_ref = $actions{$action}; 60 | if(!$action_ref) { 61 | $actions{$action} = $action_ref = \$action; 62 | } 63 | for ($F..$P-1) { 64 | unshift @{$loc[$_]}, $action_ref; 65 | } 66 | } 67 | 68 | sub stdstopper { } 69 | sub terminator { } 70 | sub unitstopper { } 71 | sub comp_unit { } 72 | } 73 | 74 | MAIN(@ARGV); 75 | 76 | # vim: ts=8 sw=4 77 | -------------------------------------------------------------------------------- /tools/setting: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use STD; 4 | use utf8; 5 | 6 | my $failures = 0; 7 | 8 | @ARGV = 'CORE.setting' unless @ARGV; 9 | 10 | for my $file (@ARGV) { 11 | warn $file,"\n" if @ARGV > 1; 12 | next unless -f $file; 13 | my $setting = "CORE"; 14 | $setting = "NULL" if $file =~ /CORE/; 15 | eval { 16 | warn "Undefined\n" unless defined STD->parsefile($file, setting => $setting); 17 | }; 18 | if ($@) { 19 | warn $@; 20 | $failures++; 21 | } 22 | } 23 | my ($time, $vsz) = split(' ', `ps -o "time= vsz=" $$`); 24 | $time =~ s/^00://; 25 | $vsz =~ s/\d\d\d$/m/; 26 | if ($failures) { 27 | if ($vsz) { 28 | warn "FAILED $time $vsz\n"; 29 | } 30 | else { 31 | warn "FAILED\n"; 32 | } 33 | exit $failures; 34 | } 35 | elsif ($vsz) { 36 | warn "ok $time $vsz\n"; 37 | } 38 | else { 39 | warn "ok\n"; 40 | } 41 | -------------------------------------------------------------------------------- /tools/show_changed_vars: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use Term::ANSIColor qw(:constants); 4 | use STD; 5 | use utf8; 6 | use YAML::XS; 7 | use Encode; 8 | use strict; 9 | use feature 'say'; 10 | my $fail = 0; 11 | 12 | my @files = sort `find ../roast/ -name '*.t'`; 13 | chomp(@files); 14 | $| = 1; 15 | 16 | our $foo = 2; 17 | our %foo = (a=>7); 18 | { package foo; 19 | our $foo = 1; 20 | } 21 | { package foo::bar; 22 | our $bar = 1; 23 | our %foo = (a=>6,b=>4); 24 | our %bar = (A=>6,B=>4); 25 | } 26 | { package foo::bar::baz; 27 | our $baz = 1; 28 | } 29 | sub traverse { 30 | my $package = shift; 31 | my $callback = shift; 32 | for (sort keys %{$package}) { 33 | next if /^main::$/; 34 | if (/::$/) { 35 | next if /^Config/; 36 | next if /^DB/; 37 | next if /^utf8/; 38 | #say "descending into $_"; 39 | traverse($package->{$_},$callback); 40 | #say "ascending"; 41 | } elsif ($package->{$_} =~ /^\*/) { 42 | #say "callback on $_:",$package->{$_},; 43 | $callback->($package->{$_}); 44 | } 45 | } 46 | } 47 | traverse(\%main::,sub { 48 | my $sym=shift; 49 | }); 50 | 51 | my %pristine; 52 | use Data::Dumper; 53 | traverse(\%main::,sub { 54 | my $sym=shift; 55 | $pristine{'$'.$sym} = Dumper(*{$sym}{SCALAR}); 56 | $pristine{'%'.$sym} = Dumper(*{$sym}{HASH}); 57 | $pristine{'@'.$sym} = Dumper(*{$sym}{ARRAY}); 58 | }); 59 | #warn Dumper(\%pristine); 60 | 61 | my $dump_limit = 100; 62 | sub part { 63 | return $_[0] if length $_[0] < $dump_limit+3; 64 | return substr($_[0],0,$dump_limit)."..."; 65 | } 66 | sub check { 67 | my ($name,$what_raw) = @_; 68 | my $what = Dumper($what_raw); 69 | if (!$what_raw || (ref $what_raw eq 'SCALAR' && !${$what_raw})) { 70 | next unless $pristine{$name}; 71 | #say RED,"undefined $name\n",RESET; 72 | } 73 | say YELLOW,$name,RESET,":",RED," ",part($what),RESET," ne ",GREEN,part($pristine{$name}),RESET unless $pristine{$name} eq $what; 74 | } 75 | sub globals { 76 | traverse(\%main::,sub { 77 | my $sym=shift; 78 | check(('%'.$sym),*{$sym}{HASH}); 79 | #check(('@'.$sym),*{$sym}{HASH}); 80 | check(('$'.$sym),*{$sym}{SCALAR}); 81 | }); 82 | } 83 | 84 | #$foo::bar::foo{asadas} = 123; 85 | #globals; 86 | my $total = 0+@files; 87 | for my $file (@files) { 88 | $::HIGHWATER = 0; 89 | %{$::HIGHEXPECT} = (); 90 | %CursorBase::lexers = (); 91 | globals; 92 | print $file, "..."; 93 | #system "./tryfile $file >tryfile.out"; 94 | 95 | eval { 96 | my $what = 'comp_unit'; 97 | my $text = Encode::decode('utf8', `cat $file`); 98 | my $r = Perl->new($text)->$what(); 99 | }; 100 | if ($@) { 101 | $fail++; 102 | die if $fail > 1; 103 | warn; 104 | } else { 105 | print "ok\n"; 106 | } 107 | } 108 | 109 | print "Failed $fail/$total, ", int $fail/$total * 100, "%\n"; 110 | -------------------------------------------------------------------------------- /tools/sprixel_csv.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use v5.010; 4 | 5 | use Actions; 6 | use STD; 7 | use Encode; 8 | use Scalar::Util qw( blessed reftype refaddr ); 9 | use File::Slurp; 10 | no warnings; 11 | 12 | my $PROG = ''; 13 | my $setting = 'CORE'; 14 | 15 | my $r; 16 | if (@ARGV and -f $ARGV[0]) { 17 | $PROG = read_file($ARGV[0]); 18 | $r = STD->parsefile($ARGV[0], setting => $setting); 19 | } elsif (@ARGV) { 20 | $PROG = $ARGV[1] || $ARGV[0]; 21 | $r = STD->parse($PROG, setting => $setting); 22 | } else { 23 | local $/; 24 | $PROG = <>; 25 | $PROG = $PROG; 26 | $r = STD->parse($PROG, setting => $setting); 27 | } 28 | $r->{'stabs'} = $STD::ALL; 29 | 30 | sub str_esc { 31 | my $out = shift; 32 | $out =~ s/([\\"])/\\$1/g; 33 | $out =~ s/\n/\\n/mg; 34 | return '"' . $out . '"'; 35 | } 36 | 37 | 38 | sub tps { 39 | my $str = Encode::decode_utf8(shift); 40 | return '""' unless defined $str; 41 | return '"'.$1.'"' if $str =~ /\(0x(\w+)/; 42 | $str =~ s/^VAST:://; 43 | return $str if (!(shift || 0) && $str =~ /^[\w_]+$/); 44 | $str =~ s/([\\"])/\\$1/g; 45 | $str =~ s/\n/\\n/mg; 46 | return '"'.$str.'"'; 47 | } 48 | 49 | my %idmap = (); 50 | my $lastid = 2; 51 | my %seen = (); 52 | my %torun = (); 53 | 54 | sub emit_csv { 55 | say "0," . str_esc($PROG) . ",1"; 56 | emit_csv_recurse($_[0]); 57 | } 58 | 59 | { package Array; } 60 | 61 | sub get_obj_id { 62 | return $idmap{refaddr(shift)} //= ++$lastid; 63 | } 64 | 65 | sub emit_csv_recurse { 66 | my ($self, $parent) = @_; 67 | unless(ref $self) { 68 | say ++$lastid . ',' . tps($self,1) . ",$parent"; 69 | return; 70 | } 71 | 72 | my $addr = get_obj_id($self); 73 | if (exists $seen{$addr}) { 74 | if (defined $parent) { 75 | say "2,$addr,$parent"; 76 | } 77 | return; 78 | } 79 | $seen{$addr} = 1; 80 | say "$addr," . (ref $self) . ',' . ($parent // '""'); 81 | for my $prop (keys %$self) { 82 | next if !defined $self->{$prop} || $prop eq '.' || $prop eq '_xact'; 83 | my $p = $self->{$prop}; 84 | my $reftype; 85 | if ($reftype = reftype($p)) { 86 | my $ra = get_obj_id($p); 87 | if ('ARRAY' eq $reftype) { 88 | my $z = $p; 89 | $p = $self->{$prop} = bless { '.' => $p }, 'Array'; 90 | if (scalar @$z) { 91 | my $oid = get_obj_id($p); 92 | say '1,' . tps($prop) . ',' . $oid; 93 | $torun{$oid} = $p; 94 | } 95 | } elsif ('HASH' eq $reftype) { 96 | say '1,' . tps($prop) . ',' . $ra; 97 | $torun{$ra} = $p; 98 | } else { 99 | say '1,' . tps($prop) . ',' . tps($p); 100 | } 101 | } else { 102 | say '0,' . tps($prop) . ',' . tps($p); 103 | } 104 | } 105 | if (defined $self->{'.'}) { 106 | for my $kid (@{$self->{'.'}}) { 107 | emit_csv_recurse($kid, $addr); 108 | } 109 | } 110 | } 111 | 112 | emit_csv( $r ); 113 | while (scalar keys %torun) { 114 | my @tor = keys %torun; 115 | for my $kidkey (@tor) { 116 | emit_csv_recurse( $torun{$kidkey} ); 117 | delete $torun{$kidkey}; 118 | } 119 | } 120 | 121 | 122 | 1; 123 | -------------------------------------------------------------------------------- /tools/teststd: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | use English; 6 | 7 | print <tryfile.out"; 34 | if ($CHILD_ERROR) { 35 | push(@failed,$short); 36 | $fail++; 37 | # catch those pesky CTRL-Cs 38 | if($CHILD_ERROR &= 127) { 39 | print "CTRL-C detected... bye bye\n"; 40 | last; 41 | } 42 | } 43 | else { 44 | $success++; 45 | } 46 | } 47 | 48 | printf "Passed $success/$total, %6.2f%%\n", $success/$total * 100; 49 | if (@failed) { 50 | print "Failed tests:\n"; 51 | for my $file (@failed) { 52 | print "$file\n"; 53 | } 54 | } 55 | -------------------------------------------------------------------------------- /tools/tlong: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use 5.10.0; 3 | 4 | BEGIN { $ENV{STD5DEBUG} = -1; } 5 | binmode(STDIN, ":utf8"); 6 | binmode(STDOUT, ":utf8"); 7 | use STD; 8 | use utf8; 9 | use YAML::XS; 10 | use Encode; 11 | $/ = "\n\n"; 12 | 13 | while (<>) { 14 | my $r = eval { STD->parse($_) }; 15 | print $@ if $@; 16 | say "ok" if $r; 17 | print "=========================\n"; 18 | } 19 | -------------------------------------------------------------------------------- /tools/tloop: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use 5.10.0; 3 | 4 | use FindBin; 5 | BEGIN { unshift @INC, $FindBin::Bin if -s "$FindBin::Bin/STD.pmc"; } 6 | 7 | BEGIN { $ENV{STD5DEBUG} = -1; } 8 | use STD; 9 | use utf8; 10 | use YAML::XS; 11 | use Encode; 12 | use Term::ReadLine; 13 | my $term = new Term::ReadLine 'STD non-repl'; 14 | my $prompt = " "; 15 | my $OUT = $term->OUT || \*STDOUT; 16 | while ( defined ($_ = $term->readline($prompt)) ) { 17 | my $text = Encode::decode("UTF-8", $_); 18 | my $r = eval { STD->parse($text) }; 19 | print $@ if $@; 20 | say "ok" if $r; 21 | say "\n\n\n"; 22 | $term->addhistory($_) if /\S/; 23 | } 24 | -------------------------------------------------------------------------------- /tools/try5: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # A script to make running STD.pmc easier, 3 | # by providing it input, and isolating it's Match yaml output. 4 | use strict; 5 | use warnings; 6 | 7 | sub print_usage_and_exit { 8 | print STDERR <<"END"; exit(2); 9 | $0 [-fo] GRAMMAR_RULE [ INPUT_FILE | -e INPUT ] 10 | 11 | Examples: 12 | $0 noun -e 42 13 | END 14 | } 15 | 16 | my $fo = ''; 17 | $fo = shift if $ARGV[0] eq '-fo'; 18 | 19 | sub main { 20 | print_usage_and_exit if @ARGV < 2 || $ARGV[0] eq '--help'; 21 | my $rule = shift(@ARGV); 22 | print_usage_and_exit if $rule !~ /^\w+$/; 23 | my $input; 24 | if($ARGV[0] eq '-e') { 25 | shift(@ARGV); 26 | print_usage_and_exit if not @ARGV; 27 | $input = shift(@ARGV); 28 | #$input = 'qq{'.quotemeta($input).'}'; 29 | } 30 | else { 31 | my $fn = shift(@ARGV); 32 | print_usage_and_exit if !-f $fn; 33 | $input = "`cat $fn`"; 34 | } 35 | if(-e 'STD.pm' and -e 'gimme5') { # We're in the right place. 36 | # pretend we're 'make' 37 | if(!-e 'STD.pmc' or 38 | -M 'STD.pmc' > -M 'STD.pm' or 39 | -M 'STD.pmc' > -M 'gimme5') { 40 | system("$^X gimme5 $fo STD.pm >STD.pmc"); 41 | system("rm -rf lex"); 42 | } 43 | } 44 | #my $cmd = qq/perl -w -I . -MSTD5 -e 'print STD::Dump(STD->new(orig=>$input)->${rule}(["$rule"]));'/; 45 | #warn "# ",$cmd,"\n"; 46 | #system "$cmd 2>try5.err"; 47 | unshift(@INC,'.'); 48 | require "STD.pmc"; 49 | my $err = "try5.err"; 50 | my $perl = STD->new($input); 51 | if(!$perl->can($rule)) { die "\nERROR: Unknown rule: $rule\n"; } 52 | open(STDERR,">$err") or die; 53 | my $result = eval { $perl->${rule}(); }; 54 | if($result) { 55 | print $result->dump(); 56 | # print STD::Dump($result); 57 | } else { 58 | print "Parse failed. See $err.\n"; 59 | } 60 | } 61 | main; 62 | 63 | __END__ 64 | -------------------------------------------------------------------------------- /tools/try5_post: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # ./try5 EXPR -e '-3+2' | ./try5_post 3 | use strict; 4 | use warnings; 5 | use YAML::Syck; 6 | use Scalar::Util; 7 | 8 | my $yaml = join("",<>); 9 | my $ast = YAML::Syck::Load($yaml); 10 | Perl->remove_clutter_from($ast); 11 | print YAML::Syck::Dump($ast); 12 | exit(0); 13 | 14 | { package Perl; 15 | sub remove_clutter { 16 | my $self = shift; 17 | delete($self->{'prior'}); 18 | for my $k (keys %$self) { 19 | my $v = $self->{$k}; 20 | Perl->remove_clutter_from($v); 21 | } 22 | } 23 | sub remove_clutter_from { 24 | my($cls,$o)=@_; 25 | if(Scalar::Util::blessed($o)) { 26 | if($o->can('remove_clutter')) { 27 | $o->remove_clutter; 28 | } else { 29 | # do nothing 30 | } 31 | } 32 | elsif(ref($o) eq 'ARRAY') { 33 | for my $e (@$o) { 34 | $cls->remove_clutter_from($e); 35 | } 36 | } 37 | elsif(ref($o) eq 'HASH') { 38 | for my $v (values %$o) { 39 | $cls->remove_clutter_from($v); 40 | } 41 | } 42 | else { 43 | # do nothing 44 | } 45 | } 46 | } 47 | 48 | { package Match; 49 | sub remove_clutter { 50 | # do nothing 51 | } 52 | } 53 | -------------------------------------------------------------------------------- /tools/tryfile: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use STD; 4 | use utf8; 5 | 6 | my $failures = 0; 7 | 8 | if (not @ARGV) { 9 | @ARGV = grep { s/\.t\n/.t/} ; 10 | s/^\s*[AU]*\s+// for @ARGV; 11 | } 12 | my $pkgs = $ARGV[0]; 13 | if ($pkgs =~ s[roast.*][roast/packages]) { 14 | $ENV{PERL6LIB} ||= "lib:$pkgs:."; 15 | } 16 | 17 | for my $file (@ARGV) { 18 | warn $file,"\n" if @ARGV > 1; 19 | next unless -f $file; 20 | eval { 21 | warn "Undefined\n" unless defined STD->parsefile($file); 22 | }; 23 | if ($@) { 24 | warn $@; 25 | $failures++; 26 | } 27 | } 28 | my ($time, $vsz) = split(' ', `ps -o "time= vsz=" $$`); 29 | $time =~ s/^00://; 30 | $vsz =~ s/\d\d\d$/m/; 31 | if ($failures) { 32 | if ($vsz) { 33 | warn "FAILED $time $vsz\n"; 34 | } 35 | else { 36 | warn "FAILED\n"; 37 | } 38 | exit $failures; 39 | } 40 | elsif ($vsz) { 41 | warn "ok $time $vsz\n"; 42 | } 43 | else { 44 | warn "ok\n"; 45 | } 46 | -------------------------------------------------------------------------------- /tools/tryfoo: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | BEGIN { $ENV{STD5DEBUG} = 16383; } 4 | use STD; 5 | use utf8; 6 | use YAML::XS; 7 | use Encode; 8 | 9 | print "Starting...\n"; 10 | my $what = 'foo'; 11 | my $text = "@ARGV"; 12 | my $r = STD->new($text)->$what(); 13 | print Dump($r); 14 | -------------------------------------------------------------------------------- /uniprops: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl6/std/28329a77382cda87f1bba12a8522005766a1054a/uniprops --------------------------------------------------------------------------------