A core perl port of https://aphyr.com/posts/340-acing-the-technical-interview

acing-the-technical-interview.pl

use v5.24.0;                                                                                                            
use warnings;                                                                                                           
use feature 'signatures';                                                                                               
no warnings 'experimental::signatures';                                                                                 
# https://aphyr.com/posts/340-acing-the-technical-interview                                                             
                                                                                                                        
sub true()  { 1 }                                                                                                       
sub false() { 0 }                                                                                                       
                                                                                                                        
sub cons($h, $t) {                                                                                                      
    sub ($x) { $x ? $h : $t }                                                                                           
}                                                                                                                       
                                                                                                                        
                                                                                                                        
{                                                                                                                       
    my $x = cons 1, cons 2, undef;                                                                                      
    say $x->(true);                                                                                                     
    # 1                                                                                                                 
    say $x->(false)->(true);                                                                                            
    # 2                                                                                                                 
                                                                                                                        
    say $x;                                                                                                             
    # CODE(0x947a5f8)                                                                                                   
}                                                                                                                       
                                                                                                                        
                                                                                                                        
sub nth($l, $n) {                                                                                                       
    $l and                                                                                                              
        $n == 0                                                                                                         
            ? $l->(true)                                                                                                
            : __SUB__->($l->(false), $n - 1)                                                                            
}                                                                                                                       
                                                                                                                        
                                                                                                                        
sub prn_list($l) {                                                                                                      
    print "(";                                                                                                          
    sub ($l) {                                                                                                          
        !defined $l                                                                                                     
            ? print ")\n"                                                                                               
            : do {                                                                                                      
                print $l->(true);                                                                                       
                print " " if $l->(false);                                                                               
                __SUB__->($l->(false))                                                                                  
            }                                                                                                           
    }->($l)                                                                                                             
}                                                                                                                       
                                                                                                                        
prn_list cons 1, cons 2, cons 3, undef;                                                                                 
# (1 2 3)                                                                                                               
                                                                                                                        
sub reversed($l) {                                                                                                      
    sub ($r, $l) {                                                                                                      
        $l                                                                                                              
            ? __SUB__->(cons($l->(true), $r), $l->(false))                                                              
            : $r                                                                                                        
    }->(undef, $l)                                                                                                      
}                                                                                                                       
                                                                                                                        
prn_list reversed cons 1, cons 2, cons 3, undef;                                                                        
# (3 2 1)