From: Jim Cromie Date: Tue, 3 Jan 2006 23:18:09 +0000 (-0700) Subject: Re: [patch] optimized constant subs are cool, teach B::Concise about them X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f9f861ecaa1dbb3c86ada9d10a796967508456a2;p=p5sagit%2Fp5-mst-13.2.git Re: [patch] optimized constant subs are cool, teach B::Concise about them Message-ID: <43BB68A1.7060708@gmail.com> With syntactic tweaks to the test file p4raw-id: //depot/perl@26651 --- diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index c8710ca..5ce1d45 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp use Exporter (); # use #5 -our $VERSION = "0.66"; +our $VERSION = "0.67"; our @ISA = qw(Exporter); our @EXPORT_OK = qw( set_style set_style_standard add_callback concise_subref concise_cv concise_main @@ -950,9 +950,8 @@ sophisticated and flexible. =head1 EXAMPLE -Here's an example of 2 outputs (aka 'renderings'), using the --exec and -basic (i.e. default) formatting conventions on the same code -snippet. +Here's two outputs (or 'renderings'), using the -exec and -basic +(i.e. default) formatting conventions on the same code snippet. % perl -MO=Concise,-exec -e '$a = $b + 42' 1 <0> enter @@ -964,21 +963,22 @@ snippet. 7 <2> sassign vKS/2 8 <@> leave[1 ref] vKP/REFC -Each line corresponds to an opcode. The opcode marked with '*' is used -in a few examples below. +In this -exec rendering, each opcode is executed in the order shown. +The add opcode, marked with '*', is discussed in more detail. The 1st column is the op's sequence number, starting at 1, and is -displayed in base 36 by default. This rendering is in -exec (i.e. -execution) order. +displayed in base 36 by default. Here they're purely linear; the +sequences are very helpful when looking at code with loops and +branches. The symbol between angle brackets indicates the op's type, for example; <2> is a BINOP, <@> a LISTOP, and <#> is a PADOP, which is used in threaded perls. (see L). -The opname, as in B<'add[t1]'>, which may be followed by op-specific +The opname, as in B<'add[t1]'>, may be followed by op-specific information in parentheses or brackets (ex B<'[t1]'>). -The op-flags (ex B<'sK/2'>) follow, and are described in (L) are described in (L). % perl -MO=Concise -e '$a = $b + 42' @@ -1496,6 +1496,40 @@ The numeric value of the OP's type, in decimal. =back +=head1 One-Liner Command tips + +=over 4 + +=item perl -MO=Concise,bar foo.pl + +Renders only bar() from foo.pl. To see main, drop the ',bar'. To see +both, add ',-main' + +=item perl -MDigest::MD5=md5 -MO=Concise,md5 -e1 + +Identifies md5 as an XS function. The export is needed so that BC can +find it in main. + +=item perl -MPOSIX -MO=Concise,_POSIX_ARG_MAX -e1 + +Identifies _POSIX_ARG_MAX as a constant sub, optimized to an IV. +Although POSIX isn't entirely consistent across platforms, this is +likely to be present in virtually all of them. + +=item perl -MPOSIX -MO=Concise,a -e 'print _POSIX_SAVED_IDS' + +This renders a print statement, which includes a call to the function. +It's identical to rendering a file with a use call and that single +statement, except for the filename which appears in the nextstate ops. + +=item perl -MPOSIX -MO=Concise,a -e 'sub a{_POSIX_SAVED_IDS}' + +This is B similar to previous, only the first two ops differ. This +subroutine rendering is more representative, insofar as a single main +program will have many subs. + + + =head1 Using B::Concise outside of the O framework The common (and original) usage of B::Concise was for command-line diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t index a90a615..fa0e7df 100644 --- a/ext/B/t/concise-xs.t +++ b/ext/B/t/concise-xs.t @@ -118,7 +118,7 @@ use Carp; use Test::More tests => ( # per-pkg tests (function ct + require_ok) 40 + 16 # Data::Dumper, Digest::MD5 + 511 + 233 # B::Deparse, B - + 589 + 189 # POSIX, IO::Socket + + 588 + 189 # POSIX, IO::Socket + 3 * ($] > 5.009) + 14 * ($] >= 5.009003) - 22); # fudge @@ -182,7 +182,8 @@ my $testpkgs = { /], }, - POSIX => { dflt => 'constant', # all but 252/589 + POSIX => { dflt => 'constant', # all but 252/589 + skip => [qw/ _POSIX_JOB_CONTROL /], # platform varying perl => [qw/ import croak AUTOLOAD /], XS => [qw/ write wctomb wcstombs uname tzset tzname diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t index 49243f5..453eed0 100644 --- a/ext/B/t/optree_constants.t +++ b/ext/B/t/optree_constants.t @@ -19,7 +19,7 @@ BEGIN { use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!! use Config; -my $tests = 23; +my $tests = 30; plan tests => $tests; SKIP: { skip "no perlio in this build", $tests unless $Config::Config{useperlio}; @@ -27,23 +27,44 @@ skip "no perlio in this build", $tests unless $Config::Config{useperlio}; ################################# use constant { # see also t/op/gv.t line 282 - myint => 42, - mystr => 'hithere', - myfl => 3.14159, - myrex => qr/foo/, - myglob => \*STDIN, - myaref => [ 1,2,3 ], - myhref => { a => 1 }, - myundef => undef, - mysub => \&ok, - mysub => \&nosuch, + myaref => [ 1,2,3 ], + myfl => 1.414213, + myglob => \*STDIN, + myhref => { a => 1 }, + myint => 42, + myrex => qr/foo/, + mystr => 'hithere', + mysub => \&ok, + myundef => undef, + myunsub => \&nosuch, +}; + +sub myyes() { 1==1 } +sub myno () { return 1!=1 } +sub pi () { 3.14159 }; + +my $want = { # expected types, how value renders in-line, todos (maybe) + myfl => [ 'NV', myfl ], + myint => [ 'IV', myint ], + mystr => [ 'PV', '"'.mystr.'"' ], + myhref => [ 'RV', '\\\\HASH'], + myundef => [ 'NULL', ], + pi => [ 'NV', pi ], + # these have todos, since they render as a bare backslash + myaref => [ 'RV', '\\\\', ' - should render as \\ARRAY' ], + myglob => [ 'RV', '\\\\', ' - should render as \\GV' ], + myrex => [ 'RV', '\\\\', ' - should render as ??' ], + mysub => [ 'RV', '\\\\', ' - should render as \\CV' ], + myunsub => [ 'RV', '\\\\', ' - should render as \\CV' ], + # these are not inlined, at least not per BC::Concise + #myyes => [ 'RV', ], + #myno => [ 'RV', ], }; use constant WEEKDAYS => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday ); -sub pi () { 3.14159 }; $::{napier} = \2.71828; # counter-example (doesn't get optimized). eval "sub napier ();"; @@ -55,268 +76,94 @@ INIT { }; ################################# -pass("CONSTANT SUBS RETURNING SCALARS"); - -checkOptree ( name => 'myint() as coderef', - code => \&myint, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a IV -EOT_EOT - is a constant sub, optimized to a IV -EONT_EONT - - -checkOptree ( name => 'mystr() as coderef', - code => \&mystr, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a PV -EOT_EOT - is a constant sub, optimized to a PV -EONT_EONT - - -checkOptree ( name => 'myfl() as coderef', - code => \&myfl, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a NV -EOT_EOT - is a constant sub, optimized to a NV -EONT_EONT - - -checkOptree ( name => 'myrex() as coderef', - code => \&myrex, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a RV -EOT_EOT - is a constant sub, optimized to a RV -EONT_EONT - - -checkOptree ( name => 'myglob() as coderef', - code => \&myglob, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a RV -EOT_EOT - is a constant sub, optimized to a RV -EONT_EONT - - -checkOptree ( name => 'myaref() as coderef', - code => \&myaref, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a RV -EOT_EOT - is a constant sub, optimized to a RV -EONT_EONT - - -checkOptree ( name => 'myhref() as coderef', - code => \&myhref, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a RV -EOT_EOT - is a constant sub, optimized to a RV -EONT_EONT - - -checkOptree ( name => 'myundef() as coderef', - code => \&myundef, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a NULL -EOT_EOT - is a constant sub, optimized to a NULL -EONT_EONT - - -checkOptree ( name => 'mysub() as coderef', - code => \&mysub, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a RV -EOT_EOT - is a constant sub, optimized to a RV -EONT_EONT - +pass("RENDER CONSTANT SUBS RETURNING SCALARS"); -checkOptree ( name => 'myunsub() as coderef', - todo => '- may prove only that sub is unformed', - code => \&myunsub, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - has no START +for $func (sort keys %$want) { + # no strict 'refs'; # why not needed ? + checkOptree ( name => "$func() as a coderef", + code => \&{$func}, + noanchors => 1, + expect => < <{$func}[0] EOT_EOT - has no START + is a constant sub, optimized to a $want->{$func}[0] EONT_EONT +} -############## - -checkOptree ( name => 'call myint', - code => 'myint', - bc_opts => '-nobanner', - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -3 <1> leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 -1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const[IV 42] s ->3 -EOT_EOT -3 <1> leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 -1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const(IV 42) s ->3 -EONT_EONT - - -checkOptree ( name => 'call mystr', - code => 'mystr', - bc_opts => '-nobanner', - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -3 <1> leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 -1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const[PV "hithere"] s ->3 -EOT_EOT -3 <1> leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 -1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const(PV "hithere") s ->3 -EONT_EONT - +pass("RENDER CALLS TO THOSE CONSTANT SUBS"); -checkOptree ( name => 'call myfl', - code => 'myfl', - bc_opts => '-nobanner', - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); +for $func (sort keys %$want) { + # print "# doing $func\n"; + checkOptree ( name => "call $func", + code => "$func", + ($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (), + bc_opts => '-nobanner', + expect => < < leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 +- <\@> lineseq KP ->3 1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const[NV 3.14159] s ->3 +2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3 EOT_EOT 3 <1> leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 +- <\@> lineseq KP ->3 1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const(NV 3.14159) s ->3 +2 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3 EONT_EONT +} -checkOptree ( name => 'call myrex', - code => 'myrex', - todo => '- RV value is bare backslash', - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 753 (eval 27):1) v ->2 -# 2 <$> const[RV \\] s ->3 -EOT_EOT -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 753 (eval 27):1) v ->2 -# 2 <$> const(RV \\) s ->3 -EONT_EONT - - -checkOptree ( name => 'call myglob', - code => 'myglob', - todo => '- RV value is bare backslash', - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 753 (eval 27):1) v ->2 -# 2 <$> const[RV \\] s ->3 -EOT_EOT -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 753 (eval 27):1) v ->2 -# 2 <$> const(RV \\) s ->3 -EONT_EONT - - -checkOptree ( name => 'call myaref', - code => 'myaref', - todo => '- RV value is bare backslash', - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 758 (eval 29):1) v ->2 -# 2 <$> const[RV \\] s ->3 -EOT_EOT -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 758 (eval 29):1) v ->2 -# 2 <$> const(RV \\) s ->3 -EONT_EONT - - -checkOptree ( name => 'call myhref', - code => 'myhref', - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 763 (eval 31):1) v ->2 -# 2 <$> const[RV \\HASH] s ->3 -EOT_EOT -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 763 (eval 31):1) v ->2 -# 2 <$> const(RV \\HASH) s ->3 -EONT_EONT - +############## +pass("MORE TESTS"); -checkOptree ( name => 'call myundef', - code => 'myundef', +checkOptree ( name => 'myyes() as coderef', + code => sub () { 1==1 }, noanchors => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 771 (eval 35):1) v ->2 -# 2 <$> const[NULL ] s ->3 + is a constant sub, optimized to a SPECIAL EOT_EOT -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 771 (eval 35):1) v ->2 -# 2 <$> const(NULL ) s ->3 + is a constant sub, optimized to a SPECIAL EONT_EONT -checkOptree ( name => 'call mysub', - code => 'mysub', +checkOptree ( name => 'myyes() as coderef', + code => 'sub a() { 1==1 }; print a', noanchors => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 771 (eval 35):1) v ->2 -# 2 <$> const[RV \\] s ->3 +# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->5 +# 1 <;> nextstate(main 810 (eval 47):1) v ->2 +# 4 <@> print sK ->5 +# 2 <0> pushmark s ->3 +# 3 <$> const[SPECIAL sv_yes] s ->4 EOT_EOT -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 771 (eval 35):1) v ->2 -# 2 <$> const(RV \\) s ->3 +# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->5 +# 1 <;> nextstate(main 810 (eval 47):1) v ->2 +# 4 <@> print sK ->5 +# 2 <0> pushmark s ->3 +# 3 <$> const(SPECIAL sv_yes) s ->4 EONT_EONT -################## -# test constant sub defined w/o 'use constant' - -checkOptree ( name => "pi(), defined w/o 'use constant'", - code => \&pi, +checkOptree ( name => 'myno() as coderef', + code => 'sub a() { 1!=1 }; print a', noanchors => 1, + todo => '- SPECIAL sv_no renders as PVNV 0', expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a NV +# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->5 +# 1 <;> nextstate(main 810 (eval 47):1) v ->2 +# 4 <@> print sK ->5 +# 2 <0> pushmark s ->3 +# 3 <$> const[PVNV 0] s ->4 EOT_EOT - is a constant sub, optimized to a NV +# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->5 +# 1 <;> nextstate(main 810 (eval 47):1) v ->2 +# 4 <@> print sK ->5 +# 2 <0> pushmark s ->3 +# 3 <$> const(PVNV 0) s ->4 EONT_EONT @@ -352,7 +199,7 @@ checkOptree ( name => 'call many in a print statement', # 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4 # 4 <$> const[IV 42] s ->5 # 5 <$> const[PV "hithere"] s ->6 -# 6 <$> const[NV 3.14159] s ->7 +# 6 <$> const[NV 1.414213] s ->7 # 7 <$> const[NV 3.14159] s ->8 EOT_EOT # 9 <1> leavesub[1 ref] K/REFC,1 ->(end) @@ -363,7 +210,7 @@ EOT_EOT # 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4 # 4 <$> const(IV 42) s ->5 # 5 <$> const(PV "hithere") s ->6 -# 6 <$> const(NV 3.14159) s ->7 +# 6 <$> const(NV 1.414213) s ->7 # 7 <$> const(NV 3.14159) s ->8 EONT_EONT