Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 104 lines (90 sloc) 2.602 kb
920c0b2 [STD,Cursor] Push error reporting functions down into the new Perl6 Curs...
sorear authored
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
27777d6 [Cursor] Rewrite in Perl 6, bring under bootstrap control
sorear authored
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;
920c0b2 [STD,Cursor] Push error reporting functions down into the new Perl6 Curs...
sorear authored
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 = '<BOL>' if $pre eq '';
70 my $post = substr($*ORIG, $pos, 40);
71 1 while $post ~~ s!(\n.*)!!;
72 $post = '<EOL>' if $post eq '';
73 " at " ~ $*FILE<name> ~ " 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]<L>;
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++]<L> = $line
91 for 1 .. chars($_);
92 }
93 @*MEMOS[$pos++]<L> = $line;
94 return @*MEMOS[$p]<L> // 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
Something went wrong with that request. Please try again.