1package Pugs::Runtime::Tracer;
2
3use strict;
4use warnings;
5use base 'Exporter';
6#use Smart::Comments;
7
8our @EXPORT = qw(
9   trace_begin trace_end trace
10   expand_tracing_code
11);
12
13sub trace_begin ($$$$) {
14   my ($name, $from, $to, $pos) = @_;
15   trace(">>BEGIN $name<< $from..$to at $pos\n");
16}
17
18sub trace_end ($$$) {
19   my ($name, $res, $pos) = @_;
20   trace(">>END $name<< ", $res ? 'success' : 'fail', " at $pos\n");
21}
22
23sub trace ($@) {
24   if (!defined $::PCR_TRACE_FH) {
25       $::PCR_TRACE_FH = \*STDOUT;
26   }
27   print $::PCR_TRACE_FH @_;
28}
29
30sub expand_tracing_code {
31    my $s = shift;
32    open my $in, '<', \$s or die;
33    my (@names, $name, $new, @has_pos);
34    while (<$in>) {
35        chomp;
36        if (/\s+## <(\w+)>$/) {
37            $name = $1;
38            push @names, $name;
39            push @has_pos, 0;
40            ### begin: $name
41            $new .= $_ . "\n";
42        } elsif (/(\s+)## pos: (\d+) (\d+)$/) {
43            my ($tab, $from, $to) = ($1, $2, $3);
44            $has_pos[-1] = 1;
45            $new .= <<"_EOC_";
46$_
47$tab do {
48$tab   Pugs::Runtime::Tracer::trace_begin('$name', $from, $to, \$pos);
49$tab   my \$retval =
50_EOC_
51        } elsif (/(\s+)## <\/(\w+)>$/) {
52            my ($tab, $n) = ($1, $2);
53            $name = pop @names;
54            my $has_pos = pop @has_pos;
55            ### end: $n . "<=>" . $name
56            if (!defined $name || $n ne $name) {
57                die "ERROR: unexpected closing tag </$n>";
58            } elsif ($has_pos) {
59                $new .= <<"_EOC_";
60$_
61$tab ;
62$tab   Pugs::Runtime::Tracer::trace_end('$name', \$retval, \$pos);
63$tab   \$retval;
64$tab }
65_EOC_
66            }
67            if (!$has_pos) {
68                #warn "No pos info found for <$n>";
69            }
70        } else {
71            $new .= $_ . "\n";
72        }
73    }
74    return $new;
75}
76
771;
78__END__
79
80=head1 NAME
81
82Pugs::Runtime::Tracer - tracer runtime for Pugs::Compiler::Rule
83
84=head1 SYNOPSIS
85
86    use Pugs::Runtime::Tracer;
87    trace("blah blah blah");
88    trace_begin($regex_name, $regex_pos_from, $regex_pos_to, $input_pos);
89    trace_end($regex_name, $success, $input_pos);
90    $perl5_code_with_tracing_code = expand_tracing_code($perl5_code);
91
92=head1 DESCRIPTION
93
94This module provides tracing facilities for both PCR compile-time and run-time.
95
96=head1 SEE ALSO
97
98=over
99
100=item *
101
102L<compile_p6grammar.pl>
103
104=item *
105
106"A graphical tracer for Perl 6 regexes based on PCR"
107
108L<http://pugs.blogs.com/pugs/2007/10/a-graphical-tra.html>.
109
110=back
111
112=head1 AUTHOR
113
114Agent Zhang E<lt>agentzh@yahoo.cnE<gt>.
115
116=head1 COPYRIGHT
117
118Copyright 2007 by Yahoo! China Inc. L<http://cn.yahoo.com>.
119
120=head1 LICENSE
121
122This module is free software; you can redistribute it and/or modify it
123under the same terms as Perl itself.
124
125