Category:
Author/Contact Info
Description:

This tool translates the default output of B::Concise into Prolog. The basic predicates are optree/1 which contains an optree and opcode/4.

Sample input:

Blarg::Floop::connections B::Concise::compile(CODE(0x8220bf0)) h <1> leavesub[23 refs] K/REFC,1 ->(end) - <@> lineseq KP ->h 1 <;> nextstate(Common::Blarg -1428 Blarg.pm:172) v ->2 - <0> ex-const vP/4 ->2 2 <;> nextstate(Common::Blarg -1426 Blarg.pm:173) v ->3 - <1> null K/1 ->- 7 <|> cond_expr(other->8) K/1 ->i 6 <2> eq sK/2 ->7 4 <1> rv2av[t2] sK/1 ->5 3 <$> gv(*_) s ->4 5 <$> const(IV 2) s ->6 g <2> sassign sKS/2 ->h - <1> ex-aelem sK/2 ->9 - <1> ex-rv2av sKR/1 ->- 8 <$> aelemfast(*_) s/1 ->9 - <0> ex-const s ->- f <2> aelem sKRM*/2 ->g d <1> rv2av[t3] sKR/1 ->e c <2> aelem sKM/DREFAV,2 ->d 9 <0> padav[@stuff:FAKE] sR ->a b <1> rv2sv sK/1 ->c - <@> scope sK ->b - <0> ex-nextstate v ->a - <1> ex-aelem sK/2 ->- - <1> ex-rv2av sKR/1 ->- a <$> aelemfast(*_) s ->b - <0> ex-const s ->- e <0> padsv[$attrib_num:FAKE] s ->f o <2> aelem sK/2 ->h m <1> rv2av[t5] sKR/1 ->n l <2> aelem sKM/DREFAV,2 ->m i <0> padav[@stuff:FAKE] sR ->j k <1> rv2sv sK/1 ->l - <@> scope sK ->k - <0> ex-nextstate v ->j - <1> ex-aelem sK/2 ->- - <1> ex-rv2av sKR/1 ->- j <$> aelemfast(*_) s ->k - <0> ex-const s ->- n <0> padsv[$attrib_num:FAKE] s ->o

Sample output

optree( opcode( leavesub, '23 refs', opcode( lineseq, '', opcode( nextstate, 'Common::Blarg -1428 Blarg.pm:172', [], opcode( ex_const, '', [], opcode( nextstate, 'Common::Blarg -1426 Blarg.pm:173', [],  opcode( null, '',  opcode( cond_expr, 'other->8',  opcode( eq, '',  opcode( rv2av, 't2',  opcode( gv, '*_', [], [] ),  opcode( const, 'IV 2', [], [] ) ),  opcode( sassign, '',  opcode( ex_aelem, '',  opcode( ex_rv2av, '',  opcode( aelemfast, '*_', [], [] ),  opcode( ex_const, '', [], [] ) ),  opcode( aelem, ' sKRM*',  opcode( rv2av, 't3',  opcode( aelem, '',  opcode( padav, '@stuff:FAKE', [],  opcode( rv2sv, '',  opcode( scope, '',  opcode( ex_nextstate, '', [],  opcode( ex_aelem, '',  opcode( ex_rv2av, '',  opcode( aelemfast, '*_', [], [] ),  opcode( ex_const, '', [], [] ) ), [] ) ), [] ), [] ) ), [] ),  opcode( padsv, '$attrib_num:FAKE', [], [] ) ), [] ) ),  opcode( aelem, '',  opcode( rv2av, 't5',  opcode( aelem, '',  opcode( padav, '@stuff:FAKE', [],  opcode( rv2sv, '',  opcode( scope, '',  opcode( ex_nextstate, '', [],  opcode( ex_aelem, '',  opcode( ex_rv2av, '',  opcode( aelemfast, '*_', [], [] ),  opcode( ex_const, '', [], [] ) ), [] ) ), [] ), [] ) ), [] ),  opcode( padsv, '$attrib_num:FAKE', [], [] ) ), [] ) ) ), [] ), [] ) ) ) ), [] ), [] ) ).
use strict;
use warnings;
no warnings 'recursion';
$/ = '';

while (<>) {

    # Remove first two lines.
    s/\A((?:(?>.+)\n)(?:(?>.+)\n))// or die;
    my $header = $1;
    $header =~ s/^/%% /gm;

    # All the leading goo is turned into spaces.
    s/^(?>\S+)((?>(?:\s{3})*))(?>\s*)<.>/' ' x length $1/meg;

    # The trailing goo is also turned into spaces.
    s!\s*[\w/,]*(?>\s+)->(?>\S+)$!!mg;

    # Quote anything in parentheses.
    s<\((.+)\)>
      {
       my $thing = $1;
       $thing =~ s/([\\'"])/\\$1/g;
       qq[ '$thing'];
      }ge;

    # Quote whatever is in brackets.
    s<\[(.+)\]>
      {
       my $thing = $1;
       $thing =~ s/([\\'"%])/\\$1/g;
       qq[ '$thing'];
      }ge;

    # Remove trailing lines
    s/\s+\z//;
    $_ .= "\n";

    $_ = concise_2prolog( $_, 'ROOT' );
    print "${header}optree( $_ ).\n\n\n";
}
print <<'FOOTER';
%% Local Variables: ***
%% mode: prolog ***
%% End: ***
FOOTER

sub concise_2prolog {
    local $_ = shift @_;

    ### "$_[0]=<" . join( '', map length( /^(\s+)/ ? $1 : '' ) . $_, /
+(.*\n)/g ) . ">\n";

    my $times = 0;
    s[# Preceded by a newline or the start of the string
      (?:(?<=\n)|(?<=\A))
      (?: # First line
       (^\ *)   # Capture leading space in $1
       ([-\w]*) # Capture the opcode name in $2
       (.*)\n   # Capture the args in $3
      )
      # The children are more indented in $4.
      ((?:^\1\ .+\n)*)
      
      # The siblings are equally indented in $5.
      ((?:^\1.+\n)*)
     ]{
       my $opcode  = $2;
       my $args     = $3;
       my $children = $4;
       my $siblings = $5;

       ### $siblings

       $opcode =~ s/-/_/g;

       # Unquote the args.
       if ( $args ) {
           $args =~ s/^\s*\'//;
           $args =~ s/\'\s*\z//;
           $args =~ s/'/\\'/g;
       }
       else {
           $args ||= '',
       }
       
       if ( $children ) {
           $children = concise_2prolog( $children, 'CHILD' );
       }
       else {
           ### NO CHILDREN
           $children = '[]';
       }

       if ( $siblings ) {
           $siblings = concise_2prolog( $siblings, 'SIBLING' );
       }
       else {
           ### NO SIBLINGS
           $siblings = '[]';
       }
       
       qq<\nopcode( "$opcode", "$args", $children, $siblings )>;
      }gxem
        or do {
        ### FAILED
        };

    ### $times
    return $_ || '[]';
}
Replies are listed 'Best First'.
Re: B::Concise -> Prolog
by diotalevi (Canon) on Apr 02, 2007 at 03:02 UTC

    I wrote this pile of predicates to use when constructing my new checks.

    %% dpl/1 Prints the names for a list of opcodes. dpl([T]) :- op_name(T,N), write(N), nl. dpl([H|T]) :- op_name(H,N), write(N), write(','), dpl(T). %% curcop/2 finds the closest COP node curcop(O, Cop) :- findall(C1, (op_preceding(O,C1), op_name(C1,nextstate)), C2), last(C2,Cop). last([H|T], O) :- T = [] -> O = H; last(T,O). %% Optree primitives op_name( O, N ) :- arg( 1, O, N ). op_flags( O, F ) :- arg( 2, O, F ). op_first( O, O2 ) :- arg( 3, O, O2 ). op_sibling( O, O2 ) :- arg( 4, O, O2 ). %% Some useful optree axes op_following_siblings( Op, Sibling ) :- op_sibling( Op, Sibling ). op_following_siblings( Op, Sibling ) :- op_sibling( Op, Temp ), op_following_siblings( Temp, Sibling ). op_child( Op, Child ) :- op_first( Op, Child ). op_child( Op, Child ) :- op_first( Op, Temp ), op_following_siblings( Temp, Child ). %% op_descendant/2 op_descendant( Op, Descendant ) :- op_child( Op, Descendant ). op_descendant( Op, Descendant ) :- op_child( Op, Temp ), op_descendant( Temp, Descendant ). %% op_descendant/3 op_descendant( Op, [Op], Descendant ) :- op_child( Op, Descendant ). op_descendant( Op, [Op|Rest], Descendant ) :- op_child( Op, Temp ), op_descendant( Temp, Rest, Descendant ). %% op_descendant_or_self/2 op_descendant_or_self( Op, Op ). op_descendant_or_self( Op, Descendant ) :- op_child( Op, Descendant ). op_descendant_or_self( Op, Descendant ) :- op_child( Op, Temp ), op_descendant_or_self( Temp, Descendant ). %% op_descendant_or_self/3 op_descendant_or_self( Op, [], Op ). op_descendant_or_self( Op, [Op], Descendant ) :- op_child( Op, Descendant ). op_descendant_or_self( Op, [Op|Rest], Descendant ) :- op_child( Op, Temp ), op_descendant_or_self( Temp, Rest, Descendant ). %% op_following/2 op_following( Op, Descendant ) :- op_descendant( Op, Descendant ). op_following( Op, Sibling ) :- op_sibling( Op, Sibling ). op_following( Op, SibDesc ) :- op_sibling( Op, Sibling ), op_following( Sibling, SibDesc ). %% op_following/3 op_following( Op, Middle, Descendant ) :- op_descendant( Op, Middle, Descendant ). op_following( Op, _, Sibling ) :- op_sibling( Op, Sibling ). op_following( Op, Middle, SibDesc ) :- op_sibling( Op, Sibling ), op_following( Sibling, Middle, SibDesc ). %% op_parent/2 op_parent( Op, Parent ) :- optree( Root ), op_descendant( Root, Parent ), op_child( Parent, Op ). %% op_ancestor/2 op_ancestor( Op, Root ) :- optree( Root ), op_descendant( Root, Op ). op_ancestor( Op, Ancestor ) :- optree( Root ), op_descendant( Root, Ancestor ), op_descendant( Ancestor, Op ). %% op_ancestor/3 op_ancestor( Op, Middle, Ancestor ) :- optree( Root ), op_descendant( Root, _, Ancestor), op_descendant( Ancestor, Middle, Op ). %% op_ancestor_or_self/2 op_ancestor_or_self( Op, Op ). op_ancestor_or_self( Op, Ancestor ) :- op_ancestor( Op, Ancestor ). %% TODO: op_ancestor_or_self/3 op_ancestor_or_self( Op, [], Op ). op_ancestor_or_self( Op, Middle, Ancestor ) :- op_ancestor( Op, Middle, Ancestor ). op_preceding_sibling(Op, Sibling) :- op_parent( Op, Parent ), op_child( Parent, Sibling ), op_following_siblings( Sibling, Op ). %% op_preceding/2 op_preceding( Op, Preceding ) :- optree( Root ), op_following( Root, Preceding ), op_folowing( Preceding, Op ). %% op_preceding/3 op_preceding( Op, Middle, Preceding ) :- optree( Root ), op_following( Root, _, Preceding ), op_folowing( Preceding, Middle, Op ).

    ⠤⠤ ⠙⠊⠕⠞⠁⠇⠑⠧⠊