Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Idealized optrees from B::Concise

by diotalevi (Canon)
on Oct 21, 2003 at 21:50 UTC ( [id://301087]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info
Description:

This alters the output of B::Concise so you can view an idealized optree. It remove all the execution order, context and null nodes away until the output is nicely readable.

perl -MO=Concise -e '...' | ./idealized_ops

That transforms something like this:

l  <@> leavet1 vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 2 -e:1) v ->3
k     <2> leaveloop vK/2 ->l
7        <{> enteriter(next->g last->k redo->8) lKS ->i
-           <0> ex-pushmark s ->3
-           <1> ex-list lK ->6
3              <0> pushmark s ->4
4              <$> const(IV 1) s ->5
5              <$> const(IV 100) s ->6
6           <$> gv(*_) s ->7
-        <1> null vK/1 ->k
j           <|> and(other->8) vK/1 ->k
i              <0> iter s ->j
-              <@> lineseq vK ->-
8                 <;> nextstate(main 1 -e:1) v ->9
-                 <1> null vK/1 ->g
c                    <|> and(other->d) vK/1 ->g
b                       <2> lt sK/2 ->c
-                          <1> ex-rv2sv sK/1 ->a
9                             <$> gvsv(*_) s ->a
a                          <$> const(IV 50) s ->b
f                       <@> print vK ->g
d                          <0> pushmark s ->e
-                          <1> ex-rv2sv sK/1 ->f
e                             <$> gvsv(*_) s ->f
g                 <0> unstack v ->h
h                 <;> nextstate(main 2 -e:1) v ->i

Into this:

leave
   enter
   nextstate
   leaveloop
      enteriter
         pushmark
         const
         const
         gv
      null
         and
            iter
            lineseq
               nextstate
               null
                  and
                     lt
                        gvsv
                        const
                     print
                        pushmark
                        gvsv
               unstack
               nextstate
#!/usr/bin/perl
use strict;
use warnings;

use vars qw($strip $text);
$text = '';
for (<>) {
    /^(.*?<.> )([\w-]+|\S+)(.*?)$/ or next;
    my $level = length $1;
    my $op    = lc $2;
    my $pv    = (grep defined(), $3 =~ /[IN]V (\d+)|PV "((?:\\"|[^"])*
+)"/)[0];

    if ( not defined $strip ) {
        $strip = $level;
        $level = 0;
    } else {
        $level -= $strip;
        $level /= 3;
    }
    $text .= (" " x $level) . "$op@{[ defined $pv ? qq[ $pv] : '' ]}\n
+";
}
while ( $text =~ /^(\s*)(?:ex-|null).*/gm ) {
    my $pos      = $-[0];
    my $level = length $1;
    substr( $text, $pos ) =~ s/^(.*\n)// or next;
    substr( $text, $pos ) =~ /^\s{0,$level}\S/m or next;
    my $section = $-[0];
        substr( $text, $pos, $section ) =~ s/^ //gm;
}
continue {
    pos($text) = 0;
}
$text =~ s/ /   /g;
print $text;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://301087]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (4)
As of 2024-03-29 10:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found