#!perl 

use Math::BigInt;

# Forward declaraties
sub lisp_eval(@);
sub map_lisp_eval(@);
sub showlist(@);
sub parse();

# Globale variabelen
my %bound;    # Bevat de lokale variabelen op het huidige stackframe

# tokenize()  Leest telkens een token (haakje of willekeurige
# andere string) van STDIN en retourneert die (dus stateful).
{
  sub get_line() {
    my $x  = (scalar(<>) or '');
    $x =~ s/\;.*//;
    return $x;
  }

  my $line = get_line();
  sub tokenize() {

    # Blok met redo wanneer geen token gevonden
    {
      # $line bevat minimaal een newline, tenzij EOF
      return undef if not $line;

      # Regexp: haakje, apostrophe of willekeurige string
      return $& if $line =~ m$\(|\)|\'|[^\(\)\'\s]+$g;

      $line = get_line();
      redo;
    }
  }
}

# parse()  Parst recursief de tokens die worden opgeleverd
# door tokenize() en retourneert een ref naar een lijst.
# Als in de invoer een lijst andere lijsten bevat, bevat de
# uitvoer scalars van het type \@ ofwel reference naar lijst.

sub parse() {
  my @thislist;

  # Doorgaan met parsen tot aan EOF of sluithaakje
  while(1) {
    my $token = tokenize;
    return \@thislist if !defined($token) or $token eq ')';

#    print "Token: $token\n";

    if ($token eq '(') {
      # Lijst binnen lijst, recursief parsen en ref naar lijst invoegen
      $token = parse();
    }
    elsif ($token eq "'") { # 'x is een afkorting voor (quote x)
      # Sorry hoor, last-minute hack..
      $token = tokenize;
      my @arr = ('quote', ($token eq '(' ? parse() : $token));
      $token = \@arr;
    }

    push @thislist, $token;
  }
}

# showlist()  Loopt een lijst (met \@ references erin) recursief
# af en toont hem als een string.
sub showlist(@) {
  my($str, @lst) = ('', @_);

  foreach $elem (@lst) {
    if ('ARRAY' eq ref($elem)) {
      $str = ($str ? "$str " : '') . '(' . showlist(@$elem) . ')';
    }
    else {
      $str = ($str ? "$str " : '') . $elem;
    }
  }

  return $str;
}

# lisp_define()  Definieert een Lisp-functie of variabele. Eerste argument
# is een lijst (voor functies) of een string (voor variabelen). Overige
# argumenten vormen de body. In het geval van een variabele wordt de hele
# body geëvalueerd en geldt de waarde van de laatste expressie.
sub lisp_define($@) {
  my ($decl, @body) = @_;

  if ('ARRAY' eq ref($decl)) {    # Functie-definitie
    my($name, @vars) = @$decl;

    # Anonieme functie maken (closure!) en in %lisp_fn stoppen
    $lisp_fn{$name} = sub {
      %bound = map {$_, $bound{$_} = shift @_} @vars;
      map_lisp_eval(@body);
    }
  }
}

%lisp_fn = (
    '+'             => sub { my $sum = 0; map { $sum += $_ } @_; return $sum; },
    '-'             => sub { my $sum = (shift @_ or 0); map { $sum -= $_ } @_; return $sum; },
    '*'             => sub { my $sum = 1; map { $sum *= $_ } @_; return $sum; },
    '/'             => sub { my $sum = (shift @_ or 0); map { $sum /= $_ } @_; return $sum; },
    '='             => sub { return ($_[0] == $_[1]); },
    'eq'            => sub { return ($_[0] eq $_[1]); },
    'print'         => sub { print showlist(@_), "\n"; },
    'bigint'        => sub { map { new Math::BigInt $_ } @_; },
    'show'          => \&showlist,
    'eval'          => \&lisp_eval,
  );

%lisp_macro = (
    'quote'         => sub { return $_[0]; },
    'define'        => \&lisp_define,
    'if'            => sub { my ($cond, $yes, $no) = @_; return (lisp_eval($cond) ? lisp_eval($yes) : lisp_eval($no)); },
);

%lisp_vars = (
    'nil'           => undef,
    't'             => 1,
);

sub lisp_eval(@) {
  my($fn, @args) = @_;

  while ('ARRAY' eq ref($fn)) {
    $fn = lisp_eval @$fn;
  }

  if (exists $lisp_fn{$fn}) {
    my @params = map { ('ARRAY' eq ref($_)) ? lisp_eval(@$_) : lisp_eval($_) } @args;
    return &{$lisp_fn{$fn}} (@params);
  }
  elsif (exists $lisp_macro{$fn}) {
    return &{$lisp_macro{$fn}} (@args);
  }
  elsif (exists $bound{$fn}) {
    return $bound{$fn};
  }
  elsif (exists $lisp_vars{$fn}) {
    return $lisp_vars{$fn};
  }
  elsif (not @args) {
    return $fn;
  }
  else {
    warn "Lisp fout: $fn is geen geldige functie!\n";
    return undef;
  }
}

sub map_lisp_eval(@) {
  my $retval;
  foreach (@_) {
    $retval = ('ARRAY' eq ref() ? lisp_eval @$_ : $_);
  }

  return $retval;
}

$program = parse();

#print showlist(@$program) . "\n";
map_lisp_eval(@$program);