
// See http://www.okisoft.co.jp/esc/scala-lisp

// A Tiny Lisp Interpreter in Scala 2.7.7 by (鈴) H21.12/4
// 
// Cf. J. McCarthy: A Micro-Manual for Lisp - Not the Whole Truth,
//     ACM SIGPLAN Notices, Vol. 13, No. 8, August 1978, pp.215-216

package lisp

import scala.util.parsing.combinator._
import java.io.FileReader

class SExprParsers extends JavaTokenParsers {
  lazy val list: Parser[List[Any]] = "(" ~> rep(expr) <~ ")"
  lazy val quot: Parser[List[Any]] = ("'" ~> expr) ^^ (x => List('quote, x))
  lazy val expr: Parser[Any] = {
    list | quot |
    stringLiteral ^^ (s => s.substring(1, s.length() - 1)) |
    wholeNumber ^^ (_.toLong) |
    """[a-zA-Z_\+\-\*\<]+""".r ^^ (name => Symbol(name))
  }
}

object Lisp {
  type AList = List[(Symbol, Any)]      // Association List

  val MINUS_SYMBOL = Symbol("-")        //  '- causes a syntax error.
  val STAR_SYMBOL = Symbol("*")         // So does '*

  def eval(e: Any, a: AList): Any = e match {
    case car::cdr => car match {
      case 'quote =>
        val fst::Nil = cdr; fst

      case 'car =>
        val hd::tl = ev1arg(cdr, a); hd
      case 'cdr =>
        val hd::tl = ev1arg(cdr, a); tl
      case 'atom =>
        convBoolean(! ev1arg(cdr, a).isInstanceOf[::[_]])

      case 'cons =>
        val (x: Any, y: List[_]) = ev2args(cdr, a); x::y
      case 'eq =>
        convBoolean(ev2args(cdr, a) match {
          case (r: List[_], s: List[_]) => r eq s
          case (x, y) => x == y
        })

      case '+ =>
        val (r: Long, s: Long) = ev2args(cdr, a); r + s
      case MINUS_SYMBOL =>
        val (r: Long, s: Long) = ev2args(cdr, a); r - s
      case STAR_SYMBOL =>
        val (r: Long, s: Long) = ev2args(cdr, a); r * s
      case '< =>
        val (r: Long, s: Long) = ev2args(cdr, a); convBoolean(r < s)

      case 'cond => evcond(cdr, a)
      case (functionName: Symbol) =>
        val fun = fetch(functionName, a); eval(fun::cdr, a)

      case caar::cdar => caar match {
        case 'lambda => {
          val params::body::Nil = cdar
          val paramSymbols = params.asInstanceOf[List[Symbol]]
          val argVals = evlis(cdr, a)
          val env = (paramSymbols zip argVals) ::: a
          eval(body, env)
        }
        case 'label => {
          val fun::lambdaExp::Nil = cdar
          val exp = lambdaExp::cdr
          val funSymbol = fun.asInstanceOf[Symbol]
          val env = (funSymbol, car) :: a
          eval(exp, env)
        }
      }
    }
    case 'nil => Nil
    case 't => 't
    case (variableName: Symbol) => fetch(variableName, a)
    case _ => e
  }

  def convBoolean(e: Boolean) = if (e) 't else Nil
  def fetch(s: Symbol, a: AList) = (a find (_._1 eq s)).get._2

  def ev1arg(e: List[Any], a: AList): Any = {
    val fst::Nil = e
    eval(fst, a)
  }

  def ev2args(e: List[Any], a: AList): (Any, Any) = {
    val fst::snd::Nil = e
    val x = eval(fst, a)
    val y = eval(snd, a)
    (x, y)
  }

  def evcond(e: List[Any], a: AList): Any = {
    val hd::tl = e
    val condition::body::Nil = hd
    if (eval(condition, a) == Nil)
      evcond(tl, a)
    else
      eval(body, a)
  }

  def evlis(args: List[Any], a: AList): List[Any] = args match {
    case Nil => Nil
    case hd::tl => eval(hd, a) :: evlis(tl, a)
  }

  def repr(e: Any): String = e match {
    case Nil => "nil"
    case (x: ::[_]) => "(" + x.map(repr).mkString(" ") + ")"
    case (x: String) => "\"" + x + "\""
    case (x: Symbol) => x.name
    case _ => e.toString
  }

  def main(args: Array[String]) {
    val reader = new FileReader(args(0))
    val parsers = new SExprParsers
    val exp = parsers.parseAll(parsers.expr, reader).get
    println(repr(exp))
    println(repr(eval(exp, Nil)))
  }
}
