// Copyright 2010 Henry Strickland
// Open Source under BSD or MIT license.

package main

import "fmt"
import "os"
//import "reflect"

func main() {
  for k, v := range os.Args {
    println(k);
    println(v);
  }

  hey := Intern("hey");
  you := Intern("you");
  Say("hey", hey);
  Say("you", you);
  Say("NIL", NIL);
  Say("CAR", CAR);
  Say("TWO", TWO);
  Say("(eq.nil)", Cons(EQ, NIL));
  Say("(eq.bad)", Cons(EQ, Cdr(NIL)));
  Say("(eq.bad)", Cons(EQ, Cdr(Car(NIL))));
  env := Builtins();
  Say("2", Eval(TWO, env));
  Say("10", Eval(Int10, env));
  Say("fCar", Lookup(CAR, env));
  Say("fCdr", Lookup(CDR, env));
  Say("nil", Lookup(NIL, env));
  env = env.Bind(hey, Intern("*HEY*"));
  env = env.Bind(you, Intern("*YOU*"));

  X := Intern("x");  // for lambda var
  Y := Intern("y");  // for lambda var

  car_lamb := List3(LAMBDA, List1(X), List2(CAR, X));
  Say("car_lamb", car_lamb);
  make_hey := List2(car_lamb, List2(QUOTE, List2(hey, you)));
  Say("make_hey", make_hey);
  hey2 := Eval(make_hey, env);
  Say("hey2", hey2);
  Must(!Nullp(Eq(hey2, hey)), "hey2");

  eq_lamb := List3(LAMBDA, List2(X, Y), List3(EQ, X, Y));
  Say("eq_lamb", eq_lamb);
  eq_10_10 := List3(eq_lamb, Int10, Int{10});
  Say("eq_10_10", eq_10_10);
  eval_eq_10_10 := Eval(eq_10_10, env);
  Say("eval_eq_10_10", eval_eq_10_10);
  Must(!Nullp(eval_eq_10_10), "eval_eq_10_10");

  //PanicOnBad = true;
  add_lamb := List3(LAMBDA, List2(X, Y), List3(ADD, X, Y));
  Say("add_lamb", add_lamb);
  add_10_10 := List3(add_lamb, Int10, Int{10});
  Say("add_10_10", add_10_10);
  eval_add_10_10 := Eval(add_10_10, env);
  Say("eval_add_10_10", eval_add_10_10);
  Must(!Nullp(eval_add_10_10), "eval_add_10_10");
  Must("20" == String(eval_add_10_10), "must str 20")
  Must(20 == OkInt64(IntValue(eval_add_10_10)), "must int64 20")

  var s string
  s = " alpha  beta     gamma     "
  println("s <==== ", s)
  for i, x := range Parse(s) {
    println(" [", i, "] ==> ", String(x))
  }

  s = " alpha  beta  ;comment\n   gamma  ;xxxxx   "
  println("s <==== ", s)
  for i, x := range Parse(s) {
    println(" [", i, "] ==> ", String(x))
  }

  s = " () (alpha)  ( beta     gamma   )  "
  println("s <==== ", s)
  for i, x := range Parse(s) {
    println(" [", i, "] ==> ", String(x))
  }

  s = "(lambda (x y) (cond (eq x (quote x)) (cons x y)))"
  println("s <==== ", s)
  for i, x := range Parse(s) {
    println(" [", i, "] ==> ", String(x))
  }
}
func OkInt64(i int64, ok bool) int64 {
  if !ok {panic("OkInt64 fails")}
  return i
}
func OkString(i string, ok bool) string {
  if !ok {panic("OkString fails")}
  return i
}

func printf(s string, x... interface{}) {
  println(fmt.Sprintf("## " + s, x...))
}
func Say(s string, x Any) {
  println(fmt.Sprintf(":: %s :: %s", s, String(x)))
}
func Zay(s string, x Any) {
  //println(fmt.Sprintf(":: %s :: %s", s, String(x)))
}

func Must(assertion bool, msg string) {
  if assertion {return}
  println("\n****** FAIL: " + msg);
  os.Exit(13);
}

type Any interface {}

type Conser interface {
  Car() Any;
  Cdr() Conser;
  Cons(a Any) Conser;
  Bind(k, v Any) Conser;
  Lookup(k Any) Any;
  ListString() string;
}
func Car(a Any) Any {
  if a, ok := a.(Conser); ok {
    return a.Car()
  }
  return NewBad(fmt.Sprintf("Cannot Car on NonConser <%#s>", a))
}
func Cdr(a Any) Conser {
  if a, ok := a.(Conser); ok {
    return a.Cdr()
  }
  return NewBad(fmt.Sprintf("Cannot Cdr on NonConser <%#s>", a))
}
func Cons(a, b Any) Conser {
  if b, ok := b.(Conser); ok {
    return b.Cons(a)
  }
  return NewBad(fmt.Sprintf("Cannot Cons on NonConser <%#s>", b))
}
func Bind(k, v, env Any) Conser {
  if env, ok := env.(Conser); ok {
    return env.Bind(k, v)
  }
  return NewBad(fmt.Sprintf("Cannot Bind on NonConser <%#s>", env))
}
func Lookup(k, env Any) Any {
  if env, ok := env.(Conser); ok {
    return env.Lookup(k)
  }
  return NewBad(fmt.Sprintf("Cannot Lookup on NonConser <%#s>", env))
}

type Evaler interface {
  Eval(env Conser) Any;
}
func Eval(a Any, env Conser) Any {
  if a, ok := a.(Evaler); ok {
    Zay("Eval Env ===", env);
    Say("Eval Expr <<<", a);
    z := a.Eval(env);
    Say("Eval >>>", z);
    return z;
  }
  return a;  // Default is self-evaling
}

type Applier interface {
  Apply(tail, args Any, env Conser) Any;
}
func Apply(funcobj Any, args Any, env Conser) Any {
  applier := Car(funcobj);
  tail := Cdr(funcobj);
  if applier, ok := applier.(Applier); ok {
    return applier.Apply(tail, args, env)
  }
  return NewBad(fmt.Sprintf("Cannot Apply on NonApplier <%#s>", applier))
}

type SymNamer interface {
  SymName() string;
}
func SymName(a Any) string {
  if a, ok := a.(SymNamer); ok {
    return a.SymName()
  }
  return "";
}

type Stringer interface {
  String() string;
}
func String(a Any) string {
  if a, ok := a.(Stringer); ok {
    return a.String()
  }
  return fmt.Sprintf("<%#s>", a)
}

type Eqer interface {
  Eq(a Any) bool;
}
func Eq(a, b Any) bool {
  if a, ok := a.(Eqer); ok {
    return a.Eq(b)
  }
  /*
  aa := reflect.NewValue(a);
  bb := reflect.NewValue(b);
  if aa.Addr() == bb.Addr() {return T}
  */
  return false;
}

type Nullper interface {
  Nullp() bool;
}
func Nullp(a Any) bool {
  if a, ok := a.(Nullper); ok {
    return a.Nullp()
  }
  return false;  // Default is not null; only NilSym isn't.
}

type Atomper interface {
  Atomp() bool;
}
func Atomp(a Any) bool {
  if a, ok := a.(Atomper); ok {
    return a.Atomp()
  }
  return true;  // Default is Atomic; only Pair isn't.
}

//  Bad: a 'bottom' value for error returns.
//  You can Cons it and print it.
//  TODO:  Test for it & catch it.

type Bad struct {
  msg string;
}
var PanicOnBad = false;
func NewBad(s string) Bad {
  if PanicOnBad {
    panic(s)
  }
  return Bad{s}
}
func NewBadf(f string, args ...interface{}) Bad {
  return NewBad(fmt.Sprintf(f, args...))
}
func (p Bad) Car() Any {
  return NewBad("Cannot Car on a Bad: " + p.msg)
}
func (p Bad) Cdr() Conser {
  return NewBad("Cannot Cdr on a Bad: " + p.msg)
}
func (p Bad) Cons(a Any) Conser {
  return Pair{a, p};
}
func (p Bad) Bind(k, v Any) Conser {
  return NewBad("Cannot Bind on a Bad: " + p.msg);
}
func (p Bad) Lookup(k Any) Any {
  return NewBad("Cannot Lookup on a Bad: " + p.msg);
}
func (p Bad) String() string {
  return fmt.Sprintf("BAD<%s>", p.msg);
}
func (p Bad) ListString() string {
  return p.String();
}

//////  Int.   A value atom holding an int64.

type IntValuer interface {
  IntValue() (int64, bool)
}
func IntValue(a Any) (int64, bool) {
  if a, ok := a.(IntValuer); ok {
    return a.IntValue()
  }
  return 0, false
}

type Int struct {
  x int64;
}
func (p Int) IntValue() (int64, bool) {
  return p.x, true
}
func (p Int) SymName() string {
  return p.String()
}
func (p Int) String() string {
  return fmt.Sprintf("%d", p.x);
}
func (p Int) Eq(a Any) bool {
  if a, ok := a.(Int); ok {
    return p.x == a.x;
  }
  return false;
}

////// Hash
type Hash struct {
  m map[string]Any  // As a hash, for speed.
  unraveled Conser  // Same stuff, linearly.
}
func NewHash(kvs ...Any) Conser {
  var chain Conser = NIL
  m := make(map[string]Any)
  for i := 0; i < len(kvs); i += 2 {
    k := SymName(kvs[i])  
    if len(k) == 0 {panic("empty key")}
    v := kvs[i+1]
    m[k] = v
    chain = chain.Bind(Intern(k), v)
  }
  return &Hash{m, chain}
}

func (p *Hash) ListString() string {
  z := ""
  for k, v := range(p.m) {
    if len(z) > 0 {z += " "}
    z += k + " " + String(v)
  }
  return z
}
func (p *Hash) String() string {
  return "(" + p.ListString() + ")";
}

func (p *Hash) Car() Any {
  return p.unraveled.Car()
}
func (p *Hash) Cdr() Conser {
  return p.unraveled.Cdr()
}
func (p *Hash) Cons(a Any) Conser {
  return Pair{a, p};
}
func (p *Hash) Bind(k, v Any) Conser {
  return Pair{k, Pair{v, p}};
}
func (p *Hash) Lookup(k Any) Any {
  s := SymName(k)
  if len(s) == 0 {panic("No SymName: ")}
  v, ok := p.m[s]
  if !ok {return NIL}
  return v
}

////// Pair
type Pair struct {
  h Any;
  t Conser;
}

func (p Pair) ListString() string {
  a := String(p.h);
  b := p.t.ListString();
  if b == "" {return a;}
  return a + " " + b;
}
func (p Pair) String() string {
  return "(" + p.ListString() + ")";
}

func (p Pair) Car() Any {
  return p.h;
}
func (p Pair) Cdr() Conser {
  return p.t;
}
func (p Pair) Cons(a Any) Conser {
  return Pair{a, p};
}
func (p Pair) Bind(k, v Any) Conser {
  return Pair{k, Pair{v, p}};
}
func (p Pair) Lookup(k Any) Any {
  if Eq(k, p.h) {
    return Car(p.t)
  }
  return Lookup(k, Cdr(p.t))
}
func MapcarEval(list, env Conser) Conser {
  if Nullp(list) {
    return list
  }
  return MapcarEval(Cdr(list), env).Cons(Eval(Car(list), env))
}
func (p Pair) Eval(env Conser) Any {
  // TODO: special forms

  // HACK: QUOTE
  if Eq(QUOTE, p.h) {
    Zay("Pair::Eval special QUOTE", p);
    return Car(p.t);
  }
  if Eq(LAMBDA, p.h) {
    Zay("Pair::Eval special LAMBDA", p);
    return p;
  }

  Zay("Pair::Eval normal cmd...", p.h);
  cmd := Eval(p.h, env);

  Zay("Pair::Eval normal args...", p.t);
  args := MapcarEval(p.t, env);

  Zay("Pair::Eval Apply ", List3(cmd, args, env));
  return Apply(cmd, args, env);
}

//////  Sym

type Sym struct {
  name string;
}

func (p Sym) SymName() string {
  return p.name
}
func (p Sym) String() string {
  return p.name
}
func (p Sym) Eq(a Any) bool {
  /*
  pp := reflect.NewValue(p);
  aa := reflect.NewValue(a);
  println(pp);
  println(aa);
  println(pp.Addr());
  println(aa.Addr());
  println(pp.Type());
  println(aa.Type());
  */
  //if aa.Addr() == bb.Addr() {return true}
  if a, ok := a.(SymNamer); ok {
    println(`/ ` + p.SymName());
    println(`\ ` + a.SymName());
    if p.SymName() == a.SymName() {return true};
  }
  return false
}
func (p Sym) Eval(env Conser) Any {
  return env.Lookup(p);
}

//////  LambdaSym
type LambdaSym struct {
  Sym;
}

func (p LambdaSym) Apply(tail, args Any, env Conser) Any {
  vars := Car(tail);
  body := Car(Cdr(tail));
  for !Nullp(vars) {
    env = env.Bind(Car(vars), Car(args));
    vars = Cdr(vars);
    args = Cdr(args);
  }
  return Eval(body, env);
}
//////  NilSym
type NilSym struct {
  Sym;
}

func (p NilSym) Car() Any {
  return NewBad("Cannot Car on NIL");
}
func (p NilSym) Cdr() Conser {
  return NewBad("Cannot Cdr on NIL");
}
func (p NilSym) Cons(a Any) Conser {
  return Pair{a, p};
}
func (p NilSym) Bind(k, v Any) Conser {
  return Pair{k, Pair{v, p}};
}
func (p NilSym) Lookup(k Any) Any {
  return NewBad("Key not found: " + String(k));
}
func (p NilSym) Nullp() bool {
  return true;
}
func (p NilSym) ListString() string {
  return "";
}

//////  Prim
type Prim struct {
  remark string;
  f func(args Any, env Any) Any;
}

func (p Prim) String() string {
  return fmt.Sprintf("Prim<%s>", p.remark);
}
func (p Prim) Apply(tail, args Any, env Conser) Any {
  Say("Applying Prim: ", List2(p, args));
  return p.f(args, env);
}


func fCar(args Any, env Any) Any {
  a := Car(args);
  if !Nullp(Cdr(args)) {
    return NewBad(fmt.Sprintf(
        "Car needs just 1 arg.  args: %s env: %s",
        String(args), String(env)))
  }
  return Car(a);
}
func fCdr(args Any, env Any) Any {
  a := Car(args);
  if !Nullp(Cdr(args)) {
    return NewBad(fmt.Sprintf(
        "Cdr needs just 1 arg.  args: %s env: %s",
        String(args), String(env)))
  }
  return Cdr(a);
}
func fEq(args Any, env Any) Any {
  if Eq(Car(args), Car(Cdr(args))) {
    return T;
  }
  return NIL;
}

func fAdd(args Any, env Any) Any {
  a := Car(args);
  b := Car(Cdr(args));
  if !Nullp(Cdr(Cdr(args))) {
    return NewBad(fmt.Sprintf(
        "Cdr needs just 2 args.  args: %s env: %s",
        String(args), String(env)))
  }
  ai, ok := IntValue(a)
  if !ok {
    return NewBad(fmt.Sprintf("No IntValue: %#v", a))
  }
  bi, ok := IntValue(b)
  if !ok {
    return NewBad(fmt.Sprintf("No IntValue: %#v", b))
  }
  return Int{ai+bi}
}

func List1(a Any) Conser {
  return NIL.Cons(a)
}
func List2(a, b Any) Conser {
  return NIL.Cons(b).Cons(a)
}
func List3(a, b, c Any) Conser {
  return NIL.Cons(c).Cons(b).Cons(a)
}

var Int10 = Int{10}

//////  Symbol Table

var Symtab = make(map[string]SymNamer);
func Intern(s string) SymNamer {
  sym, ok := Symtab[s];
  if ok {return sym}
  sym = &Sym{s};
  Symtab[s] = sym;
  return sym;
}

//////  Builtins

func Builtins() Conser {
  return NewHash(
    CAR, List1(Prim{"fCar", fCar}),
    CDR, List1(Prim{"fCdr", fCdr}),
    EQ, List1(Prim{"fEq", fEq}),
    ADD, List1(Prim{"fAdd", fAdd}),
    ZERO, Int{0},
    ONE, Int{1},
    TWO, Int{2},
    )
/*
  return (
    Bind(CAR, List1(Prim{"fCar", fCar}),
    Bind(CDR, List1(Prim{"fCdr", fCdr}),
    Bind(EQ, List1(Prim{"fEq", fEq}),
    Bind(ADD, List1(Prim{"fAdd", fAdd}),
    Bind(ZERO, Int{0},
    Bind(ONE, Int{1},
    Bind(TWO, Int{2},
    NIL))))))))
*/
}

//////  Instantiate Builtin Symbols

var NIL = &NilSym{Sym{"nil"}};
var LAMBDA = &LambdaSym{Sym{"lambda"}};
var T, CAR, CDR, CONS, NULLP, ATOMP, EQ, COND Any;
var QUOTE, ZERO, ONE, TWO, BAD Any;
var ADD Any;
func init() {
  //@ Symtab = make(map[string]Any);
  //@ var Symtab = make(map[string]*Sym);

  Symtab["nil"] = NIL;
  Symtab["lambda"] = LAMBDA;
  T = Intern("t");
  CAR = Intern("car");
  CDR = Intern("cdr");
  CONS = Intern("cons");
  NULLP = Intern("nullp");
  ATOMP = Intern("atomp");
  EQ = Intern("eq");
  COND = Intern("cond");
  ADD = Intern("+");
  ZERO = Intern("zero");
  QUOTE = Intern("quote");
  ONE = Intern("one");
  TWO = Intern("two");
  BAD = Intern("bad");
}

func Parse(s string) []Any {
  p := &Parser{s:s, pos:0}
  z := make([]Any, 0)
  for {
    a, ok := p.Parse()
    if !ok { p.Panic() }
    if a == nil { break }
    z = append(z, a)
  }
  return z
}

type Parser struct {
  s string
  pos int
}

func (p *Parser) Panic() {
  panic(fmt.Sprintf("bad parse at %d, rest is %s", p.pos, p.s[p.pos:]))
}
func (p *Parser) Eof() bool {
  return p.pos == len(p.s)
}
func (p *Parser) SkipWhite() {
  for true { 
    if p.Eof() {return}
    switch c := p.s[p.pos]; c {
      case ' ', '\t', '\n', '\r', '\v', '\f':
        p.pos++
      default:
        return
    }
  }
}
    

func (p *Parser) Parse () (Any, bool) {
  //println("Enter Parser::Parse:  pos=", p.pos, " << ",  p.s[:p.pos], "<|>", p.s[p.pos:], " >> ")
  p.SkipWhite()
  //println("skiped white       :  pos=", p.pos, " << ",  p.s[:p.pos], "<|>", p.s[p.pos:], " >> ")
  if p.Eof() { return nil, true }
  
  switch c := p.s[p.pos]; c {
    case ';':
      for {
        p.pos++
	if p.pos == len(p.s) { break }
        c := p.s[p.pos];
	if c == '\n' { break }
      }
      return p.Parse()
    case '(':
      p.pos++
      p.SkipWhite()
      var list Conser = NIL
      for true {
        tmp, ok := p.Parse()
	if !ok {p.Panic()}

	if tmp==nil { break }
	list = list.Cons(tmp)
      }
      return Reverse(list), true;   //// REVERSE!

    case ')':
      p.pos++
      return nil, true

    default:
      symName := make([]byte, 0)
      symName: for ; p.pos<len(p.s) ; p.pos++ {
        switch c := p.s[p.pos]; c {
          case ' ', '\t', '\n', '\r', '\v', '\f':
	    break symName
          case '(', ')':
	    break symName
	  default:
	    symName = append(symName, c)
	}
      }
      return Intern(string(symName)), true
  }
  p.Panic()  // notreached
  return nil, true;  // notreached
}
	  
func Reverse(a Conser) Conser {
  var z Conser = NIL
  for ; !Nullp(a); a = a.Cdr() {
    z = z.Cons(a.Car())
  }
  return z
}