

{ my @tokens;

  sub more_input {
    my $s = shift;
    my @toks = split /(         # these tokens are interesting
                         [()]   # parentheses
                      |         #   or
                         \'     # single-quote
                      |         #   or
                         \"[^\"]*\" # quoted strings
                      )
                       |
                         \s+    # whitespace is not interesting
                     /x, $s;
    push @tokens, grep {$_ ne '' } @toks;
  }


  sub next_token {
    return 'EOF' if @tokens == 0;
    my $t = shift @tokens;
    if ($t eq '(' || $t eq ')' || $t eq "'" ) { return $t } 
    elsif ($t =~ /^"(.*)"$/) { return 'STRING', $1 }
    elsif ($t =~ /^\d*\.\d+([eE]-?\d+)?$/) { return 'FLOAT', $t }
    elsif ($t =~ /^\d+$/) { return 'INT', $t }
    else { return 'SYMBOL', $t }
  }
}

sub parse_sexp {
  my ($type, $val) = next_token();
  if ($type eq ')' || $type eq 'EOF') {
    return;
  } elsif ($type eq '(') {
    my $subexps = ['LIST'];
    while (my $se = parse_sexp()) {
      push @$subexps, $se;
    }
    return $subexps;
  } elsif ($type eq "'") {    # 'foo compiles as (QUOTE foo)
    my $subexps = ['LIST', ['SYMBOL', 'QUOTE']];
    push @$subexps, parse_sexp();
    return $subexps;
  } else {
    return [$type, $val];
  }
}

sub parse_lisp {
  while (<DATA>) {
    more_input($_);
  }
  while (my $sexp = parse_sexp()) {
    lisp_eval($sexp);
  }
}


sub lisp_eval {
  # Michael Fischer will write this part
  print_lisp(shift());  # Until then, just print out the expression we would have eval'ed
}

sub print_lisp {
  my @sexp = @{shift()};
  my $type = shift @sexp;
  if ($type eq 'LIST') {
    print "(";
    while (my $elt = shift @sexp) {
      print_lisp($elt);
#      print " ";
    } 
    print ") ";
  } else {
    print "@sexp ";
  }
}

parse_lisp();

__DATA__
(defun (fact n) 
  "factorial function"
  (cond ((= n 0) 1)
        ( t (* n (fact (-1 n))))))
'(a b 'c)
