From oleg@pobox.com Mon Apr 3 12:21:42 2000 Subject: Scheme in Perl, or Perl as Scheme Date: 03 Apr 2000 00:00:00 GMT Message-ID: <00ed8efe.172183af@usw-ex0103-086.remarq.com> NNTP-Posting-Date: Mon, 03 Apr 2000 12:21:42 PDT Newsgroups: comp.lang.scheme,comp.lang.perl.misc Keywords: high-order function, list, recursion, fixpoint, Scheme, Perl X-Comment: corrected based on the discussion in comp.lang.perl.misc (specifically, comment by Ilmari Karonen) Summary: emulating true lists and true Scheme style in Perl The title is not a contradiction: however unexpected, Perl and Scheme are indeed somewhat close. This article will show nested, improper and circular lists, shared data structures, fixpoint and other combinators, higher-order functions and closures -- all in Perl. Even the location of parentheses is sometimes similar to that in Scheme notation. If one wants to experiment with functional programming and flat, _proper_ lists in Perl, the easiest and the most efficient way to get started is to emulate lists as Perl's native arrays: sub cons { @_ } # cons Atom List -> List sub list { @_ } # list Atoms -> List sub car { $_[0] } # car List -> Atom -- the head of the list sub cdr { shift; @_ } # cdr List -> List -- the tail of the list sub nullp { not @_ } We can now define the famous fixpoint combinator # fixpoint Function Args ... -> # fixpoint Function(Function, ... Function(Function, # Function(Function, Args))) sub fixpoint { &{$_[0]}(@_) } # Yep, it does look like @#&$! and its close but more domesticated relative # (left) Fold combinator # foldl kons knil List -> # kons(List[n-1], kons(List[n-2], ... kons(List[0], knil))) # where n is the length of List. kons is a function of two arguments, # knil is a value sub foldl { my ($kons, $knil, @list) = @_; (nullp @list) ? $knil : foldl($kons, &$kons((car @list),$knil), (cdr @list)) } Here's a simple application, literally ripped off SRFI-1. Note an anonymous sub passed to foldl. This sub is actually a closure: it closes over $pred from the outer scope: # count Pred List -> integer # Counts the number of elements in a list satisfying a Pred. sub count { my ($pred, @args) = @_; foldl(sub { my ($elem, $accum) = @_; &$pred($elem) ? $accum + 1 : $accum}, 0, @args) } The following statement prints "3", the count of the even numbers in a sample list: print "Count: ",count( sub { $_[0] % 2 == 0 }, list(3,1,4,1,5,9,2,5,6)),"\n"; Emulating lists as Perl's arrays has obvious drawbacks. It is hard to implement improper lists, it's peculiar to pass several lists as distinct arguments to a function, it's difficult to make lists of lists and trees. Most of all, it's impossible for two lists with a common tail to share it. Perl's arrays as Scheme's vectors can't share parts of their bodies. The following is a true to R5RS authors definition of lists in Perl. A cons cell is a reference to an array of two elements, with obvious meaning. sub cons { my @x = @_; \@x } # cons Val1 Val2 -> Pair sub car { ${$_[0]}[0] } # car Pair -> Val1 sub cdr { ${$_[0]}[1] } # cdr Pair -> Val2 sub empty { \0 } # nil, that is; \() would've been a better choice, # but it caused innumerable problems, try "print \()" # An alternative suggested by Ilmari Karonen # in the discussion thread: # sub empty { [] } # nullp Arg -> TRUE iff Arg is nil sub nullp { ref $_[0] eq "SCALAR" and not $$_[0]} sub pairp { ref $_[0] eq "ARRAY" } # pairp Arg -> TRUE iff Arg is a pair sub setcar { ${$_[0]}[0] = $_[1] } # setcar Pair Val, mutation sub setcdr { ${$_[0]}[1] = $_[1] } # setcdr Pair Val, mutation sub list { # list Array -> List @_ or return (empty); my $head = shift; cons($head, list(@_)) } The following function prints proper lists, improper lists as well as nested lists (trees). The code below shows off a nested function as well as a fixpoint combinator. sub printl { # printl List -> ? my ($list) = @_; (nullp $list) and return print "()"; (pairp $list) or return print $list; # It's not a pair sub printval { my ($prefix, $val) = @_; print $prefix; printl($val); } printval( "(",(car $list) ); # The following is equivalent to a letrec or a named let fixpoint( sub { my ($self, $list) = @_; (nullp $list) and return print ")"; (not (pairp $list)) ? ( printval(" . ",$list), print ")" ) : ( printval(" ", (car $list)), &$self($self,(cdr $list))) }, (cdr $list)) } For example, printl list(); ==prints==> () printl (cons 4,(cons 3,(cons 2,1))); ==prints==> (4 3 2 . 1) printl (cons 4, list(1,2,3)); ==prints==> (4 1 2 3) printl (cons list(1,2,3),4); ==prints==> ((1 2 3) . 4) The fixpoint, fold and count functions defined at the beginning work as they are, without any changes. The code below shows a more advanced operation: flattening a list sub append { # append List1 ... -> List @_ or return (empty); # no arguments @_ == 1 and return $_[0]; # only one argument my $list = shift; (nullp $list) and return append(@_); # Ignore the empty list cons((car $list), append((cdr $list),@_)) } sub flatten { # flatten List -> List (pairp $_[0]) or return $_[0]; my $flattened_car = flatten(car $_[0]); my $flattened_cdr = flatten(cdr $_[0]); (pairp $flattened_car) ? append($flattened_car, $flattened_cdr) : (nullp $flattened_car) ? $flattened_cdr : cons($flattened_car, $flattened_cdr) } { my $tree = list(list(1,2), 3, list(4,5,list(6)), list(7,list()), list(8)); print "Original list: "; printl $tree; print"\n"; print "Flattened list: "; printl flatten($tree); print"\n"; } The code prints: Original list: ((1 2) 3 (4 5 (6)) (7 ()) (8)) Flattened list: (1 2 3 4 5 6 7 8) Genuine lists may share the common tail, as the following snippet proves: { my $x = list(1,2,3); my $y = cons(10,$x); print "Original lists "; printl $x; print " "; printl $y; print "\n"; setcar(cdr($x),11); print "After mutation: "; printl $x; print " "; printl $y; print "\n"; } Let's consider a cuter application of list mutators: # take N List -> List with no more than N elements sub take { my ($n,$list) = @_; $n > 0 or return (empty); (pairp $list) or return (empty); cons( (car $list), take($n-1,(cdr $list))); } # last_pair List -> Pair # This was an exercise recently discussed on comp.lang.scheme sub last_pair_ss { (not (pairp $_[0])) ? $_[0] : (nullp (cdr $_[0])) ? $_[0] : last_pair(cdr $_[0]) } The following implementation is more in Perl style, but just as functional as well as more logical (both puns intended) sub last_pair { pairp($_[0]) or return $_[0]; my $tail = (cdr $_[0]); nullp($tail) and return $_[0]; last_pair($tail) } { print "\nMaking a cicular list!\n"; my $x = list(1,2,3,4,5); setcdr(last_pair($x),$x); print "The first 13 elements of the list are: "; printl take(13,$x); } Alas, the circular list $x will remain forever garbage... There is an often-quoted saying by Guy L. Steele Jr.: "If you give someone Fortran, he has Fortran. If you give someone Lisp, he has any language he pleases." It appears that for some languages, the converse is also true. If you give someone this language, he has Lisp. Thinking in a recursive, functional style indeed has advantages; for example, it meshes well with a problem decomposition, a divide-and-conquer approach. The other result of this exercise is to make me appreciate more the syntax of Scheme -- or the lack of it.