printf "10 factorial is %d", scheme_procs('factorial', 1, 10);

my $ls = mklist(1,5,5,7,3,6); # make a list

print pair_str($ls) . "\n"; # print it

my $max = scheme_procs('max', $ls); # get the max

printf "Max is $max\n";

#pair_push($ls,$ls); # make a circular list!!
# now do the bad thing, never terminate but monitor
# memory usage
#$max = scheme_procs('max', $ls); # get the max
#printf "Max is $max\n";


###################################################
# call scheme_procs(proc name, args);
###################################################
sub scheme_procs{
    my $proc = shift;
    if($proc eq 'max'){ # go to the correct label
        goto SCM_MAX;
    } elsif($proc eq 'factorial'){
        goto SCM_FACTORIAL;
    } else {
        die "no such proc: $proc";
    }

SCHEME_RP:  # return the return values
    if(wantarray){
        return(@_);
    } else {
        return $_[0];
    }

SCM_FACTORIAL:
    my ($total,$n) = @_;
    if($n == 0){
        @_ = ($total);
        goto SCHEME_RP; # return
    } else {
        @_ = ($total*$n, $n - 1);
        goto SCM_FACTORIAL; # tail call
    }

SCM_MAX:
    my $p = shift;
    print_resources();
    if(null($p)){
        die "Error";
    }
    if(null(cdr($p))){
        @_ = (car($p));
        goto SCHEME_RP; # return
    } else {
        if(car($p) > (car(cdr($p)))){
            @_ = (cons(car($p), cdr(cdr($p))));
            goto SCM_MAX; # tail call
        } else {
            @_ = (cdr($p));
            goto SCM_MAX; # tail call
        }
    }
}


# helper functions for our simplistic scheme subsystem 
sub cons{ my($a,$d) = @_; [$a,$d] }
sub car{ shift->[0] }
sub cdr{ shift->[1] }
sub null{ not defined shift }
sub set_cdr{ my ($ls, $v) = @_;  $ls->[1] = $v }
sub mklist{
    return unless @_;
    return cons(shift, mklist(@_));
}
sub pair_str{
    my $p = shift;
    if(ref $p eq 'ARRAY'){
         "(" . pair_str(car($p)) . " " . pair_str(cdr($p)) . ")";
    } else {
        if(null($p)){
            "()"
        } else {
            $p;
        }
    }
}

# this is a really bad resource monitor but works to monitor 
# memory growth to check for proper tail recursion
sub print_resources{
    my @lines = grep {$_ =~ /\s+(\d+)/ and $1 eq $$}  `ps u`;
    print @lines;
}