package List;
# List module: build LAZY linked lists using references, OO version
#
#	build the equivalent of the Haskell-style data decln:
#		data list = nil or cons( scalar head, list tail )
#	representing nil as [], and cons(h,t) as [h,t] (a 2-tuple)
#
# to add laziness: a tail can either be a normal list (nil or cons()),
# or a PROMISE (a coderef) that when INVOKED (FORCED) delivers the
# rest of the List - or at least the next (head, promise) pair..

use strict;
use warnings;
use Function::Parameters qw(:strict);
use Exporter qw(import);

our @EXPORT = qw(map_l grep_l merge_l);

our $as_string_limit = 100;        # as_string limit ("display first N").

# $l = List->nil - return an empty list
#
fun nil( $class )
{
	return bless [], $class;
}

# $l = List->cons( $head, $tail ) - return a new list node.
#	$head becomes the head of the new list, and $tail the tail.
#
fun cons( $class, $head, $tail )
{
	return bless [ $head, $tail ], $class;
}

# $isnil = $list->isnil - return true iff the given list is nil
#
method isnil()
{
	die "List::isnil, bad list ".Dumper($self) unless
		$self->isa("List") && (@$self == 0 || @$self == 2);
	return @$self == 0 ? 1 : 0;
}

# ( $head, $tail ) = $list->headtail - break nonempty list into head and tail
#
method headtail()
{
	die "List::headtail, bad list ".Dumper($self) unless
		$self->isa("List") && (@$self == 0 || @$self == 2);
	die "List::headtail, empty list\n" if @$self == 0;
	my( $h, $t ) = @$self;
	$t = $t->() if ref($t) eq "CODE";		# FORCE A PROMISE
	return ( $h, $t );
}

# $len = $list->len - return the length of the given list
#
method len()
{
	my $len = 0;
	while( ! $self->isnil )
	{
		( my $h, $self ) = $self->headtail;
		$len++;
	}
	return $len;
}

# $list = $l1->append( $l2 ) - build a new list comprising all of
#			       list $l1 followed by all of list $l2
#
method append( $l2 )
{
	return $l2 if $self->isnil;
	my( $h, $t ) = $self->headtail;
	return List->cons( $h, $t->append($l2) );
}

# $revlist = $list->rev - return the reverse of $list
#
method rev()
{
	my $result = List->nil;
	while( ! $self->isnil )
	{
		( my $h, $self ) = $self->headtail;
		$result = List->cons( $h, $result );
	}
	return $result;
}

# $str = $list->as_string( [$limit] ) - return the printable form of the $list
#
method as_string( $limit = $as_string_limit )
{
	my $str = "";
	for( my $i = 1; ! $self->isnil && ($limit == 0 || $i <= $limit); $i++ )
	{
		( my $h, $self ) = $self->headtail;
		$str .= "$h, ";
	}
	chop $str; chop $str;                 # remove trailing ','
	$str .= "..." unless $self->isnil;    # must show that list has been cutoff!
	return "[ $str ]";
}

# Operator overloading of "stringify" (turn into a string)
use overload '""' => \&overload_as_string;
fun overload_as_string( $list, $x, $y )    # don’t care about last 2 params
{
	return $list->as_string;
}

# $l2 = map_l( $op, $list ) - List version of map, with
#	it's recursive helper that does the work..
#
fun _recursive_map_l( $op, $list )
{
	return List->nil() if $list->isnil;
	my( $h, $t ) = $list->headtail;
	local $_ = $h;				# set localised $_ for op
	my $tailpromise = fun { _recursive_map_l( $op, $t ); };
	return List->cons( $op->($h), $tailpromise );
}
#
fun map_l( $op, $list ) :(&$)
{
	return _recursive_map_l( $op, $list );
}

# $list2 = grep_l( $op, $list ) - List version of grep.
#	each time called: find first matching head.
#
fun _recursive_grep_l( $op, $list )
{
	while( ! $list->isnil )
	{
		my( $h, $t ) = $list->headtail;
		local $_ = $h;			# set localised copy of $_
		if( $op->($h) )			# for the filter op
		{
			my $tailpromise = fun { _recursive_grep_l( $op, $t ); };
			return List->cons( $h, $tailpromise );
		}
		$list = $t;
	}
	return List->nil;
}

fun grep_l( $op, $list ) :(&$)
{
	return _recursive_grep_l( $op, $list );
}

our $debug_merge = 0;

# $l = merge_l( $cmp, $l1, $l2 ) - merge two sorted Lists into one sorted List
#	the comparator $cmp is called with each pair of head elements ( a, b )
#	and must return -1 if a<b, 0 if a==b and +1 if a>b (just like sort)
#
fun _recursive_merge_l( $cmp, $l1, $l2 )
{
	# simple cases, one or both Lists empty
	return List->nil() if $l1->isnil && $l2->isnil;
	return $l1 if $l2->isnil;
	return $l2 if $l1->isnil;

	# ok, two non-empty Lists here
	my( $h1, $t1 ) = $l1->headtail;
	my( $h2, $t2 ) = $l2->headtail;

	# set up elements $a and $b for comparator (like in sort)
	local $main::a = $h1; $main::a += 0; # suppress warning!
	local $main::b = $h2; $main::b += 0; # suppress warning!

	# compare h1 and h2 to find out which order they should come in
	my $cmpres = $cmp->($h1, $h2);
	print "debug: merge_l, h1=$h1, h2=$h2, cmpres=$cmpres\n" if
		$debug_merge;

	# if h1 is smaller, place h1 at the front of the result, merge rest
	return List->cons( $h1, fun { merge_l($cmp,$t1,$l2) } ) if $cmpres <= 0;

	# otherwise, place h2 at the front, merge the rest
	return List->cons( $h2, fun { merge_l($cmp,$l1,$t2) } );
}

fun merge_l( $cmp, $l1, $l2 ) :(&$$)
{
	return _recursive_merge_l( $cmp, $l1, $l2 );
}

1;
