File Coverage

lib/B/DeparseTree/PP_OPtable.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1             # Copyright (c) 2018 Rocky Bernstein
2              
3             # A table-driven mapping from Perl PP ops e.g pp_accept, pp_aeach,
4             # ... to a compact list of function names with arguments that
5             # implements them.
6              
7             package B::DeparseTree::PP_OPtable;
8              
9 8     8   53 use B::DeparseTree::OPflags;
  8         15  
  8         512  
10              
11 8     8   52 use warnings; use strict;
  8     8   46  
  8         194  
  8         37  
  8         14  
  8         566  
12             our($VERSION, @EXPORT, @ISA);
13             $VERSION = '3.2.0';
14             @ISA = qw(Exporter);
15              
16 8     8   66 use vars qw(%PP_MAPFNS);
  8         51  
  8         7989  
17              
18             # In the HASH below, the key is the operation name with the leading pp_ stripped.
19             # so "die" refers to function "pp_die". The value can be several things.
20             #
21             # If the table value is a string, then that function is called with a standard
22             # set of parameters. For example, consider:
23             # 'die' => 'listop'.
24             #
25             # The above indicates that for the pp_die operation we should call listop
26             # with standard parameters $self, $op, and the key value, e.g
27             # "die". This replaces B::Deparse equivalent:
28             # sub pp_die { $self->listop($op, $cx, "die"); }
29             #
30             # If the table value is not a string, it will be an array reference, and here
31             # the entries may be subject to interpretation based on the function name.
32             #
33             # For the most part, when there are two entries, it is similar to the string case,
34             # but instead of passing the key name as a parameter, the string second parameter
35             # is used. For example:
36             # 'ghostent' => ['baseop', "gethostent"],
37             # replaces the B::Deparse equivalent:
38             # sub pp_ghostent { $self->listop($op, $cx, "gethostent"); }
39              
40             # Precedences in binop are given by the following table
41              
42             # Precedences:
43             # 26 [TODO] inside interpolation context ("")
44             # 25 left terms and list operators (leftward)
45             # 24 left ->
46             # 23 nonassoc ++ --
47             # 22 right **
48             # 21 right ! ~ \ and unary + and -
49             # 20 left =~ !~
50             # 19 left * / % x
51             # 18 left + - .
52             # 17 left << >>
53             # 16 nonassoc named unary operators
54             # 15 nonassoc < > <= >= lt gt le ge
55             # 14 nonassoc == != <=> eq ne cmp
56             # 13 left &
57             # 12 left | ^
58             # 11 left &&
59             # 10 left ||
60             # 9 nonassoc .. ...
61             # 8 right ?:
62             # 7 right = += -= *= etc.
63             # 6 left , =>
64             # 5 nonassoc list operators (rightward)
65             # 4 right not
66             # 3 left and
67             # 2 left or xor
68             # 1 statement modifiers
69             # 0.5 statements, but still print scopes as do { ... }
70             # 0 statement level
71             # -1 format body
72              
73              
74             %PP_MAPFNS = (
75             # 'avalues' => ['unop', 'value'],
76             # 'values' => 'unop', # FIXME
77             # 'sselect' => 'listop', FIXME: is used in PPfns
78             # 'sockpair' => 'listop', ""
79             # 'exec' => ['maybe_targmy', 'unop'],
80             # 'exp' => ['maybe_targmy', 'listop'],
81             # 'or' => ['logop', 'or', 2, '//', 10, "unless"],
82             # 'preinc' => ['maybe_targmy', 'pfixop', "++", 23],
83             # 'print' => ['indirop'],
84             # 'prtf' => ['indirop', 'printf'],
85             # 'xor' => ['logop', 'xor', 2, '', 0, ''],
86              
87             'aassign' => ['binop', '=', 7, SWAP_CHILDREN | LIST_CONTEXT, 'array assign'],
88             'abs' => ['maybe_targmy', 'unop'],
89             'accept' => 'listop',
90             'add' => ['maybe_targmy', 'binop', '+', 18, ASSIGN],
91             'aeach' => ['unop', 'each'],
92             'akeys' => ['unop', 'keys'],
93             'alarm' => 'unop',
94             'andassign' => ['logassignop', '&&='],
95             'atan2' => ['maybe_targmy', 'listop'],
96              
97             'bind' => 'listop',
98             'binmode' => 'listop',
99             'bit_and' => ['maybe_targmy', 'binop', "&", 13, ASSIGN],
100             'bit_or' => ['maybe_targmy', 'binop', "|", 12, ASSIGN],
101             'bit_xor' => ['maybe_targmy', 'binop', "^", 12, ASSIGN],
102             'bless' => 'listop',
103             'break' => 'unop',
104              
105             'caller' => 'unop',
106             'chdir' => ['maybe_targmy', 'unop'], # modified below
107             'chr' => ['maybe_targmy', 'unop'],
108             'chmod' => ['maybe_targmy', 'listop'],
109             'chomp' => ['maybe_targmy', 'unop'],
110             'chop' => ['maybe_targmy', 'unop'],
111             'chown' => ['maybe_targmy', 'listop'],
112             'chroot' => ['maybe_targmy', 'unop'],
113             'close' => 'unop',
114             'closedir' => 'unop',
115             'connect' => 'listop',
116             'complement' => ['maybe_targmy', 'pfixop', '~', 21],
117             'concat' => ['maybe_targmy', 'concat'],
118             'continue' => 'unop',
119             'cos' => ['maybe_targmy', 'unop'],
120             'crypt' => ['maybe_targmy', 'listop'],
121              
122             'db_open' => 'listop',
123             'dbmclose' => 'unop',
124             'dbmopen' => 'listop',
125             'dbstate' => 'cops',
126             'defined' => 'unop',
127             'die' => 'listop',
128             'divide' => ['maybe_targmy', 'binop', "/", 19, ASSIGN],
129             'dor' => ['logop', 'or', '//', 10],
130             'dorassign' => ['logassignop', '//='],
131             'dump' => ['loopex', "CORE::dump"],
132              
133             'each' => 'unop',
134             'egrent' => ['baseop', 'endgrent'],
135             'ehostent' => ['baseop', "endhostent"],
136             'enetent' => ['baseop', "endnetent"],
137             'enterwrite' => ['unop', "write"],
138             'eof' => 'unop',
139             'eprotoent' => ['baseop', "endprotoent"],
140             'epwent' => ['baseop', "endpwent"],
141             'eservent' => ['baseop', "endservent"],
142             'exit' => 'unop',
143              
144             'fc' => 'unop',
145             'fcntl' => 'listop',
146             'fileno' => 'unop',
147             'flock' => ['maybe_targmy', 'listop'],
148             'fork' => 'baseop',
149             'formline' => 'listop', # see also deparse_format
150             'ftatime' => ['filetest', "-A"],
151             'ftbinary' => ['filetest', "-B"],
152             'ftblk' => ['filetest', "-b"],
153             'ftchr' => ['filetest', "-c"],
154             'ftctime' => ['filetest', "-C"],
155             'ftdir' => ['filetest', "-d"],
156             'fteexec' => ['filetest', "-x"],
157             'fteowned' => ['filetest', "-O"],
158             'fteread' => ['filetest', "-r"],
159             'ftewrite' => ['filetest', "-w"],
160             'ftfile' => ['filetest', "-f"],
161             'ftis' => ['filetest', "-e"],
162             'ftlink' => ['filetest', "-l"],
163             'ftmtime' => ['filetest', "-M"],
164             'ftpipe' => ['filetest', "-p"],
165             'ftrexec' => ['filetest', "-X"],
166             'ftrowned' => ['filetest', "-o"],
167             'ftrread' => ['filetest', '-R'],
168             'ftrwrite' => ['filetest', "-W"],
169             'ftsgid' => ['filetest', "-g"],
170             'ftsize' => ['filetest', "-s"],
171             'ftsock' => ['filetest', "-S"],
172             'ftsuid' => ['filetest', "-u"],
173             'ftsvtx' => ['filetest', "-k"],
174             'fttext' => ['filetest', "-T"],
175             'fttty' => ['filetest', "-t"],
176             'ftzero' => ['filetest', "-z"],
177              
178             'getc' => 'unop',
179             'getlogin' => 'baseop',
180             'getpeername' => 'unop',
181             'getpgrp' => ['maybe_targmy', 'unop'],
182             'getppid' => ['maybe_targmy', 'baseop'],
183             'getpriority' => ['maybe_targmy', 'listop'],
184             'getsockname' => 'unop',
185             'ggrent' => ['baseop', "getgrent"],
186             'ggrgid' => ['unop', "getgrgid"],
187             'ggrnam' => ['unop', "getgrnam"],
188             'ghbyaddr' => ['listop', 'gethostbyaddr'],
189             'ghbyname' => ['unop', "gethostbyname"],
190             'ghostent' => ['baseop', "gethostent"],
191             'gmtime' => 'unop',
192             'gnbyaddr' => ['listop', "getnetbyaddr"],
193             'gnbyname' => ['unop', "getnetbyname"],
194             'gnetent' => ['baseop', "getnetent"],
195             'goto' => ['loopex', "goto"],
196             'gpbyname' => ['unop', "getprotobyname"],
197             'gpbynumber' => ['listop', 'getprotobynumber'],
198             'gprotoent' => ['baseop', "getprotoent"],
199             'gpwent' => ['baseop', "getpwent"],
200             'gpwnam' => ['unop', "getpwnam"],
201             'gpwuid' => ['unop', "getpwuid"],
202             'grepstart' => ['baseop', "grep"],
203             'grepwhile' => ['mapop', 'grep'],
204             'gsbyname' => ['listop', 'getservbyname'],
205             'gsbyport' => ['listop', 'getservbyport'],
206             'gservent' => ['baseop', "getservent"],
207             'gsockopt' => ['listop', 'getsockopt'],
208              
209             'hex' => ['maybe_targmy', 'unop'],
210              
211             'i_add' => ['maybe_targmy', 'binop', "+", 18, ASSIGN],
212             'i_divide' => ['maybe_targmy', 'binop', "/", 19, ASSIGN],
213             'i_modulo' => ['maybe_targmy', 'binop', "%", 19, ASSIGN],
214             'i_multiply' => ['maybe_targmy', 'binop', "*", 19, ASSIGN],
215             'i_predec' => ['maybe_targmy', 'pfixop', "--", 23],
216             'i_preinc' => ['maybe_targmy', 'pfixop', "++", 23],
217             'i_subtract' => ['maybe_targmy', 'binop', "-", 18, ASSIGN],
218             'index' => ['maybe_targmy', 'listop'],
219             'int' => ['maybe_targmy', 'unop'],
220             'ioctl' => 'listop',
221              
222             'join' => ['maybe_targmy', 'listop'],
223             'keys' => 'unop',
224             'kill' => ['maybe_targmy', 'listop'],
225              
226             'last' => 'loopex',
227             'lc' => 'dq_unop',
228             'lcfirst' => 'dq_unop',
229             'left_shift' => ['maybe_targmy', 'binop', "<<", 17, ASSIGN],
230             'length' => ['maybe_targmy', 'unop'],
231             'link' => ['maybe_targmy', 'listop'],
232             'listen' => 'listop',
233             'localtime' => 'unop',
234             'lock' => 'unop',
235             'log' => ['maybe_targmy', 'unop'],
236             'lstat' => 'filetest',
237              
238             'mapwhile' => ['mapop', 'map'],
239             'match' => ['matchop', 'm', "/"],
240             'mkdir' => ['maybe_targmy', 'listop'],
241             'modulo' => ['maybe_targmy', 'binop', "%", 19, ASSIGN],
242             'msgctl' => 'listop',
243             'msgget' => 'listop',
244             'msgrcv' => 'listop',
245             'msgsnd' => 'listop',
246             'multiply' => ['maybe_targmy', 'binop', '*', 19, ASSIGN],
247              
248             'nbit_and' => ['maybe_targmy', 'binop', "&", 13, ASSIGN],
249             'nbit_or' => ['maybe_targmy', 'binop', "|", 12, ASSIGN],
250             'nbit_xor' => ['maybe_targmy', 'binop', "^", 12, ASSIGN],
251             'next' => 'loopex',
252             'nextstate' => 'cops',
253              
254             'oct' => ['maybe_targmy', 'unop'],
255             'ord' => ['maybe_targmy', 'unop'],
256             'open' => 'listop',
257             'open_dir' => ['listop', 'opendir'],
258             'orassign' => ['logassignop', '||='],
259              
260             'padav' => 'pp_padsv',
261             'padhv' => 'pp_padsv',
262             'pack' => 'listop',
263             'pipe_op' => ['listop', 'pipe'],
264             'pop' => 'unop',
265             'postdec' => ['maybe_targmy', 'pfixop', "--", 23, POSTFIX],
266             'postinc' => ['maybe_targmy', 'pfixop', "++", 23, POSTFIX],
267             'pow' => ['maybe_targmy', 'binop', "**", 22, ASSIGN],
268             'prototype' => 'unop',
269             'push' => ['maybe_targmy', 'listop'],
270             # 'pushre' => ['matchop', 'm', '/'],
271              
272             'quotemeta' => ['maybe_targmy', 'dq_unop'],
273             # 'qr' => ['matchop', 'qr', '/'],
274              
275             'rand' => ['maybe_targmy', 'unop'],
276             'read' => 'listop',
277             'readdir' => 'unop',
278             'readlink' => 'unop',
279             'recv' => 'listop',
280             'redo' => 'loopex',
281             'ref' => 'unop',
282             'rename' => ['maybe_targmy', 'listop'],
283             'repeat' => ['maybe_targmy', 'repeat'], # modified below
284             'reset' => 'unop',
285             'return' => ['listop', 'return', undef, 1],
286             'reverse' => 'listop',
287             'rewinddir' => 'unop',
288             'right_shift' => ['maybe_targmy', 'binop', ">>", 17, ASSIGN],
289             'rindex' => ['maybe_targmy', 'listop'],
290             'rmdir' => ['maybe_targmy', 'unop'],
291             'runcv' => ['unop', '__SUB__'],
292              
293             'say' => 'indirop',
294             'schomp' => ['maybe_targmy', 'unop', 'chomp'],
295             'schop' => ['maybe_targmy', 'unop', 'chop'],
296             'seek' => 'listop',
297             'seekdir' => 'listop',
298             'select' => 'listop',
299             'semctl' => 'listop',
300             'semget' => 'listop',
301             'semop' => 'listop',
302             'send' => 'listop',
303             'setstate' => 'nextstate',
304             'setpgrp' => ['maybe_targmy', 'listop'],
305             'setpriority' => ['maybe_targmy', 'listop'],
306             'sgrent' => ['baseop', "setgrent"],
307             'shift' => 'unop',
308             'shmctl' => 'listop',
309             'shmget' => 'listop',
310             'shmread' => 'listop',
311             'shmwrite' => 'listop',
312             'shostent' => ['unop', "sethostent"],
313             'shutdown' => 'listop',
314             'sin' => ['maybe_targmy', 'unop'],
315             'sleep' => ['maybe_targmy', 'unop'],
316             'snetent' => ['unop', "setnetent"],
317             'socket' => 'listop',
318             'sort' => "indirop",
319             'splice' => 'listop',
320             'sprintf' => ['maybe_targmy', 'listop'],
321             'sprotoent' => ['unop', "setprotoent"],
322             'spwent' => ['baseop', "setpwent"],
323             'sqrt' => ['maybe_targmy', 'unop'],
324             'srand' => 'unop',
325             'sselect' => ['listop', "select"],
326             'sservent' => ['unop', "setservent"],
327             'ssockopt' => ['listop', "setsockopt"],
328             'stat' => 'filetest',
329             'study' => 'unop',
330             'subtract' => ['maybe_targmy', 'binop', "-", 18, ASSIGN],
331             'syscall' => 'listop',
332             'symlink' => ['maybe_targmy', 'listop'],
333             'sysopen' => 'listop',
334             'sysread' => 'listop',
335             'sysseek' => 'listop',
336             'system' => ['maybe_targmy', 'listop'],
337             'syswrite' => 'listop',
338              
339             'tell' => 'unop',
340             'telldir' => 'unop',
341             'tie' => 'listop',
342             'tied' => 'unop',
343             'time' => ['maybe_targmy', 'baseop'],
344             'tms' => ['baseop', 'times'],
345              
346             'uc' => 'dq_unop',
347             'ucfirst' => 'dq_unop',
348             'umask' => 'unop',
349             'undef' => 'unop',
350             'unlink' => ['maybe_targmy', 'listop'],
351             'unpack' => 'listop',
352             'unshift' => ['maybe_targmy', 'listop'],
353             'untie' => 'unop',
354             'utime' => ['maybe_targmy', 'listop'],
355              
356             'wait' => ['maybe_targmy', 'baseop'],
357             'waitpid' => ['maybe_targmy', 'listop'],
358             'wantarray' => 'baseop',
359             'warn' => 'listop',
360             );
361              
362              
363             # Version specific modification are next...
364 8     8   59 use Config;
  8         125  
  8         2585  
365             my $is_cperl = $Config::Config{usecperl};
366              
367             if ($] >= 5.015000) {
368             # FIXME is it starting in cperl 5.26+ which add this?
369             $PP_MAPFNS{'srefgen'} = 'pp_refgen';
370              
371             if ($] <= 5.023 && $] >= 5.020) {
372             # Something is up in 5.20 - 5.22 where there is reach and rkeys
373             $PP_MAPFNS{'reach'} = ['unop', 'each'];
374             $PP_MAPFNS{'rkeys'} = ['unop', 'keys'];
375             }
376             if ($] >= 5.022) {
377             $PP_MAPFNS{'scomplement'} = ['maybe_targmy', 'pfixop', "~.", 21];
378             $PP_MAPFNS{'ncomplement'} = ['maybe_targmy', 'pfixop', '~', 21];
379             }
380             }
381              
382             if ($is_cperl) {
383             $PP_MAPFNS{'s_cmp'} = ['maybe_targmy', 'binop', "cmp", 14];
384             $PP_MAPFNS{'s_eq'} = ['binop', "eq", 14];
385             $PP_MAPFNS{'s_ge'} = ['binop', "ge", 15];
386             $PP_MAPFNS{'s_gt'} = ['binop', "gt", 15];
387             $PP_MAPFNS{'s_le'} = ['binop', "le", 15];
388             $PP_MAPFNS{'s_lt'} = ['binop', "lt", 15];
389             $PP_MAPFNS{'s_ne'} = ['binop', "ne", 14];
390             # FIXME reconcile differences in cperl. Maybe cperl is right?
391             delete $PP_MAPFNS{'chdir'};
392             }
393              
394             if ($] < 5.012000) {
395             # Earlier than 5.12 doesn't use "targmy"?
396             $PP_MAPFNS{'repeat'} = 'repeat';
397             }
398              
399             @EXPORT = qw(%PP_MAPFNS);
400              
401             1;