// Nukata Lisp Light 1.2 in Go 1.4 by SUZUKI Hisao (H27.5/11)

/*
これは Dart による 1.2 版インタープリタと同じ仕様の Lisp インタープリタである。
ただし Go 言語で簡易に実装するため,扱う数を int による十進数に限る点で異なる。
cf. http://www.oki-osk.jp/esc/dart/lisp.html

取り扱いを簡単にするため Go 言語としては非標準的だが単一ファイルで構成した。
単に go build lisp-light.go とするだけでコンパイルできる。

データ構造に対する排他制御はしていない。もし goroutine による Lisp の並行化を
行うときは symbols と Interp の globals を sync.RWMutex で保護するとよい。
*/
package main

import (
    "bufio"
    "errors"
    "fmt"
    "io"
    "os"
    "regexp"
    "strconv"
    "strings"
    "unicode/utf8"
)

// Cons セル.
// Cons 演算は &Cell{car, cdr} で行う。
type Cell struct {
    Car interface{}
    Cdr interface{}
}

// *Cell 型の nil で空リストを表現する。
var Nil *Cell = nil

// デバッグの便宜のための cons セルの文字列表現
func (cell *Cell) String() string {
    return fmt.Sprintf("(%v . %v)", cell.Car, cell.Cdr)
}

// リストとしての長さ
func (j *Cell) Len() int {
    return j.FoldL(0, func(i, e interface{}) interface{} {
        return i.(int) + 1
    }).(int)
}

// (a b c).FoldL(x, fn) => fn(fn(fn(x, a), b), c)
func (j *Cell) FoldL(x interface{},
    fn func(interface{}, interface{}) interface{}) interface{} {
    for j != Nil {
        x = fn(x, j.Car)
        j = j.Cdr.(*Cell)
    }
    return x
}

// MapCar((a b c), fn) => (fn(a) fn(b) fn(c))
func (j *Cell) MapCar(fn func(interface{}) interface{}) interface{} {
    if j == Nil {
        return Nil
    }
    a := fn(j.Car)
    d := j.Cdr
    if cdr, ok := d.(*Cell); ok {
        d = cdr.MapCar(fn)
    }
    if j.Car == a && j.Cdr == d {
        return j
    }
    return &Cell{a, d}
}

//----------------------------------------------------------------------

// Lisp のシンボル (および式キーワード).
// 未 intern のシンボルを作るには &Sym{name, false} とする。
type Sym struct {
    Name      string
    IsKeyword bool
}

// シンボルの文字列表現
func (sym *Sym) String() string {
    return sym.Name
}

// intern されたシンボルの表
var symbols = make(map[string]*Sym)

// 文字列からシンボルを (最初の構築で第2引数が真ならば式キーワードを) 作る。
func NewSym2(name string, isKeyword bool) *Sym {
    sym, ok := symbols[name]
    if !ok {
        sym = &Sym{name, isKeyword}
        symbols[name] = sym
    }
    return sym
}

// 文字列からシンボルを作る。
func NewSym(name string) *Sym {
    return NewSym2(name, false)
}

// intern されたシンボルかどうか?
func (sym *Sym) IsInterned() bool {
    _, ok := symbols[sym.Name]
    return ok
}

// 定義済みのシンボル

var BackQuoteSym = NewSym("`")
var CommaAtSym = NewSym(",@")
var CommaSym = NewSym(",")
var DotSym = NewSym(".")
var LeftParenSym = NewSym("(")
var RightParenSym = NewSym(")")
var SingleQuoteSym = NewSym("'")

var AppendSym = NewSym("append")
var ConsSym = NewSym("cons")
var ListSym = NewSym("list")
var RestSym = NewSym("&rest")
var UnquoteSym = NewSym("unquote")
var UnquoteSplicingSym = NewSym("unquote-splicing")

// キーワード

var CondSym = NewSym2("cond", true)
var LambdaSym = NewSym2("lambda", true)
var MacroSym = NewSym2("macro", true)
var ProgNSym = NewSym2("progn", true)
var QuasiquoteSym = NewSym2("quasiquote", true)
var QuoteSym = NewSym2("quote", true)
var SetqSym = NewSym2("setq", true)

//----------------------------------------------------------------------

// Lisp 関数の共通要素
type Func struct {
    // 引数の個数 (rest 引数があれば符号を反転する)
    Carity int
}

// rest 引数をもつかどうか?
func (fn *Func) hasRest() bool {
    return fn.Carity < 0
}

// 固定引数の個数
func (fn *Func) fixedArgs() int {
    if c := fn.Carity; c < 0 {
        return -c - 1
    } else {
        return c
    }
}

// 実引数の並びからローカル変数のフレームを作る。
func (fn *Func) MakeFrame(arg *Cell) []interface{} {
    arity := fn.Carity // rest 引数全体を 1 と数えた引数の個数
    if arity < 0 {
        arity = -arity
    }
    frame := make([]interface{}, arity)
    n := fn.fixedArgs()
    i := 0
    for i < n && arg != Nil { // 固定引数並びを設定する。
        frame[i] = arg.Car
        arg = CdrCell(arg)
        i++
    }
    if i != n || (arg != Nil && !fn.hasRest()) {
        panic(NewEvalError("arity not matched", fn))
    }
    if fn.hasRest() {
        frame[n] = arg
    }
    return frame
}

// フレームの各式を評価する。
func (fn *Func) EvalFrame(frame []interface{}, interp *Interp, env *Cell) {
    n := fn.fixedArgs()
    for i := 0; i < n; i++ {
        frame[i] = interp.Eval(frame[i], env)
    }
    if fn.hasRest() {
        if j, ok := frame[n].(*Cell); ok {
            z := Nil
            y := Nil
            for j != Nil {
                e := interp.Eval(j.Car, env)
                x := &Cell{e, Nil}
                if z == Nil {
                    z = x
                } else {
                    y.Cdr = x
                }
                y = x
                j = CdrCell(j)
            }
            frame[n] = z
        }
    }
}

//----------------------------------------------------------------------

// コンパイル後のマクロ式
type Macro struct {
    Func
    // 関数本体となるリスト
    body *Cell
}

func NewMacro(carity int, body *Cell, env *Cell) interface{} {
    return &Macro{Func{carity}, body}
}

func (x *Macro) String() string {
    return fmt.Sprintf("#<macro:%d:%s>", x.Carity, Str(x.body))
}

// 実引数の並びでマクロを展開する。
func (x *Macro) ExpandWith(interp *Interp, arg *Cell) interface{} {
    frame := x.MakeFrame(arg)
    env := &Cell{frame, Nil}
    var y interface{} = Nil
    for j := x.body; j != Nil; j = CdrCell(j) {
        y = interp.Eval(j.Car, env)
    }
    return y
}

// コンパイル後のラムダ式 (ただし入れ子の内側)
type Lambda struct {
    Func
    // 関数本体となるリスト
    Body *Cell
}

func NewLambda(carity int, body *Cell, env *Cell) interface{} {
    return &Lambda{Func{carity}, body}
}

func (x *Lambda) String() string {
    return fmt.Sprintf("#<lambda:%d:%s>", x.Carity, Str(x.Body))
}

// コンパイル後のラムダ式 (環境を伴ったクロージャ)
type Closure struct {
    Lambda
    // クロージャの環境
    Env *Cell
}

func NewClosure(carity int, body *Cell, env *Cell) interface{} {
    return &Closure{Lambda{Func{carity}, body}, env}
}

func (x *Closure) String() string {
    return fmt.Sprintf("#<closure:%d:%s:%s>",
        x.Carity, Str(x.Env), Str(x.Body))
}

// ラムダ式の本体を評価するための環境を実引数の並びから作る。
func (x *Closure) MakeEnv(interp *Interp, arg *Cell, interpEnv *Cell) *Cell {
    frame := x.MakeFrame(arg)
    x.EvalFrame(frame, interp, interpEnv)
    return &Cell{frame, x.Env} // クロージャの環境に追加する。
}

//----------------------------------------------------------------------

// 組み込み関数
type BuiltInFunc struct {
    Func
    name string
    body func([]interface{}) interface{}
}

func NewBuiltInFunc(name string, carity int,
    body func([]interface{}) interface{}) *BuiltInFunc {
    return &BuiltInFunc{Func{carity}, name, body}
}

func (x *BuiltInFunc) String() string {
    return fmt.Sprintf("#<%s:%d>", x.name, x.Carity)
}

// 実引数の並びで組み込み関数を呼び出す。
func (x *BuiltInFunc) EvalWith(interp *Interp, arg *Cell,
    interpEnv *Cell) interface{} {
    frame := x.MakeFrame(arg)
    x.EvalFrame(frame, interp, interpEnv)
    defer func() {
        if err := recover(); err != nil {
            if _, ok := err.(*EvalError); ok {
                panic(err)
            } else {
                msg := fmt.Sprintf("%v -- %s", err, x.name)
                panic(NewEvalError(msg, frame))
            }
        }
    }()
    return x.body(frame)
}

//----------------------------------------------------------------------

// コンパイル後のラムダ式やマクロ式の束縛変数.
// &Arg{level, offset, symbol} で構築する。
type Arg struct {
    // 静的スコープの入れ子レベル (最内が 0)
    Level int
    // 当該レベルのフレームでの当該変数の位置 (先頭が 0)
    Offset int
    // コンパイル前の変数を表すシンボル
    Symbol *Sym
}

func (x *Arg) String() string {
    return fmt.Sprintf("#%d:%d:%v", x.Level, x.Offset, x.Symbol)
}

// 環境の中の変数の該当箇所に値をセットする。
func (x *Arg) SetValue(y interface{}, env *Cell) {
    for i := 0; i < x.Level; i++ {
        env = env.Cdr.(*Cell)
    }
    (env.Car.([]interface{}))[x.Offset] = y
}

// 環境の中の変数の該当箇所から値を得る。
func (x *Arg) GetValue(env *Cell) interface{} {
    for i := 0; i < x.Level; i++ {
        env = env.Cdr.(*Cell)
    }
    return (env.Car.([]interface{}))[x.Offset]
}

//----------------------------------------------------------------------

// 評価エラー
type EvalError struct {
    Message string
    Trace   []string
}

func NewEvalError(msg string, x interface{}) *EvalError {
    return &EvalError{msg + ": " + Str(x), nil}
}

// 変数が出現すべき箇所に変数がないことを表すエラーを作る。
func NewNotVariableError(x interface{}) *EvalError {
    return NewEvalError("variable expected", x)
}

// error 型としてのメソッド
func (err *EvalError) Error() string {
    s := "EvalError: " + err.Message
    for _, line := range err.Trace {
        s += "\n\t" + line
    }
    return s
}

// ファイル終端エラー
var EOFError error = errors.New("end of file")

//----------------------------------------------------------------------

// インタープリタ本体
type Interp struct {
    globals map[*Sym]interface{}
}

// シンボルの大域的な値を取得する。
func (interp *Interp) GetGlobalVar(sym *Sym) (interface{}, bool) {
    val, ok := interp.globals[sym]
    return val, ok
}

// シンボルの大域的な値をセットする。
func (interp *Interp) SetGlobalVar(sym *Sym, val interface{}) {
    interp.globals[sym] = val
}

// Lisp インタープリタを作り,
// 組み込み関数等をシンボルの大域的な値としてセットする。
func NewInterp() *Interp {
    interp := &Interp{globals: make(map[*Sym]interface{})}

    interp.Def("car", 1, func(a []interface{}) interface{} {
        if a[0] == Nil {
            return Nil
        }
        return a[0].(*Cell).Car
    })

    interp.Def("cdr", 1, func(a []interface{}) interface{} {
        if a[0] == Nil {
            return Nil
        }
        return a[0].(*Cell).Cdr
    })

    interp.Def("cons", 2, func(a []interface{}) interface{} {
        return &Cell{a[0], a[1]}
    })

    interp.Def("atom", 1, func(a []interface{}) interface{} {
        if j, ok := a[0].(*Cell); ok && j != Nil {
            return Nil
        }
        return true
    })

    interp.Def("eq", 2, func(a []interface{}) interface{} {
        if a[0] == a[1] { // *Cell 値はポインタで比較される。
            return true
        }
        return Nil
    })

    interp.Def("list", -1, func(a []interface{}) interface{} {
        return a[0]
    })

    interp.Def("rplaca", 2, func(a []interface{}) interface{} {
        a[0].(*Cell).Car = a[1]
        return a[1]
    })

    interp.Def("rplacd", 2, func(a []interface{}) interface{} {
        a[0].(*Cell).Cdr = a[1]
        return a[1]
    })

    interp.Def("length", 1, func(a []interface{}) interface{} {
        switch x := a[0].(type) {
        case *Cell:
            return x.Len()
        case string: // 各マルチバイト文字を 1 と数える。
            return utf8.RuneCountInString(x)
        default:
            panic(NewEvalError("list or string expected", x))
        }
    })

    interp.Def("stringp", 1, func(a []interface{}) interface{} {
        if _, ok := a[0].(string); ok {
            return true
        }
        return Nil
    })

    interp.Def("numberp", 1, func(a []interface{}) interface{} {
        if _, ok := a[0].(int); ok {
            return true
        }
        return Nil
    })

    interp.Def("eql", 2, func(a []interface{}) interface{} {
        if a[0] == a[1] { // 数は値で比較される。"eq" も見よ。
            return true
        }
        return Nil
    })

    interp.Def("<", 2, func(a []interface{}) interface{} {
        if a[0].(int) < a[1].(int) {
            return true
        }
        return Nil
    })

    interp.Def("%", 2, func(a []interface{}) interface{} {
        return a[0].(int) % a[1].(int)
    })

    interp.Def("mod", 2, func(a []interface{}) interface{} {
        i := a[0].(int)
        j := a[1].(int)
        r := i % j // cf. http://golang.org/ref/spec#Arithmetic_operators
        if (i < 0 && j > 0) || (i > 0 && j < 0) {
            r += j
        }
        return r
    })

    interp.Def("+", -1, func(a []interface{}) interface{} {
        return a[0].(*Cell).FoldL(0,
            func(i, j interface{}) interface{} {
                return i.(int) + j.(int)
            })
    })

    interp.Def("*", -1, func(a []interface{}) interface{} {
        return a[0].(*Cell).FoldL(1,
            func(i, j interface{}) interface{} {
                return i.(int) * j.(int)
            })
    })

    interp.Def("-", -2, func(a []interface{}) interface{} {
        if a[1] == Nil {
            return -a[0].(int)
        } else {
            return a[1].(*Cell).FoldL(a[0].(int),
                func(i, j interface{}) interface{} {
                    return i.(int) - j.(int)
                })
        }
    })

    // 実数除算を整数除算で代用する。
    interp.Def("/", -3, func(a []interface{}) interface{} {
        return a[2].(*Cell).FoldL(a[0].(int)/a[1].(int),
            func(i, j interface{}) interface{} {
                return i.(int) / j.(int)
            })
    })

    interp.Def("truncate", -2, func(a []interface{}) interface{} {
        x := a[0].(int)
        y := a[1].(*Cell)
        if y == Nil {
            return x
        } else if y.Cdr == Nil {
            return x / y.Car.(int)
        } else {
            panic("one or two arguments expected")
        }
    })

    interp.Def("prin1", 1, func(a []interface{}) interface{} {
        fmt.Print(Str2(a[0], true))
        return a[0]
    })

    interp.Def("princ", 1, func(a []interface{}) interface{} {
        fmt.Print(Str2(a[0], false))
        return a[0]
    })

    interp.Def("terpri", 0, func(a []interface{}) interface{} {
        fmt.Println()
        return true
    })

    gensymCounterSym := NewSym("*gensym-counter*")
    interp.SetGlobalVar(gensymCounterSym, 1)
    interp.Def("gensym", 0, func(a []interface{}) interface{} {
        i := interp.globals[gensymCounterSym].(int)
        interp.globals[gensymCounterSym] = i + 1
        return &Sym{fmt.Sprintf("G%d", i), false}
    })

    interp.Def("make-symbol", 1, func(a []interface{}) interface{} {
        return &Sym{a[0].(string), false}
    })

    interp.Def("intern", 1, func(a []interface{}) interface{} {
        return NewSym(a[0].(string))
    })

    interp.Def("symbol-name", 1, func(a []interface{}) interface{} {
        return a[0].(*Sym).Name
    })

    interp.Def("apply", 2, func(a []interface{}) interface{} {
        args := a[1].(*Cell).MapCar(QqQuote)
        return interp.Eval(&Cell{a[0], args}, Nil)
    })

    interp.Def("exit", 1, func(a []interface{}) interface{} {
        os.Exit(int(a[0].(int)))
        return Nil // *not reached*
    })

    interp.Def("dump", 0, func(a []interface{}) interface{} {
        r := Nil
        for key := range interp.globals {
            r = &Cell{key, r}
        }
        return r
    })

    interp.SetGlobalVar(NewSym("*version*"),
        &Cell{1.2, &Cell{"Go", &Cell{"Nukata Lisp Light", Nil}}})

    return interp
}

// 名前と引数個数と関数本体を与えて組み込み関数を定義する。
func (interp *Interp) Def(name string, carity int,
    body func([]interface{}) interface{}) {
    sym := NewSym(name)
    fnc := NewBuiltInFunc(name, carity, body)
    interp.SetGlobalVar(sym, fnc)
}

// Lisp 式を環境のもとで評価する。
func (interp *Interp) Eval(expression interface{}, env *Cell) interface{} {
    defer func() {
        if err := recover(); err != nil {
            if ex, ok := err.(*EvalError); ok {
                if ex.Trace == nil {
                    ex.Trace = make([]string, 0, 10)
                }
                if len(ex.Trace) < 10 {
                    ex.Trace = append(ex.Trace, Str(expression))
                }
            }
            panic(err)
        }
    }()
    for {
        switch x := expression.(type) {
        case *Arg:
            return x.GetValue(env)
        case *Sym:
            r, ok := interp.GetGlobalVar(x)
            if ok {
                return r
            }
            panic(NewEvalError("void variable", x))
        case *Cell:
            if x == Nil {
                return x // 空リスト
            }
            fn := x.Car
            arg := CdrCell(x)
            sym, ok := fn.(*Sym)
            if ok && sym.IsKeyword {
                switch sym {
                case QuoteSym:
                    if arg != Nil && arg.Cdr == Nil {
                        return arg.Car
                    }
                    panic(NewEvalError("bad quote", x))
                case ProgNSym:
                    expression = interp.evalProgN(arg, env)
                case CondSym:
                    expression = interp.evalCond(arg, env)
                case SetqSym:
                    return interp.evalSetQ(arg, env)
                case LambdaSym:
                    return interp.compile(arg, env, NewClosure)
                case MacroSym:
                    if env != Nil {
                        panic(NewEvalError("nested macro", x))
                    }
                    return interp.compile(arg, Nil, NewMacro)
                case QuasiquoteSym:
                    if arg != Nil && arg.Cdr == Nil {
                        expression = QqExpand(arg.Car)
                    } else {
                        panic(NewEvalError("bad quasiquote", x))
                    }
                default:
                    panic(NewEvalError("bad keyword", fn))
                }
            } else { // 関数の適用
                // 高速化のため fn = interp.Eval(fn, env) を Sym に対して開く。
                if ok {
                    fn, ok = interp.GetGlobalVar(sym)
                    if !ok {
                        panic(NewEvalError("undefined", x.Car))
                    }
                } else {
                    fn = interp.Eval(fn, env)
                }
                switch f := fn.(type) {
                case *Closure:
                    env = f.MakeEnv(interp, arg, env)
                    expression = interp.evalProgN(f.Body, env)
                case *Macro:
                    expression = f.ExpandWith(interp, arg)
                case *BuiltInFunc:
                    return f.EvalWith(interp, arg, env)
                default:
                    panic(NewEvalError("not applicable", fn))
                }
            }
        case *Lambda:
            return &Closure{*x, env}
        default:
            return x // 数や文字列など
        }
    }
}

// (progn E1 E2.. En) => E1, E2, .. を評価し末尾の En をそのまま返す。
func (interp *Interp) evalProgN(j *Cell, env *Cell) interface{} {
    if j == Nil {
        return Nil
    }
    for {
        x := j.Car
        j = CdrCell(j)
        if j == Nil {
            return x // 末尾式は戻った先で評価する。
        }
        interp.Eval(x, env)
    }
}

// 条件式 (cond (C1 E1...) (C2 E2...) ...) を評価して末尾式をそのまま返す。
func (interp *Interp) evalCond(j *Cell, env *Cell) interface{} {
    for j != Nil {
        clause, ok := j.Car.(*Cell)
        if ok {
            if clause != Nil {
                result := interp.Eval(clause.Car, env)
                if result != Nil { // テスト結果が真ならば
                    body := CdrCell(clause)
                    if body == Nil {
                        return QqQuote(result)
                    } else {
                        return interp.evalProgN(body, env)
                    }
                }
            }
        } else {
            panic(NewEvalError("cond test expected", j.Car))
        }
        j = CdrCell(j)
    }
    return Nil // 成立する節がなかった。
}

// (setq V1 E1 ...) => Ei を評価して Vi に代入する。末尾の式の値を返す。
func (interp *Interp) evalSetQ(j *Cell, env *Cell) interface{} {
    var result interface{} = Nil
    for j != Nil {
        lval := j.Car
        j = CdrCell(j)
        if j == Nil {
            panic(NewEvalError("right value expected", lval))
        }
        result = interp.Eval(j.Car, env)
        switch v := lval.(type) {
        case *Arg:
            v.SetValue(result, env)
        case *Sym:
            if v.IsKeyword {
                panic(NewNotVariableError(lval))
            }
            interp.SetGlobalVar(v, result)
        default:
            panic(NewNotVariableError(lval))
        }
        j = CdrCell(j)
    }
    return result
}

// Lisp のリスト (macro ...) または (lambda ...) をコンパイルする。
func (interp *Interp) compile(arg *Cell, env *Cell,
    factory func(int, *Cell, *Cell) interface{}) interface{} {
    if arg == Nil {
        panic(NewEvalError("arglist and body expected", arg))
    }
    table := make(map[*Sym]*Arg)
    hasRest := makeArgTable(arg.Car, table)
    arity := len(table)
    body := CdrCell(arg)
    body = scanForArgs(body, table).(*Cell)
    body = interp.expandMacros(body, 20).(*Cell) // 20 はマクロ展開する深さ
    body = interp.compileInners(body).(*Cell)
    if hasRest {
        arity = -arity
    }
    return factory(arity, body, env)
}

// 式の中のマクロと準引用式を展開する。
func (interp *Interp) expandMacros(x interface{}, count int) interface{} {
    if count > 0 {
        if j, ok := x.(*Cell); ok {
            if j == Nil {
                return Nil
            }
            switch k := j.Car; k {
            case QuoteSym, LambdaSym, MacroSym:
                return j
            case QuasiquoteSym:
                d := CdrCell(j)
                if d != Nil && d.Cdr == Nil {
                    z := QqExpand(d.Car)
                    return interp.expandMacros(z, count)
                }
                panic(NewEvalError("bad quasiquote", j))
            default:
                if sym, ok := k.(*Sym); ok {
                    if v, ok := interp.GetGlobalVar(sym); ok {
                        k = v
                    }
                }
                if f, ok := k.(*Macro); ok {
                    d := CdrCell(j)
                    z := f.ExpandWith(interp, d)
                    return interp.expandMacros(z, count-1)
                } else {
                    return j.MapCar(func(y interface{}) interface{} {
                        return interp.expandMacros(y, count)
                    })
                }
            }
        }
    }
    return x
}

// 入れ子のラムダ式を Lambda インスタンスに置き換える。
func (interp *Interp) compileInners(x interface{}) interface{} {
    if j, ok := x.(*Cell); ok {
        if j == Nil {
            return Nil
        }
        switch k := j.Car; k {
        case QuoteSym:
            return j
        case LambdaSym:
            d := CdrCell(j)
            return interp.compile(d, Nil, NewLambda)
        case MacroSym:
            panic(NewEvalError("nested macro", j))
        default:
            return j.MapCar(func(y interface{}) interface{} {
                return interp.compileInners(y)
            })
        }
    }
    return x
}

//----------------------------------------------------------------------

// 仮引数の表を作る。rest 引数があれば true を返す。
func makeArgTable(x interface{}, table map[*Sym]*Arg) bool {
    arg, ok := x.(*Cell)
    if !ok {
        panic(NewEvalError("arglist expected", x))
    }
    if arg == Nil {
        return false
    } else {
        offset := 0 // 仮引数に割り当てるフレーム内オフセット値
        hasRest := false
        for arg != Nil {
            j := arg.Car
            if hasRest {
                panic(NewEvalError("2nd rest", j))
            }
            if j == RestSym { // &rest var
                arg = CdrCell(arg)
                if arg == Nil {
                    panic(NewNotVariableError(arg))
                }
                j = arg.Car
                if j == RestSym {
                    panic(NewNotVariableError(j))
                }
                hasRest = true
            }
            var sym *Sym
            switch v := j.(type) {
            case *Sym:
                sym = v
            case *Arg:
                sym = v.Symbol
            default:
                panic(NewNotVariableError(j))
            }
            table[sym] = &Arg{0, offset, sym}
            offset++
            arg = CdrCell(arg)
        }
        return hasRest
    }
}

// table にある仮引数を式から探して Arg に換える。
// table にない自由な Arg を式から探してそのレベルを上げる。
func scanForArgs(x interface{}, table map[*Sym]*Arg) interface{} {
    switch j := x.(type) {
    case *Sym:
        if a, ok := table[j]; ok {
            return a
        }
        return j
    case *Arg:
        if a, ok := table[j.Symbol]; ok {
            return a
        }
        return &Arg{j.Level + 1, j.Offset, j.Symbol}
    case *Cell:
        if j == Nil {
            return Nil
        }
        switch j.Car {
        case QuoteSym:
            return j
        case QuasiquoteSym:
            return &Cell{QuasiquoteSym, scanForQQ(j.Cdr, table, 0)}
        default:
            return j.MapCar(func(y interface{}) interface{} {
                return scanForArgs(y, table)
            })
        }
    default:
        return j
    }
}

// 準引用式を式から探し,その入れ子レベルにより _scanForArgs を行う。
func scanForQQ(x interface{}, table map[*Sym]*Arg,
    level int) interface{} {
    j, ok := x.(*Cell)
    if ok {
        if j == Nil {
            return Nil
        }
        switch k := j.Car; k {
        case QuasiquoteSym:
            return &Cell{k, scanForQQ(j.Cdr, table, level+1)}
        case UnquoteSym, UnquoteSplicingSym:
            var d interface{}
            if level == 0 {
                d = scanForArgs(j.Cdr, table)
            } else {
                d = scanForQQ(j.Cdr, table, level-1)
            }
            if d == j.Cdr {
                return j
            }
            return &Cell{k, d}
        default:
            return j.MapCar(func(y interface{}) interface{} {
                return scanForQQ(y, table, level)
            })
        }
    } else {
        return x
    }
}

// リスト x の cdr を *Cell または Nil として得る。
func CdrCell(x *Cell) *Cell {
    if j, ok := x.Cdr.(*Cell); ok {
        return j
    }
    panic(NewEvalError("proper list expected", x))
}

//----------------------------------------------------------------------
// 準引用 (Quasi-Quotation)

// 任意の準引用式 `x の x を等価な S 式に展開する。
func QqExpand(x interface{}) interface{} {
    return qqExpand0(x, 0) // 入れ子レベル 0 で始める。
}

// 評価すると引数自身になるようにクォートする。
func QqQuote(x interface{}) interface{} {
    if x == Nil {
        return Nil
    }
    switch x.(type) {
    case *Sym, *Cell:
        return &Cell{QuoteSym, &Cell{x, Nil}}
    default:
        return x
    }
}

func qqExpand0(x interface{}, level int) interface{} {
    if j, ok := x.(*Cell); ok {
        if j == Nil {
            return Nil
        }
        if j.Car == UnquoteSym { // ,a
            if level == 0 {
                return j.Cdr.(*Cell).Car // ,a => a
            }
        }
        t := qqExpand1(j, level)
        if t.Cdr == Nil {
            if k, ok := t.Car.(*Cell); ok {
                if k.Car == ListSym || k.Car == ConsSym {
                    return k
                }
            }
        }
        return &Cell{AppendSym, t}
    } else {
        return QqQuote(x)
    }
}

// `x の x を append の引数として使えるように展開する。
// 例 1: (,a b) => h=(list a) t=((list 'b)) => ((list a 'b))
// 例 2: (,a ,@(cons 2 3)) => h=(list a) t=((cons 2 3))
//                         => ((cons a (cons 2 3)))
func qqExpand1(x interface{}, level int) *Cell {
    if j, ok := x.(*Cell); ok {
        if j == Nil {
            return &Cell{Nil, Nil}
        }
        switch j.Car {
        case UnquoteSym: // ,a
            if level == 0 {
                return j.Cdr.(*Cell) // ,a => (a)
            }
            level--
        case QuasiquoteSym: // `a
            level++
        }
        h := qqExpand2(j.Car, level)
        t := qqExpand1(j.Cdr, level) // != Nil
        if t.Car == Nil && t.Cdr == Nil {
            return &Cell{h, Nil}
        } else if hc, ok := h.(*Cell); ok {
            if hc.Car == ListSym {
                if tcar, ok := t.Car.(*Cell); ok {
                    if tcar.Car == ListSym {
                        hh := qqConcat(hc, tcar.Cdr)
                        return &Cell{hh, t.Cdr}
                    }
                }
                if hcdr, ok := hc.Cdr.(*Cell); ok {
                    hh := qqConsCons(hcdr, t.Car)
                    return &Cell{hh, t.Cdr}
                }
            }
        }
        return &Cell{h, t}
    } else {
        return &Cell{QqQuote(x), Nil}
    }
}

// (1 2), (3 4) => (1 2 3 4)
func qqConcat(x *Cell, y interface{}) interface{} {
    if x == Nil {
        return y
    } else {
        return &Cell{x.Car, qqConcat(x.Cdr.(*Cell), y)}
    }
}

// (1 2 3), "a" => (cons 1 (cons 2 (cons 3 "a")))
func qqConsCons(x *Cell, y interface{}) interface{} {
    if x == Nil {
        return y
    } else {
        return &Cell{ConsSym, &Cell{x.Car,
            &Cell{qqConsCons(x.Cdr.(*Cell), y), Nil}}}
    }
}

// `x の x.car (= y) を append の1引数として使えるように展開する。
// 例: ,a => (list a); ,@(foo 1 2) => (foo 1 2); b => (list 'b)
func qqExpand2(y interface{}, level int) interface{} {
    if j, ok := y.(*Cell); ok {
        if j == Nil {
            return &Cell{ListSym, &Cell{Nil, Nil}} // (list nil)
        }
        switch j.Car {
        case UnquoteSym: // ,a
            if level == 0 {
                return &Cell{ListSym, j.Cdr} // ,a => (list a)
            }
            level--
        case UnquoteSplicingSym: // ,@a
            if level == 0 {
                return j.Cdr.(*Cell).Car // ,@a => a
            }
            level--
        case QuasiquoteSym: // `a
            level++
        }
    }
    return &Cell{ListSym, &Cell{qqExpand0(y, level), Nil}}
}

//----------------------------------------------------------------------

// Lisp 式の読み取り器
type Reader struct {
    scanner *bufio.Scanner
    token   interface{}
    tokens  []string
    index   int
    line    string
    lineNo  int
    erred   bool
}

// 与えられた引数から次々と Lisp 式を読み取る Reader を構築する。
func NewReader(r io.Reader) *Reader {
    scanner := bufio.NewScanner(r)
    return &Reader{scanner, nil, nil, 0, "", 0, false}
}

// 1個の Lisp 式を読む。入力が尽きたら EOFError で panic する。
func (rr *Reader) Read() interface{} {
    rr.readToken()
    return rr.parseExpression()
}

func (rr *Reader) newSynatxError(msg string, arg interface{}) *EvalError {
    rr.erred = true
    s := fmt.Sprintf("syntax error: %s -- %d: %s",
        fmt.Sprintf(msg, arg), rr.lineNo, rr.line)
    return &EvalError{s, nil}
}

func (rr *Reader) parseExpression() interface{} {
    switch rr.token {
    case LeftParenSym: // (a b c)
        rr.readToken()
        return rr.parseListBody()
    case SingleQuoteSym: // 'a => (quote a)
        rr.readToken()
        return &Cell{QuoteSym, &Cell{rr.parseExpression(), Nil}}
    case BackQuoteSym: // `a => (quasiquote a)
        rr.readToken()
        return &Cell{QuasiquoteSym, &Cell{rr.parseExpression(), Nil}}
    case CommaSym: // ,a => (unquote a)
        rr.readToken()
        return &Cell{UnquoteSym, &Cell{rr.parseExpression(), Nil}}
    case CommaAtSym: // ,@a => (unquote-splicing a)
        rr.readToken()
        return &Cell{UnquoteSplicingSym, &Cell{rr.parseExpression(), Nil}}
    case DotSym, RightParenSym:
        panic(rr.newSynatxError("unexpected \"%v\"", rr.token))
    default:
        return rr.token
    }
}

func (rr *Reader) parseListBody() *Cell {
    if rr.token == RightParenSym {
        return Nil
    } else {
        e1 := rr.parseExpression()
        rr.readToken()
        var e2 interface{}
        if rr.token == DotSym { // (a . b)
            rr.readToken()
            e2 = rr.parseExpression()
            rr.readToken()
            if rr.token != RightParenSym {
                panic(rr.newSynatxError("\")\" expected: %v", rr.token))
            }
        } else {
            e2 = rr.parseListBody()
        }
        return &Cell{e1, e2}
    }
}

// 次のトークンを読み取って rr.token にセットする。
func (rr *Reader) readToken() {
    // 行が尽きたか前回がエラーならば次の行を読み取る。
    for len(rr.tokens) <= rr.index || rr.erred {
        rr.erred = false
        if rr.scanner.Scan() {
            rr.line = rr.scanner.Text()
            rr.lineNo++
        } else {
            if err := rr.scanner.Err(); err != nil {
                panic(err)
            }
            panic(EOFError)
        }
        mm := tokenPat.FindAllStringSubmatch(rr.line, -1)
        tt := make([]string, 0, len(mm)*3/5) // 四割は空白等と見込む。
        for _, m := range mm {
            if m[1] != "" {
                tt = append(tt, m[1])
            }
        }
        rr.tokens = tt
        rr.index = 0
    }
    // 次のトークンを読み取る。
    s := rr.tokens[rr.index]
    rr.index++
    if s[0] == '"' {
        n := len(s) - 1
        if n < 1 || s[n] != '"' {
            panic(rr.newSynatxError("bad string: '%s'", s))
        }
        s = s[1:n]
        s = escapePat.ReplaceAllStringFunc(s, func(t string) string {
            r, ok := escapes[t] // r, err := strconv.Unquote("'" + t + "'")
            if !ok {
                r = t // 解釈できないエスケープ列はそのまま残す。
            }
            return r
        })
        rr.token = s
        return
    }
    i, err := strconv.ParseInt(s, 10, 0) // さしあたり数は十進 int に限る。
    if err == nil {
        rr.token = int(i)
        return
    }
    if s == "nil" {
        rr.token = Nil
        return
    } else if s == "t" {
        rr.token = true
        return
    }
    rr.token = NewSym(s)
    return
}

// Lisp のトークンに切り分けるための正規表現
var tokenPat = regexp.MustCompile(`\s+|;.*$|("(\\.?|.)*?"|,@?|[^()'` +
    "`" + `~"; ]+|.)`)

// 文字列中のエスケープ列を切り出すための正規表現
var escapePat = regexp.MustCompile(`\\(.)`)

// エスケープ列から文字列値への変換表
var escapes = map[string]string{
    `\\`: `\`,
    `\"`: `"`,
    `\n`: "\n", `\r`: "\r", `\f`: "\f", `\b`: "\b", `\t`: "\t", `\v`: "\v",
}

//----------------------------------------------------------------------

// Lisp 式として値を文字列化する。
func Str(x interface{}) string {
    return Str2(x, true)
}

// Lisp 式として値を文字列化する。第2引数が真ならば文字列を引用符で囲む。
func Str2(x interface{}, quoteString bool) string {
    return str4(x, quoteString, -1, nil)
}

// クォートのシンボルから文字列表現への変換表
var quotes = map[*Sym]string{
    QuoteSym:           "'",
    QuasiquoteSym:      "`",
    UnquoteSym:         ",",
    UnquoteSplicingSym: ",@",
}

func str4(a interface{}, quoteString bool, count int,
    printed map[*Cell]bool) string {
    if a == true {
        return "t"
    }
    switch x := a.(type) {
    case *Cell:
        if x == Nil {
            return "nil"
        }
        if s, ok := x.Car.(*Sym); ok {
            if q, ok := quotes[s]; ok {
                if d, ok := x.Cdr.(*Cell); ok {
                    if d.Cdr == Nil {
                        return q + str4(d.Car, true, count, printed)
                    }
                }
            }
        }
        return "(" + strListBody(x, count, printed) + ")"
    case string:
        if quoteString {
            return strconv.Quote(x)
        }
        return x
    case []interface{}:
        s := make([]string, len(x))
        for i, e := range x {
            s[i] = str4(e, true, count, printed)
        }
        return "[" + strings.Join(s, ", ") + "]"
    case *Sym:
        if x.IsInterned() {
            return x.Name
        }
        return "#:" + x.Name
    }
    return fmt.Sprintf("%v", a)
}

// リストを前後の ( ) を省いて文字列化する。
func strListBody(x *Cell, count int, printed map[*Cell]bool) string {
    if printed == nil {
        printed = make(map[*Cell]bool)
    }
    if count < 0 {
        count = 4 // 循環リストを ... で表すまでの閾値
    }
    s := make([]string, 0, 10)
    y := x
    for y != Nil {
        if _, ok := printed[y]; ok {
            count--
            if count < 0 {
                s = append(s, "...") // 循環リストを ... で表す。
                return strings.Join(s, " ")
            }
        } else {
            printed[y] = true
            count = 4
        }
        s = append(s, str4(y.Car, true, count, printed))
        if cdr, ok := y.Cdr.(*Cell); ok {
            y = cdr
        } else {
            s = append(s, ".")
            s = append(s, str4(y.Cdr, true, count, printed))
            break
        }
    }
    y = x
    for y != Nil {
        delete(printed, y)
        if cdr, ok := y.Cdr.(*Cell); ok {
            y = cdr
        } else {
            break
        }
    }
    return strings.Join(s, " ")
}

//----------------------------------------------------------------------

const (
    continueLoop = iota
    exitOnEOF
    abortByError
)

// REPL (Read-Eval-Print-Loop) を行う。
func Run(interp *Interp, input io.Reader) bool {
    interactive := (input == nil)
    if interactive {
        input = os.Stdin
    }
    reader := NewReader(input)
    for {
        if interactive {
            os.Stdout.WriteString("> ")
        }
        switch run1(interp, reader, interactive) {
        case exitOnEOF:
            return true // 最後まで無事終了した。
        case abortByError:
            return false // エラーにより中断する。
        }
    }
}

func run1(interp *Interp, reader *Reader, interactive bool) (result int) {
    defer func() {
        if err := recover(); err != nil {
            if err == EOFError {
                result = exitOnEOF
            } else {
                fmt.Println(err)
                if !interactive {
                    result = abortByError
                }
            }
        }
    }()
    sExp := reader.Read()
    x := interp.Eval(sExp, Nil)
    if interactive {
        fmt.Println(Str(x))
    }
    return continueLoop
}

//  args の各要素を Lisp スクリプトのファイル名として順に実行する。
//  args[0] は無視する。a[1] 以降がないか,値が "-" ならば対話入力する。
func Main(args []string) int {
    interp := NewInterp()
    ss := strings.NewReader(Prelude)
    if !Run(interp, ss) {
        return 1
    }
    if len(args) < 2 {
        args = []string{args[0], "-"}
    }
    for i, fileName := range args {
        if i == 0 {
            continue
        }
        if fileName == "-" {
            Run(interp, nil)
            fmt.Println("Goodbye")
        } else {
            file, err := os.Open(fileName)
            if err != nil {
                fmt.Println(err)
                return 1
            }
            if !Run(interp, file) {
                return 1
            }
        }
    }
    return 0
}

func main() {
    os.Exit(Main(os.Args))
}

// Lisp 初期化スクリプト
// (` が Go 言語の生文字列で使えないから ~ を ` に置き換えて使う)
var Prelude = strings.Replace(`
(setq defmacro
      (macro (name args &rest body)
             ~(progn (setq ,name (macro ,args ,@body))
                     ',name)))

(defmacro defun (name args &rest body)
  ~(progn (setq ,name (lambda ,args ,@body))
          ',name))

(defun caar (x) (car (car x)))
(defun cadr (x) (car (cdr x)))
(defun cdar (x) (cdr (car x)))
(defun cddr (x) (cdr (cdr x)))
(defun caaar (x) (car (car (car x))))
(defun caadr (x) (car (car (cdr x))))
(defun cadar (x) (car (cdr (car x))))
(defun caddr (x) (car (cdr (cdr x))))
(defun cdaar (x) (cdr (car (car x))))
(defun cdadr (x) (cdr (car (cdr x))))
(defun cddar (x) (cdr (cdr (car x))))
(defun cdddr (x) (cdr (cdr (cdr x))))
(defun not (x) (eq x nil))
(defun consp (x) (not (atom x)))
(defun print (x) (prin1 x) (terpri) x)
(defun identity (x) x)

(setq
 = eql
 null not
 setcar rplaca
 setcdr rplacd)

(defun > (x y) (< y x))
(defun >= (x y) (not (< x y)))
(defun <= (x y) (not (< y x)))
(defun /= (x y) (not (= x y)))

(defun equal (x y)
  (cond ((atom x) (eql x y))
        ((atom y) nil)
        ((equal (car x) (car y)) (equal (cdr x) (cdr y)))))

(defmacro if (test then &rest else)
  ~(cond (,test ,then)
         ,@(cond (else ~((t ,@else))))))

(defmacro when (test &rest body)
  ~(cond (,test ,@body)))

(defmacro let (args &rest body)
  ((lambda (vars vals)
     (defun vars (x)
       (cond (x (cons (if (atom (car x))
                          (car x)
                        (caar x))
                      (vars (cdr x))))))
     (defun vals (x)
       (cond (x (cons (if (atom (car x))
                          nil
                        (cadar x))
                      (vals (cdr x))))))
     ~((lambda ,(vars args) ,@body) ,@(vals args)))
   nil nil))

(defmacro letrec (args &rest body)      ; (letrec ((v e) ...) body...)
  (let (vars setqs)
    (defun vars (x)
      (cond (x (cons (caar x)
                     (vars (cdr x))))))
    (defun sets (x)
      (cond (x (cons ~(setq ,(caar x) ,(cadar x))
                     (sets (cdr x))))))
    ~(let ,(vars args) ,@(sets args) ,@body)))

(defun _append (x y)
  (if (null x)
      y
    (cons (car x) (_append (cdr x) y))))
(defmacro append (x &rest y)
  (if (null y)
      x
    ~(_append ,x (append ,@y))))

(defmacro and (x &rest y)
  (if (null y)
      x
    ~(cond (,x (and ,@y)))))

(defun mapcar (f x)
  (and x (cons (f (car x)) (mapcar f (cdr x)))))

(defmacro or (x &rest y)
  (if (null y)
      x
    ~(cond (,x)
           ((or ,@y)))))

(defun listp (x)
  (or (null x) (consp x)))    ; NB (listp (lambda (x) (+ x 1))) => nil

(defun memq (key x)
  (cond ((null x) nil)
        ((eq key (car x)) x)
        (t (memq key (cdr x)))))

(defun member (key x)
  (cond ((null x) nil)
        ((equal key (car x)) x)
        (t (member key (cdr x)))))

(defun assq (key alist)
  (cond (alist (let ((e (car alist)))
                 (if (and (consp e) (eq key (car e)))
                     e
                   (assq key (cdr alist)))))))

(defun assoc (key alist)
  (cond (alist (let ((e (car alist)))
                 (if (and (consp e) (equal key (car e)))
                     e
                   (assoc key (cdr alist)))))))

(defun _nreverse (x prev)
  (let ((next (cdr x)))
    (setcdr x prev)
    (if (null next)
        x
      (_nreverse next x))))
(defun nreverse (list)            ; (nreverse '(a b c d)) => (d c b a)
  (cond (list (_nreverse list nil))))

(defun last (list)
  (if (atom (cdr list))
      list
    (last (cdr list))))

(defun nconc (&rest lists)
  (if (null (cdr lists))
      (car lists)
    (if (null (car lists))
        (apply nconc (cdr lists))
      (setcdr (last (car lists))
              (apply nconc (cdr lists)))
      (car lists))))

(defmacro while (test &rest body)
  (let ((loop (gensym)))
    ~(letrec ((,loop (lambda () (cond (,test ,@body (,loop))))))
       (,loop))))

(defmacro dolist (spec &rest body) ; (dolist (name list [result]) body...)
  (let ((name (car spec))
        (list (gensym)))
    ~(let (,name
           (,list ,(cadr spec)))
       (while ,list
         (setq ,name (car ,list))
         ,@body
         (setq ,list (cdr ,list)))
       ,@(if (cddr spec)
             ~((setq ,name nil)
               ,(caddr spec))))))

(defmacro dotimes (spec &rest body) ; (dotimes (name count [result]) body...)
  (let ((name (car spec))
        (count (gensym)))
    ~(let ((,name 0)
           (,count ,(cadr spec)))
       (while (< ,name ,count)
         ,@body
         (setq ,name (+ ,name 1)))
       ,@(if (cddr spec)
             ~(,(caddr spec))))))
`, "~", "`", -1)

/*
  Copyright (c) 2015 OKI Software Co., Ltd.

  Permission is hereby granted, free of charge, to any person obtaining a
  copy of this software and associated documentation files (the "Software"),
  to deal in the Software without restriction, including without limitation
  the rights to use, copy, modify, merge, publish, distribute, sublicense,
  and/or sell copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
  THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  DEALINGS IN THE SOFTWARE.
*/