view release on metacpan or  search on metacpan

lib/Devel/Chitin/OpTree/LISTOP.pm  view on Meta::CPAN

    'socket(' . join(', ',  $children->[1]->deparse,
                            $domain, $type,
                            $children->[4]->deparse) . ')';
}

sub pp_sockpair {
    my $children = shift->children;
    my $domain = $addr_types{ $children->[3]->deparse(skip_quotes => 1) }
                    || $children->[3]->deparse;
    my $type = $sock_types{ $children->[4]->deparse(skip_quotes => 1) }
                    || $children->[4]->deparse;
    my $proto = $sock_domains{ $children->[5]->deparse(skip_quotes => 1) }
                    || $children->[5]->deparse;

    'socketpair(' . join(', ',  $children->[1]->deparse,
                                $children->[2]->deparse,
                                $domain, $type, $proto) . ')';
}

sub pp_substr {
    my $self = shift;
    my $children = $self->children;
    if ($^V ge v5.16.0 and $self->op->private & B::OPpSUBSTR_REPL_FIRST()) {
        # using subtr as an lvalue
        my @substr_params = @{$children}[2..4];
        'substr('
            . join(', ', map { $_->deparse } @substr_params)
            . ') = '
            . $children->[1]->deparse;
    } else {
        'substr('
            . join(', ', map { $_->deparse } @$children[1 .. $#$children]) # [0] is pushmark
            . ')';
    }
}

sub pp_mapstart { 'map' }
sub pp_grepstart { 'grep' }

#                 OP name           Perl fcn    targmy?
foreach my $a ( [ pp_crypt      => 'crypt',     1 ],
                [ pp_pack       => 'pack',      0 ],
                [ pp_reverse    => 'reverse',   0 ],
                [ pp_sprintf    => 'sprintf',   0 ],
                [ pp_atan2      => 'atan2',     1 ],
                [ pp_push       => 'push',      1 ],
                [ pp_unshift    => 'unshift',   1 ],
                [ pp_splice     => 'splice',    1 ],
                [ pp_join       => 'join',      1 ],
                [ pp_binmode    => 'binmode',   0 ],
                [ pp_die        => 'die',       0 ],
                [ pp_warn       => 'warn',      0 ],
                [ pp_read       => 'read',      0 ],
                [ pp_sysread    => 'sysread',   0 ],
                [ pp_syswrite   => 'syswrite',  0 ],
                [ pp_seekdir    => 'seekdir',   0 ],
                [ pp_syscall    => 'syscall',   0 ],
                [ pp_select     => 'select',    0 ],
                [ pp_sselect    => 'select',    0 ],
                [ pp_vec        => 'vec',       0 ],
                [ pp_chown      => 'chown',     1 ],
                [ pp_fcntl      => 'fcntl',     1 ],
                [ pp_ioctl      => 'ioctl',     1 ],
                [ pp_open       => 'open',      0 ],
                [ pp_open_dir   => 'opendir',   0 ],
                [ pp_rename     => 'rename',    0 ],
                [ pp_link       => 'link',      1 ],
                [ pp_symlink    => 'symlink',   1 ],
                [ pp_unlink     => 'unlink',    1 ],
                [ pp_utime      => 'utime',     1 ],
                [ pp_formline   => 'formline',  0 ],
                [ pp_gpbynumber => 'getprotobynumber', 0 ],
                [ pp_gsbyname   => 'getservbyname', 0 ],
                [ pp_gsbyport   => 'getservbyport', 0 ],
                [ pp_return     => 'return', 0 ],
                [ pp_kill       => 'kill',      1 ],
                [ pp_pipe_op    => 'pipe',      0 ],
                [ pp_getpriority=> 'getpriority',   1 ],
                [ pp_setpriority=> 'setpriority',   1 ],
                [ pp_setpgrp    => 'setpgrp',   1 ],
                [ pp_bless      => 'bless',     0 ],
                [ pp_tie        => 'tie',       0 ],
                [ pp_accept     => 'accept',    0 ],
                [ pp_bind       => 'bind',      0 ],
                [ pp_connect    => 'connect',   0 ],
                [ pp_listen     => 'listen',    0 ],
                [ pp_gsockopt   => 'getsockopt',0 ],
                [ pp_ssockopt   => 'setsockopt',0 ],
                [ pp_send       => 'send',      0 ],
                [ pp_recv       => 'recv',      0 ],
                [ pp_shutdown   => 'shutdown',  0 ],
                [ pp_msgctl     => 'msgctl',    0 ],
                [ pp_msgget     => 'msgget',    0 ],
                [ pp_msgsnd     => 'msgsnd',    0 ],
                [ pp_msgrcv     => 'msgrcv',    0 ],
                [ pp_semctl     => 'semctl',    0 ],
                [ pp_semget     => 'semget',    0 ],
                [ pp_semop      => 'semop',     0 ],
                [ pp_shmctl     => 'shmctl',    0 ],
                [ pp_shmget     => 'shmget',    0 ],
                [ pp_shmread    => 'shmread',   0 ],
                [ pp_shmwrite   => 'shmwrite',  0 ],
) {
    my($pp_name, $perl_name, $targmy) = @$a;
    my $sub = sub {
        my $self = shift;
        my $children = $self->children;

        my $target = $targmy ? $self->_maybe_targmy : '';
        "${target}${perl_name}("
            . join(', ', map { $_->deparse } @$children[1 .. $#$children]) # [0] is pushmark
            . ')';
    };
    no strict 'refs';
    *$pp_name = $sub;
}

my($INDEX_BOOLNEG, $INDEX_TRUEBOOL) = $^V ge v5.28.0
                                    ? (B::OPpINDEX_BOOLNEG(), B::OPpTRUEBOOL())
                                    : (0,0);
foreach my $index_fcn ( 'index', 'rindex') {