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

// This is a simple and straight forward implementation of a small toy
// Lisp in Rust. We consider this as an experiment on how well Rust
// would be such a task.

// Here are our rules:

//   1. No unsafe code
//   2. No unsafe code
//   3. No unsafe code

// In general this is not a good example on how to craft a Lisp. To
// begin with this is an interpreter. You would at least want a single
// byte code implementation.

// -- TODO -------------------------------------------------------------------

// - FUNCALL, APPLY

// - argc check.

// - "..." syntax. This should yield self-evaluating uninterned symbols.
//   Maclisp marks those with a special property, so that they also
//   print like that.

// - init file loading.

// - EQN

// - Lisp-2?

// - symbol plist

// - More work for streams as we need our own anyway.

// - TYI, UNTYI, TYO, OPENI, OPENO, CLOSE, FLUSH

// - Unicode, that is UTF-8 encoding and decoding.

// - ((lambda ...) ...)

// - dotted argument lists

// - Can we cons less on function invokation. But hey! Rust has no GC,
//   has it?

// - We should at least map out, what it would take to implement a
//   proper GC.

// #![allow(dead_code)]
// #![allow(unused_assignments)]
// #![allow(unused_variables)]
// #![allow(unused_macros)]
// #![allow(unused_imports)]

//use std::rc::Rc;
use std::cell::RefCell;
use std::sync::{Mutex,Arc};
use std::io::{self, Write, Read};
use std::fmt;
use std::collections::HashMap;
use std::char;

type Q = Node;
type Flonum = f64;

struct Cons {
    car :Node, cdr :Node }

// struct Closure {
//     params :Node,
//     body :Node,
//     env :Node
// }

struct Symbol {
    val :Node,
    nam: Arc<String>,
    plist :Node }

#[derive(Clone)]
enum Node {
    Flonum (Flonum),
    Cons (Arc<Mutex<Cons>>),
    Symbol (Arc<Mutex<Symbol>>),
    Subr0 (Arc<dyn Fn (&World) -> Ret<Q>>),
    Subr1 (Arc<dyn Fn (&World, Q) -> Ret<Q>>),
    Subr2 (Arc<dyn Fn (&World, Q, Q) -> Ret<Q>>),
    Subr3 (Arc<dyn Fn (&World, Q, Q, Q) -> Ret<Q>>),
    Pred1 (Arc<dyn Fn (&World, Q) -> Ret<bool>>),
    Pred2 (Arc<dyn Fn (&World, Q, Q) -> Ret<bool>>),
    PrimPred1 (Arc<dyn Fn (Q) -> bool>),
    Unbound }

// -- Conses -----------------------------------------------------------------

fn cons (w :&World, x :Q, y :Q) -> Ret<Q> {
    Ok(Node::Cons (Arc::new(Mutex::new(Cons { car: x, cdr: y })))) }

fn car (w :&World, x :Q) -> Ret<Q> {
    if null (w, x.clone()) {
        Ok(x)
    } else {
        match x {
            Node::Cons(x) => Ok(x.lock().unwrap().car.clone()),
            _ => error (w, "Not a list".to_string(), x) } }}

fn cdr (w :&World, x :Q) -> Ret<Q> {
    if null (w, x.clone()) {
        Ok(x)
    } else {
        match x {
            Node::Cons(x) => Ok(x.lock().unwrap().cdr.clone()),
            _ => error (w, "Not a list".to_string(), x) } }}

fn rplaca (w :&World, x :Q, y :Q) -> Ret<Q> {
    match x.clone() {
        Node::Cons(q) => {
            q.lock().unwrap().car = y;
            Ok(x) }
        _ => error (w, "Not a cons".to_string(), x) }}

fn rplacd (w :&World, x :Q, y :Q) -> Ret<Q> {
    match x.clone() {
        Node::Cons(q) => {
            q.lock().unwrap().cdr = y;
            Ok(x) }
        _ => error (w, "Not a cons".to_string(), x) }}

// -- Numbers ----------------------------------------------------------------

fn maknum (x :Flonum) -> Q {
    Node::Flonum(x) }

fn getnum (w :&World, x :Q) -> Ret<Flonum> {
    match x {
        Node::Flonum(x) => Ok(x),
        _ => match error (w, "Not a number".to_string(), x.clone()) {
            Err(e) => Err(e), _ => panic!("Hugh?") }}}

fn plus (w :&World, x :Q, y :Q) -> Ret<Q> {
    Ok(maknum (getnum (w, x)? + getnum (w, y)?)) }

fn difference (w :&World, x :Q, y :Q) -> Ret<Q> {
    Ok(maknum (getnum (w, x)? - getnum (w, y)?)) }

fn quotient (w :&World, x :Q, y :Q) -> Ret<Q> {
    Ok(maknum (getnum (w, x)? / getnum (w, y)?)) }

fn times (w :&World, x :Q, y :Q) -> Ret<Q> {
    Ok(maknum (getnum (w, x)? * getnum (w, y)?)) }

fn lessp (w :&World, x :Q, y :Q) -> Ret<Q> {
    makbool (w, getnum (w, x)? < getnum (w, y)?) }

fn makbool (w :&World, x :bool) -> Ret<Q> {
    Ok(if x { w.u.t.clone() } else { w.u.nil.clone() })}

// -- Symbols ----------------------------------------------------------------

// Ok, we would need to have an oblist here. I wonder if it would be
// feasible to have extra enums for our builtin symbols. The interpreter
// also must dispatch on this.

fn maknam_from_string (w :&World, nam :String) -> Q {
    Node::Symbol (Arc::new(Mutex::new(Symbol {
        val: Node::Unbound,
        nam: Arc::new(nam),
        plist: w.u.nil.clone() }))) }

fn exploden (w :&World, x :Q) -> Ret<Q> {
    let mut buf = Vec::new();
    drucke (w, x.clone(), &mut buf).unwrap();
    // ### We want unicode here, don't we?
    let mut head = w.u.nil.clone();
    let mut tail = w.u.nil.clone();
    // Doesn't work. This sucks!
    let dear_rust = std::str::from_utf8(buf.as_slice()).unwrap(); //.to_string();
    let chars = dear_rust.chars();
    for c in chars 
    {
        let q = cons (w, maknum (c as u32 as Flonum), w.u.nil.clone())?;
        if null (w, tail.clone()) {
            head = q.clone();
            tail = q.clone();
        } else {
            rplacd (w, tail.clone(), q.clone())?;
        }
    }
    Ok (head) }

fn oblist (w :&World) -> Ret<Q> {
    let mut r = w.u.nil.clone();
    for (_, val) in &*w.u.obarray.lock().unwrap() {
        r = cons (w, val.clone(), r)?; }
    Ok(r) }

fn intern (w :&World, s :String) -> Q {
    let obarray = &mut w.u.obarray.lock().unwrap();
    match obarray.get(&s) {
        None => {
            let q = maknam_from_string (w, s.clone());
            obarray.insert(s,q.clone());
            q }
        Some(q) =>
            q.clone() } }

fn maknam (w :&World, x :Q) -> Ret<Q> {
    let mut bag = String::new ();
    let mut q = x;
    while !null (w, q.clone()) {
        bag.push (getchar (w, car (w, q.clone())?)?);
        q = cdr (w, q)?;
    }
    Ok (maknam_from_string (w, bag)) }

fn getchar (w :&World, x :Q) -> Ret<char> {
    let u = getnum (w, x.clone())? as u32;
    let c = char::from_u32 (u);
    match c {
        Some (c) => Ok(c),
        _ => match error (w, "Not a valid character".to_string(), x.clone()) {
            Err(e) => Err(e), _ => panic!("Hugh?") }}}

fn subr_intern (w :&World, x :Q) -> Ret<Q> {
    Ok (intern (w, symbol_name (x).to_string())) }

// -- Predicates -------------------------------------------------------------

fn consp (x :Q) -> bool {
    match x { Node::Cons(_) => true, _ => false, } }

fn atom (x :Q) -> bool {
    !consp(x) }

fn numberp (x :Q) -> bool {
    match x { Node::Flonum(_) => true, _ => false, } }

fn symbolp (x :Q) -> bool {
    match x { Node::Symbol(_) => true, _ => false, } }

fn eq (x :Q, y :Q) -> bool {
    match (x, y) {
        (Node::Cons(x), Node::Cons(y)) => Arc::ptr_eq(&x,&y),
        (Node::Symbol(x), Node::Symbol(y)) => Arc::ptr_eq(&x,&y),
        (Node::Flonum(x), Node::Flonum(y)) => x == y,
        (Node::Unbound, Node::Unbound) => true,
        _ => false, }}

fn subr_eq (_ :&World, x :Q, y :Q) -> Ret<bool> {
    Ok(eq(x,y)) }

fn eql (x :Q, y :Q) -> bool {
    eq (x, y) }

fn eqn (x :Q, y :Q) -> bool {
    match (x,y) {
        (Node::Flonum(x), Node::Flonum(y)) => x == y,
        _ => panic!("Not two numbers"), }}

fn null (w :&World, x :Q) -> bool {
    eq (x, w.u.nil.clone()) }

// -- Printer ----------------------------------------------------------------

fn symbol_name (x :Q) -> Arc<String> {
    match x {
        Node::Symbol(s) => {
            s.lock().unwrap().nam.clone() }
        _ => panic! ("Not a symbol") }}

fn set (w :&World, x :Q, y :Q) -> Ret<Q> {
    match x.clone() {
        Node::Symbol(s) => {
            s.lock().unwrap().val = y.clone();
            Ok(y) }
        _ => error (w, "Not a symbol".to_string(), x) }}

fn set_plist (w :&World, x :Q, y :Q) -> Ret<Q> {
    match x.clone() {
        Node::Symbol(s) => {
            s.lock().unwrap().plist = y.clone();
            Ok(y) }
        _ => error (w, "Not a symbol".to_string(), x) }}

fn symbol_plist (w :&World, x :Q) -> Ret<Q> {
    match x.clone() {
        Node::Symbol(s) => { Ok(s.lock().unwrap().plist.clone()) }
        _ => error (w, "Not a symbol".to_string(), x) }}

fn get (w :&World, x :Q, y :Q) -> Ret<Q> {
    let mut q = symbol_plist (w, x)?;
    while consp (q.clone()) {
        if eq (y.clone(), car (w, q.clone())?) {
            return car (w, cdr (w, q)?); }
        q = cdr (w, cdr (w, q)?)?; }
    Ok(w.u.nil.clone()) }

fn put (w :&World, x :Q, y :Q, z :Q) -> Ret<Q> {
    let plist = symbol_plist (w, x.clone())?;
    let mut q = plist.clone();
    while consp (q.clone()) {
        if eq (y.clone(), car (w, q.clone())?) {
            rplaca (w, cdr (w, q)?, z.clone())?;
            return Ok(z.clone()); }
        q = cdr (w, cdr (w, q)?)?; }
    set_plist (w, x, cons (w, y, cons (w, z.clone(), plist)?)?)?;
    Ok(z) }

fn drucke (w :&World, x :Q, s :&mut dyn Write) -> Ret<Q> {
    if consp (x.clone()) {
        let mut q = x.clone();
        s.write ("(".to_string().as_bytes()).unwrap();
        loop {
            drucke (w, car(w, q.clone())?, s)?;
            q = cdr (w, q.clone())?;
            if !consp(q.clone()) { break; }
            s.write (" ".to_string().as_bytes()).unwrap(); }
        if !null(w, q.clone()) {
            s.write (" . ".to_string().as_bytes()).unwrap();
            drucke (w, q.clone(), s)?; }
        s.write (")".to_string().as_bytes()).unwrap();
    } else if numberp(x.clone()) {
        s.write (getnum(w, x.clone()).unwrap().to_string().as_bytes()).unwrap();
    } else if symbolp(x.clone()) {
        let nam = symbol_name(x.clone());
        s.write (nam.to_string().as_bytes()).unwrap();
    } else {
        s.write ("#<unknown>".as_bytes()).unwrap();
    }
    Ok(x)
}

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

type World = Arc<WorldStruct>;

#[derive(Clone)]
struct UniverseStruct {
    obarray: Arc<Mutex<HashMap<String, Q>>>,
    nil: Q,
    t: Q,
    s_quote: Q,
    s_setq: Q,
    s_if: Q,
    s_lambda: Q,
    s_catch: Q,
    s_throw: Q,
    s_closure: Q,
}

#[derive(Clone)]
struct WorldStruct {
    u :Arc<UniverseStruct>,
    d :RefCell<Q>,
    repl_level :RefCell<usize>
}

// -- Streams ----------------------------------------------------------------

// We need to be careful with EOF. We want to handle this like actual
// input. You usually cannot unread it, yet it must be able to consume
// it. C handles this by having EOF as a condition of the stream and a
// cleareof() to consume EOF. CL makes CL:READ-CHAR consume the EOF and
// CL:PEEK-CHAR leaving it. (Hence you can't implement CL:PEEK-CHAR in
// terms of CL:UNREAD-CHAR).

// We take a third route, we allow for EOF to unread. This simplifies
// many things like reading everything until some char or EOF and just
// blindly unread the input which we don't want.

type Rune = char;

#[derive(Clone)]
enum TyiResult {
    Rune(Rune),
    EOF
}

trait InputStream {
    fn tyi (&self) -> TyiResult;
    fn untyi (&self);
}

struct ReadInputStream {
    lookahead : Option<TyiResult>,
    read : Arc<Mutex<dyn Read>>
}

impl ReadInputStream {
    fn tyi (&mut self) -> TyiResult {
        match &self.lookahead.clone() {
            Some(r) => {
                self.lookahead = None;
                r.clone() },
            None => {
                let buf = &mut[0 as u8];
                let r = self.read.lock().unwrap().read(buf).unwrap();
                match r {
                    1 => TyiResult::Rune(buf[0] as Rune),
                    0 => TyiResult::EOF,
                    _ => panic! ("Hugh?!") }}}}
    fn untyi (&mut self, r :TyiResult) {
        self.lookahead = Some(r) } }

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

impl fmt::Display for Node {
    fn fmt (&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        let mut buf = Vec::new();
        drucke (&new_world(), self.clone(), &mut buf).unwrap();
        f.write_str(&std::str::from_utf8(buf.as_slice()).unwrap().to_string()) } }

impl fmt::Debug for Node {
    fn fmt (&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        let mut buf = Vec::new();
        drucke (&new_world(), self.clone(), &mut buf).unwrap();
        f.write_str(&std::str::from_utf8(buf.as_slice()).unwrap().to_string()) } }

impl fmt::Display for TyiResult {
    fn fmt (&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        match self {
            TyiResult::Rune(r) => f.write_fmt (format_args!("{}", r)),
            TyiResult::EOF => f.write_str ("#<eof>")
        }}}

// -- Lisp Reader ------------------------------------------------------------

// We derivate a bit from how this is usually done wrt to a sole dot and
// ')'. Additional to eof-value, we pass a dot-value and a rparen-value,
// which are Option<Q> here. When these are None, it is up to the read
// function to throw an error. Also as we don't have multiple values,
// our reader macros returns an Option<Q>, too.

enum Syntax {
    Whitespace,
    Constituent,
    TermMacro(fn (&World, &Arc<Mutex<ReadInputStream>>) -> Ret<Option<Q>>) }

fn read_quote (w :&World, input :&Arc<Mutex<ReadInputStream>>) -> Ret<Option<Q>> {
    let q = readone (w, input, None, None, None)?;
    Ok(Some(cons(w, w.u.s_quote.clone(),
                 cons (w, q, w.u.nil.clone())?)?)) }

fn read_comma (w :&World, input :&Arc<Mutex<ReadInputStream>>) -> Ret<Option<Q>> {
    let c = input.lock().unwrap().tyi ();
    let sym = {
        if let TyiResult::Rune('@') = c {
            intern (w, "COMMA-AT".to_string()) }
        else {
            input.lock().unwrap().untyi (c);
            intern (w, "COMMA".to_string()) }};
    let q = readone (w, input, None, None, None)?;
    Ok(Some(cons(w, sym, cons (w, q, w.u.nil.clone())?)?)) }

fn read_backquote (w :&World, input :&Arc<Mutex<ReadInputStream>>) -> Ret<Option<Q>> {
    let q = readone (w, input, None, None, None)?;
    Ok(Some(cons(w, intern (w, "BACKQUOTE".to_string()), cons (w, q, w.u.nil.clone())?)?)) }

fn read_semicolon (w :&World, input :&Arc<Mutex<ReadInputStream>>) -> Ret<Option<Q>> {
    loop {
        let c = input.lock().unwrap().tyi ();
        match c {
            TyiResult::EOF => {
                input.lock().unwrap().untyi (c);
                break; },
            TyiResult::Rune('\n') => {
                break; },
            TyiResult::Rune(_) => {}}}
    Ok(None) }

fn read_lparen (w :&World, input :&Arc<Mutex<ReadInputStream>>) -> Ret<Option<Q>> {
    let mut head = w.u.nil.clone();
    let mut tail = w.u.nil.clone();
    let rparen = cons (w, w.u.nil.clone(), w.u.nil.clone())?;
    let dot = cons (w, w.u.nil.clone(), w.u.nil.clone())?;
    loop {
        let q = readone (w, input, None,
                         if null(w, tail.clone()) { None } else { Some(dot.clone()) },
                         Some(rparen.clone()))?;
        if eq (q.clone(), rparen.clone()) {
            break;
        } else if eq (q.clone(), dot.clone()) {
            let q = readone (w, input, None, None, None)?;
            rplacd (w, tail, q.clone())?;
            let q = readone (w, input, None, None, Some(rparen.clone()))?;
            if eq (q.clone(), rparen.clone()) {
                break;
            } else {
                match error (w, "Missing ')'".to_string(), w.u.nil.clone()) {
                    Err(e) => return Err(e), _ => panic!("Hugh?!") }}
        } else {
            if null (w, tail.clone()) {
                head = cons (w, q.clone(), w.u.nil.clone()).unwrap();
                tail = head.clone(); }
            else {
                let n = cons (w, q.clone(), w.u.nil.clone()).unwrap();
                rplacd (w, tail, n.clone()).unwrap();
                tail = n; } }}
    Ok(Some(head)) }

fn read_rparen (w :&World, input :&Arc<Mutex<ReadInputStream>>) -> Ret<Option<Q>> {
    match error (w, "Misplaced ')'".to_string(), w.u.nil.clone()) {
        Err(e) => return Err(e), _ => panic!("Hugh?!") }}

fn readone (w :&World, input :&Arc<Mutex<ReadInputStream>>,
            eof_value :Option<Q>,
            dot_value :Option<Q>,
            rparen_value :Option<Q>) -> Ret<Q> {
    loop {
        let c = input.lock().unwrap().tyi ();
        match c {
            TyiResult::EOF => {
                match eof_value {
                    Some(x) => return Ok(x),
                    _ => {
                        input.lock().unwrap().untyi (c);
                        return error (w, "EOF seen".to_string(), w.u.nil.clone()); }}}
            TyiResult::Rune(c) => {
                if c == ')' {
                    if let Some(x) = rparen_value {
                        return Ok(x); }}
                match getsyntax (w, c) {
                    Syntax::Whitespace => continue,
                    Syntax::Constituent => {
                        let mut bag = String::from("");
                        bag.push(c);
                        loop {
                            let r = input.lock().unwrap().tyi ();
                            match r {
                                TyiResult::EOF => {
                                    input.lock().unwrap().untyi (r);
                                    break;
                                },
                                TyiResult::Rune(c) => {
                                    match getsyntax (w, c) {
                                        Syntax::Constituent =>
                                            bag.push(c),
                                        _ => {
                                            input.lock().unwrap().untyi (r);
                                            break; }}}}}
                        if bag == "." {
                            match dot_value {
                                Some(x) => return Ok(x),
                                _ => return error (w, "Dot context error".to_string(), w.u.nil.clone()) }
                        } else {
                            match bag.parse::<Flonum>() {
                                Ok(f) => {
                                    return Ok(maknum (f)); }
                                _ => {
                                    return Ok(intern(w,bag.to_uppercase())); }}}}
                    Syntax::TermMacro (f) => {
                        let x = f (w, input)?;
                        match x {
                            Some(x) => return Ok(x),
                            None => continue }}}}}}}

fn getsyntax (_ :&World, c :char) -> Syntax {
    match c {
        '('  => Syntax::TermMacro(read_lparen),
        ')'  => Syntax::TermMacro(read_rparen),
        ';'  => Syntax::TermMacro(read_semicolon),
        '\'' => Syntax::TermMacro(read_quote),
        ','  => Syntax::TermMacro(read_comma),
        '`'  => Syntax::TermMacro(read_backquote),
        //'\"' => Syntax::TermMacro(read_dquote),
        _    => { if c.is_whitespace()
                  { Syntax::Whitespace }
                  else { Syntax::Constituent }}}}

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

fn new_world () -> World {
    let obarray = HashMap::new();
    let obarray = Arc::new(Mutex::new(obarray));
    let fake_world = Arc::new(WorldStruct{
        d: RefCell::new(Node::Unbound),
        repl_level: RefCell::new(0 as usize),
        u: Arc::new(UniverseStruct {
            obarray: obarray.clone(),
            nil: Node::Unbound,
            t: Node::Unbound,
            s_if: Node::Unbound,
            s_quote: Node::Unbound,
            s_setq: Node::Unbound,
            s_lambda: Node::Unbound,
            s_catch: Node::Unbound,
            s_throw: Node::Unbound,
            s_closure: Node::Unbound })
    });
    {
        let nil = intern (&fake_world, "NIL".to_string());
        set (&fake_world, nil.clone(), nil.clone()).unwrap();
        set_plist (&fake_world, nil.clone(), nil.clone()).unwrap();
    }
    let w = Arc::new(WorldStruct{
        d: RefCell::new(intern (&fake_world, "NIL".to_string())),
        repl_level: RefCell::new(0 as usize),
        u: Arc::new(UniverseStruct{
        obarray: obarray.clone(),
        nil: intern (&fake_world, "NIL".to_string()),
        t: intern (&fake_world, "T".to_string()),
        s_quote: intern (&fake_world, "QUOTE".to_string()),
        s_setq: intern (&fake_world, "SETQ".to_string()),
        s_if: intern (&fake_world, "IF".to_string()),
        s_lambda: intern (&fake_world, "LAMBDA".to_string()),
        s_catch: intern (&fake_world, "CATCH".to_string()),
        s_throw: intern (&fake_world, "THROW".to_string()),
        s_closure: intern (&fake_world, "CLOSURE".to_string()),
        })});
    // set (&w, w.u.nil.clone(), w.u.nil.clone()).unwrap();
    set (&w, w.u.t.clone(), w.u.t.clone()).unwrap();
    set (&w, intern (&w, "CAR".to_string()), Node::Subr1(Arc::new(car))).unwrap();
    set (&w, intern (&w, "CDR".to_string()), Node::Subr1(Arc::new(cdr))).unwrap();
    set (&w, intern (&w, "CONS".to_string()), Node::Subr2(Arc::new(cons))).unwrap();
    set (&w, intern (&w, "LESSP".to_string()), Node::Subr2(Arc::new(lessp))).unwrap();
    set (&w, intern (&w, "PLUS".to_string()), Node::Subr2(Arc::new(plus))).unwrap();
    set (&w, intern (&w, "DIFFERENCE".to_string()), Node::Subr2(Arc::new(difference))).unwrap();
    set (&w, intern (&w, "TIMES".to_string()), Node::Subr2(Arc::new(times))).unwrap();
    set (&w, intern (&w, "QUOTIENT".to_string()), Node::Subr2(Arc::new(quotient))).unwrap();
    set (&w, intern (&w, "RPLACA".to_string()), Node::Subr2(Arc::new(rplaca))).unwrap();
    set (&w, intern (&w, "RPLACD".to_string()), Node::Subr2(Arc::new(rplacd))).unwrap();
    set (&w, intern (&w, "EQ".to_string()), Node::Pred2(Arc::new(subr_eq))).unwrap();
    set (&w, intern (&w, "ATOM".to_string()), Node::PrimPred1(Arc::new(atom))).unwrap();
    // set (&w, intern (&w, "NULL".to_string()), Node::PrimPred1(Arc::new(null))).unwrap();
    set (&w, intern (&w, "CONSP".to_string()), Node::PrimPred1(Arc::new(consp))).unwrap();
    set (&w, intern (&w, "SYMBOLP".to_string()), Node::PrimPred1(Arc::new(symbolp))).unwrap();
    set (&w, intern (&w, "NUMBERP".to_string()), Node::PrimPred1(Arc::new(numberp))).unwrap();
    set (&w, intern (&w, "EXPLODEN".to_string()), Node::Subr1(Arc::new(exploden))).unwrap();
    set (&w, intern (&w, "OBLIST".to_string()), Node::Subr0(Arc::new(oblist))).unwrap();
    set (&w, intern (&w, "MAKNAM".to_string()), Node::Subr1(Arc::new(maknam))).unwrap();
    set (&w, intern (&w, "INTERN".to_string()), Node::Subr1(Arc::new(subr_intern))).unwrap();
    set (&w, intern (&w, "PLIST".to_string()), Node::Subr1(Arc::new(symbol_plist))).unwrap();
    set (&w, intern (&w, "SET-PLIST".to_string()), Node::Subr2(Arc::new(set_plist))).unwrap();
    set (&w, intern (&w, "GET".to_string()), Node::Subr2(Arc::new(get))).unwrap();
    set (&w, intern (&w, "PUT".to_string()), Node::Subr3(Arc::new(put))).unwrap();
    w
}

#[derive(Debug)]
enum RetEnum {
    Throw(Q,Q)
}

type Ret<T> = Result<T,RetEnum>;

fn eval (w :&World, mut x :Q, mut env :Q) -> Ret<Q> {
    loop {
        if symbolp (x.clone()) {
            let q = assoc (w, x.clone(), env.clone())?;
            if !null (w, q.clone()) {
                return cdr (w, q);
            } else {
                return symeval (w, x); }
        } else if atom (x.clone()) {
            return Ok(x);
        } else {
            let mut op = car (w, x.clone())?;
            let args = cdr (w, x.clone())?;
            if symbolp (op.clone ()) {
                if eq (op.clone(), w.u.s_quote.clone()) {
                    return car (w, args.clone());
                } else if eq (op.clone(), w.u.s_if.clone()) {
                    let test = eval (w, car (w, args.clone())?, env.clone())?;
                    x = {
                        if !null (w, test) {
                            car (w, cdr (w, args.clone())?.clone())? }
                        else {
                            car (w, cdr (w, cdr (w, args.clone())?.clone())?.clone())? } };
                } else if eq (op.clone(), w.u.s_setq.clone()) {
                    let var = car (w, args.clone())?;
                    let val = eval (w, car (w, cdr (w, args.clone())?.clone())?, env.clone())?;
                    let q = assoc (w, var.clone(), env.clone())?;
                    if !null (w, q.clone()) {
                        rplacd (w, q, val.clone())?;
                    } else {
                        set (w, var, val.clone())?; }
                    return Ok(val);
                } else if eq (op.clone(), w.u.s_lambda.clone()) {
                    return cons (w, w.u.s_closure.clone(), cons (w, env, args)?);
                } else if eq (op.clone(), w.u.s_catch.clone()) {
                    let tag = eval (w, car (w, args.clone())?, env.clone())?;
                    let old_d = w.d.borrow().clone();
                    *w.d.borrow_mut() = cons (w, tag.clone(), old_d.clone())?;
                    let mut res = Ok(w.u.nil.clone());
                    let mut q = cdr (w, args.clone())?;
                    while !null (w, q.clone()) {
                        let r = eval (w, car (w, q.clone())?, env.clone());
                        match r {
                            Err(RetEnum::Throw(target,value)) => {
                                if eq (target.clone(), tag.clone()) {
                                    res = Ok(value.clone());
                                    break;
                                } else {
                                    res = Err(RetEnum::Throw(target.clone(),value.clone()));
                                    break;
                                } },
                            Ok(x) => res = Ok(x) };
                        q = cdr (w, q)?; }
                    *w.d.borrow_mut() = old_d;
                    return res;
                } else if eq (op.clone(), w.u.s_throw.clone()) {
                    let tag = eval (w, car (w, args.clone())?, env.clone())?;
                    let val = eval (w, car (w, cdr (w, args.clone())?.clone())?, env.clone())?;
                    return Err(RetEnum::Throw (tag.clone(), val.clone()));
                } else {
                    // Try to find a symbol value of 'op', don't error yet on unbound
                    // symbols as we give symbols naming SUBRs a second chance.
                    let args = evlis (w, args.clone(), env.clone())?;
                    let q = assoc (w, op.clone(), env.clone())?;
                    if !null (w, q.clone()) {
                        op = cdr (w, q)?;
                    } else {
                        let q = symeval_0 (w, op.clone())?;
                        match q {
                            Node::Unbound => { },
                            _ => op = q }; }
                    match op.clone() {
                        Node::Subr0(f) => return f(w),
                        Node::Subr1(f) => return f(w, car (w, args)?),
                        Node::Subr2(f) => return f(w, car (w, args.clone())?,
                                                   car (w, cdr (w, args)?)?),
                        Node::Subr3(f) => return f(w, car (w, args.clone())?,
                                                   car (w, cdr (w, args.clone())?)?,
                                                   car (w, cdr (w, cdr (w, args)?)?)?),
                        Node::Pred1(f) => return makbool (w, f(w, car (w, args)?)?),
                        Node::Pred2(f) => return makbool (w, f(w, car (w, args.clone())?,
                                                               car (w, cdr (w, args)?)?)?),
                        Node::PrimPred1(f) => return makbool (w, f(car (w, args)?)),
                        _ => {
                            if consp (op.clone()) && eq (car (w, op.clone())?, w.u.s_closure.clone()) {
                                let op = cdr (w, op)?;
                                let mut q = cdr (w, cdr (w, op.clone())?)?;
                                env = pairlis (w, car (w, cdr (w, op.clone())?)?, args, car (w, op.clone())?)?;
                                if null (w, q.clone()) {
                                    return Ok(w.u.nil.clone());
                                } else {
                                    while !null (w, q.clone()) {
                                        let ca = car (w, q.clone())?;
                                        let cd = cdr (w, q.clone())?;
                                        if null (w, cd.clone()) {
                                            x = ca;
                                            break;
                                        } else {
                                            eval (w, ca, env.clone())?;
                                            q = cd; }}}
                            } else {
                                return error (w, "Bad function".to_string(), op.clone()); }}}}
            } else {
                return error (w, "Bad form".to_string(), x.clone()); }}}}

fn evlis (w :&World, x :Q, env :Q) -> Ret<Q> {
    if null (w, x.clone()) {
        Ok(w.u.nil.clone())
    } else {
        cons (w, eval (w, car (w, x.clone())?, env.clone())?,
              evlis (w, cdr (w, x)?, env)?) }}

fn symeval (w :&World, x :Q) -> Ret<Q> {
    match symeval_0 (w, x.clone())?.clone() {
        Node::Unbound =>
            error (w, "Unbound symbol".to_string(), x.clone()),
        q => Ok(q) }}

fn symeval_0 (w :&World, x :Q) -> Ret<Q> {
    match x {
        Node::Symbol(x) => {
            Ok(x.lock().unwrap().val.clone()) },
        _ => error (w, "Not a symbol".to_string(), x) }}

fn assoc (w :&World, x :Q, y :Q) -> Ret<Q> {
    if null (w, y.clone()) {
        Ok(w.u.nil.clone())
    } else if eq (x.clone(), car (w, car (w, y.clone())?)?.clone()) {
        car (w, y)
    } else {
        assoc (w, x, cdr (w, y.clone())?) }}

fn pairlis (w :&World, x :Q, y :Q, z :Q) -> Ret<Q> {
    if null (w, x.clone()) {
        if null (w, y.clone()) {
            Ok(z)
        } else {
            error (w, "Too many arguments".to_string(), y) }
    } else if null (w, y.clone()) {
        error (w, "Too few arguments".to_string(), x)
    } else {
        cons (w,
              cons (w, car (w, x.clone())?, car (w, y.clone())?)?,
              pairlis (w, cdr (w, x.clone())?, cdr (w, y.clone())?, z)?) }}

fn error (w :&World, msg :String, x :Q) -> Ret<Q> {
    println! ("ERROR: {} - {}", msg, x);
    panic! ("Good bye");
}

fn repl (w :&World) {
    let repl_level = w.repl_level.borrow().clone();
    {
        let mut dr = w.repl_level.borrow_mut();
        *dr = repl_level + 1;
    }
    {
        let mut dr = w.repl_level.borrow_mut();
        *dr = repl_level;
    }
}

fn main () {
    let w = new_world();
    let f = Arc::new(Mutex::new(ReadInputStream {
        lookahead: None,
        read: Arc::new(Mutex::new(io::stdin()))
    }));
    println!(";; Welcome to Nocturnal Lisp in Rust");
    let fin = cons (&w, w.u.nil.clone(), w.u.nil.clone()).unwrap();
    loop {
        io::stdout().write_fmt(format_args!("\n> ")).unwrap();
        io::stdout().flush().unwrap();
        let q = readone (&w, &f, Some(fin.clone()), None, None).unwrap();
        if eq (q.clone(), fin.clone()) {
            break;
        } else {
                drucke (&w, eval (&w, q.clone(), w.u.nil.clone()).unwrap(), &mut io::stdout()).unwrap();
        }
    }
    println!("");
    println!("Take care.");
}