oftlisp-anf 0.1.3

use std::io::{stdout, Write};
use std::sync::atomic::{AtomicIsize, Ordering};

use gc::Gc;
use oftlisp::Value;
use oftlisp::gensym::gensym as make_gensym;
use oftlisp::interpreter::Primitives;
use oftlisp::reader::symbolish::str_is_symbol;
use oftlisp::util::{from_assoc, to_assoc};

use errors::RuntimeError;
use types::Context;

/// The primitives for the [`Context`](struct.Context.html).
pub static PRIMITIVES: Primitives<Context> = Primitives {
    apply,
    atomic_word_cas,
    atomic_word_load,
    atomic_word_new,
    atomic_word_store,
    byte_of_fixnum,
    bytes_of_string,
    car,
    cdr,
    compare,
    concat_strings,
    cons,
    debug,
    eq,
    exit_with,
    fixnum_of_byte,
    gensym,
    is_byte,
    is_cons,
    is_fixnum,
    is_nil,
    is_object,
    is_string,
    is_symbol,
    is_vector,
    list_of_vector,
    make_vector,
    object_data_len,
    object_get_data,
    object_get_func,
    object_has_func,
    object_seal,
    object_unseal,
    op_add,
    op_cmp,
    op_div,
    op_equ,
    op_mod,
    op_mul,
    op_sub,
    panic,
    show_primitive,
    string_of_symbol,
    symbol_of_string,
    unwind_protect,
    vector_of_list,
    write_bytes,
};

type Args = Vec<Gc<Value<Context>>>;
type Return = Result<Gc<Value<Context>>, RuntimeError>;

macro_rules! args {
    ([$args:expr, $name:expr]($($req:ident)*) => $block:block) => {
        args!([$args, $name]($($req)* ... rest) => {
            if rest.len() == 0 {
                $block
            } else {
                unimplemented!("bad argn in call to {}", $name)
            }
        })
    };
    ([$args:expr, $name:expr]($($req:ident)* ... $rest:ident) => $block:block) => {{
        let mut args = $args;
        args.reverse();
        $(let $req = if args.is_empty() {
            unimplemented!("bad argn in call to {}", $name)
        } else {
            args.pop().unwrap()
        };)*
        args.reverse();
        let $rest = args;
        #[allow(unused_macros)]
        macro_rules! __oftlisp_func_name {
            () => { $name };
        }
        $block
    }};
}
macro_rules! type_check {
    (atomic <- $expr:expr) => { type_check!(Value::AtomicWord(ref n, _), n, $expr) };
    (byte <- $expr:expr) => { type_check!(Value::Byte(n, _), n, $expr) };
    (bytes <- $expr:expr) => { type_check!(Value::Bytes(ref b, _), b, $expr) };
    (cons <- $expr:expr) => { type_check!(Value::Cons(ref h, ref t, _), (h, t), $expr) };
    (fixnum <- $expr:expr) => { type_check!(Value::Fixnum(n, _), n, $expr) };
    (obj <- $expr:expr) => { type_check!(Value::Object(ref f, ref d, _), (f, d), $expr) };
    (string <- $expr:expr) => { type_check!(Value::String(ref s, _), s, $expr) };
    (symbol <- $expr:expr) => { type_check!(Value::Symbol(s, _), s, $expr) };
    (vector <- $expr:expr) => { type_check!(Value::Vector(ref v, _), v, $expr) };
    ($pat:pat, $out:expr, $expr:expr) => {{
        let value = &*$expr;
        if let $pat = *value {
            $out
        } else {
            unimplemented!("type_check in {} failed: could not match {} with {}", __oftlisp_func_name!(), value, stringify!($pat))
        }
    }};

    (list <- $expr:expr) => {{
        let value = $expr;
        if let Some(l) = $crate::oftlisp::util::as_list(value.clone()) {
            l
        } else {
            unimplemented!("type_check in {} failed: {} is not a list", __oftlisp_func_name!(), value)
        }
    }};
}
macro_rules! define_ops {
    ($(($sym_name:ident, $fn_name:expr) = $fn:expr;)*) => {
        $(fn $sym_name(args: Args) -> Return {
            args!([args, $fn_name](l r) => {
                match (&*l, &*r) {
                    (&Value::Byte(a, _), &Value::Byte(b, _)) => {
                        Ok(Gc::new(Value::Byte(($fn)(a, b), Default::default())))
                    },
                    (&Value::Fixnum(a, _), &Value::Fixnum(b, _)) => {
                        Ok(Gc::new(Value::Fixnum(($fn)(a, b), Default::default())))
                    },
                    (_, _) => unimplemented!("invalid arg types to {}", __oftlisp_func_name!()),
                }
            })
        })*
    };
}

define_ops! {
    (op_add, "+/2") = |a, b| a + b;
    (op_sub, "-/2") = |a, b| a - b;
    (op_mul, "*/2") = |a, b| a * b;
    (op_div, "//2") = |a, b| a / b;
    (op_mod, "mod/2") = |a, b| a % b;
}

fn apply(args: Args) -> Return {
    args!([args, "apply"](func args) => {
        let args = type_check!(list <- args);
        match *func {
            Value::BuiltinFunction(..) | Value::Func(..) => {
                Context::apply(func, args)
            },
            _ => unimplemented!("cannot apply to non-func"),
        }
    })
}

fn atomic_word_cas(args: Args) -> Return {
    args!([args, "atomic-word.cas"](a before after) => {
        let a = type_check!(atomic <- a);
        let before = type_check!(fixnum <- before);
        let after = type_check!(fixnum <- after);
        let n = a.compare_and_swap(before, after, Ordering::SeqCst);
        Ok(Gc::new(Value::Fixnum(n, Default::default())))
    })
}

fn atomic_word_load(args: Args) -> Return {
    args!([args, "atomic-word.load"](a) => {
        let a = type_check!(atomic <- a);
        let n = a.load(Ordering::SeqCst);
        Ok(Gc::new(Value::Fixnum(n, Default::default())))
    })
}

fn atomic_word_new(args: Args) -> Return {
    args!([args, "atomic-word.new"](n) => {
        let n = type_check!(fixnum <- n);
        Ok(Gc::new(Value::AtomicWord(AtomicIsize::new(n), Default::default())))
    })
}

fn atomic_word_store(args: Args) -> Return {
    args!([args, "atomic-word.store"](a n) => {
        let a = type_check!(atomic <- a);
        let n = type_check!(fixnum <- n);
        a.store(n, Ordering::SeqCst);
        Ok(Gc::new(Value::Nil(Default::default())))
    })
}

fn byte_of_fixnum(args: Args) -> Return {
    args!([args, "byte<-fixnum"](val) => {
        let n = type_check!(fixnum <- val);
        Ok(Gc::new(if n >= 0 && n < 256 {
            Value::Byte(n as u8, Default::default())
        } else {
            Value::Nil(Default::default())
        }))
    })
}

fn bytes_of_string(args: Args) -> Return {
    args!([args, "bytes<-string"](val) => {
        let s = type_check!(string <- val);
        let bs = Gc::new(Clone::clone(&**s).into_bytes());
        Ok(Gc::new(Value::Bytes(bs, Default::default())))
    })
}

fn car(args: Args) -> Return {
    args!([args, "car"](l) => {
        let (h, _) = type_check!(cons <- l);
        Ok(h.clone())
    })
}

fn compare(args: Args) -> Return {
    args!([args, "compare"](x y) => {
        Ok(Value::ordering(x.partial_cmp(&y)))
    })
}

fn cdr(args: Args) -> Return {
    args!([args, "cdr"](l) => {
        let (_, t) = type_check!(cons <- l);
        Ok(t.clone())
    })
}

fn concat_strings(args: Args) -> Return {
    args!([args, "concat-strings"](... strs) => {
        let mut buf = String::new();
        for s in strs {
            let s = type_check!(string <- s);
            buf += s;
        }
        Ok(Gc::new(Value::String(Gc::new(buf), Default::default())))
    })
}

fn cons(args: Args) -> Return {
    args!([args, "cons"](h t) => {
        Ok(Gc::new(Value::Cons(h, t, Default::default())))
    })
}

fn debug(args: Args) -> Return {
    args!([args, "debug"](x) => {
        warn!("{}", x);
        Ok(x)
    })
}

fn eq(args: Args) -> Return {
    args!([args, "eq"](l r) => {
        Ok(Value::bool(l == r))
    })
}

fn exit_with(args: Args) -> Return {
    args!([args, "exit-with"](code) => {
        let code = type_check!(byte <- code);
        Err(RuntimeError::Exit(code))
    })
}

fn fixnum_of_byte(args: Args) -> Return {
    args!([args, "fixnum<-byte"](val) => {
        let n = type_check!(byte <- val);
        Ok(Gc::new(Value::Fixnum(n as isize, Default::default())))
    })
}

fn gensym(args: Args) -> Return {
    args!([args, "gensym"]() => {
        Ok(Gc::new(Value::Symbol(make_gensym(), Default::default())))
    })
}

fn is_byte(args: Args) -> Return {
    args!([args, "byte?"](val) => {
        Ok(Value::bool(if let Value::Byte(..) = *val {
            true
        } else {
            false
        }))
    })
}

fn is_cons(args: Args) -> Return {
    args!([args, "cons?"](val) => {
        Ok(Value::bool(if let Value::Cons(..) = *val {
            true
        } else {
            false
        }))
    })
}

fn is_fixnum(args: Args) -> Return {
    args!([args, "fixnum?"](val) => {
        Ok(Value::bool(if let Value::Fixnum(..) = *val {
            true
        } else {
            false
        }))
    })
}

fn is_nil(args: Args) -> Return {
    args!([args, "nil?"](val) => {
        Ok(Value::bool(if let Value::Nil(_) = *val {
            true
        } else {
            false
        }))
    })
}

fn is_object(args: Args) -> Return {
    args!([args, "object?"](val) => {
        Ok(Value::bool(if let Value::Object(..) = *val {
            true
        } else {
            false
        }))
    })
}

fn is_symbol(args: Args) -> Return {
    args!([args, "symbol?"](val) => {
        Ok(Value::bool(if let Value::Symbol(..) = *val {
            true
        } else {
            false
        }))
    })
}

fn is_string(args: Args) -> Return {
    args!([args, "string?"](val) => {
        Ok(Value::bool(if let Value::String(..) = *val {
            true
        } else {
            false
        }))
    })
}

fn is_vector(args: Args) -> Return {
    args!([args, "vector?"](val) => {
        Ok(Value::bool(if let Value::Vector(..) = *val {
            true
        } else {
            false
        }))
    })
}

fn list_of_vector(args: Args) -> Return {
    args!([args, "list<-vector"](v) => {
        let v = type_check!(vector <- v);
        Ok(Value::list(v.clone(), Default::default()))
    })
}

fn make_vector(args: Args) -> Return {
    args!([args, "make-vector"](l) => {
        let l = type_check!(fixnum <- l) as usize;
        let v = vec![Gc::new(Value::Nil(Default::default())); l];
        Ok(Gc::new(Value::Vector(v, Default::default())))
    })
}

fn object_data_len(args: Args) -> Return {
    args!([args, "object-data-len"](val) => {
        let (_, data) = type_check!(obj <- val);
        Ok(Gc::new(Value::Fixnum(data.len() as isize, Default::default())))
    })
}

fn object_get_data(args: Args) -> Return {
    args!([args, "object-get-data"](val i) => {
        let (_, data) = type_check!(obj <- val);
        let i = type_check!(fixnum <- i);
        if i < 0 || i as usize >= data.len() {
            return Err(RuntimeError::ObjectDataOutOfBounds(i, val.clone()));
        } else {
            Ok(data[i as usize].clone())
        }
    })
}

fn object_get_func(args: Args) -> Return {
    args!([args, "object-get-func"](val name) => {
        let (vt, _) = type_check!(obj <- val);
        let name = type_check!(symbol <- name);
        if let Some(func) = vt.get(&name) {
            Ok(func.clone())
        } else {
            Err(RuntimeError::ObjectNoSuchFunc(name, val.clone()))
        }
    })
}

fn object_has_func(args: Args) -> Return {
    args!([args, "object-has-func?"](val name) => {
        let (vt, _) = type_check!(obj <- val);
        let name = type_check!(symbol <- name);
        Ok(Value::bool(vt.contains_key(&name)))
    })
}

fn object_seal(args: Args) -> Return {
    args!([args, "object-seal"](vtbl data) => {
        let vtbl = if let Some(vtbl) = from_assoc(vtbl.clone()) {
            vtbl
        } else {
            return Err(RuntimeError::InvalidVTable(vtbl));
        };
        let data = type_check!(vector <- data);
        Ok(Gc::new(Value::Object(vtbl, data.clone(), Default::default())))
    })
}

fn object_unseal(args: Args) -> Return {
    args!([args, "object-unseal"](val) => {
        let (vtbl, data) = type_check!(obj <- val);
        let vtbl = to_assoc(vtbl);
        let data = Value::vector(data.clone());
        Ok(Gc::new(Value::Cons(vtbl, data, Default::default())))
    })
}

fn op_cmp(args: Args) -> Return {
    args!([args, "<>"](l r) => {
        match (&*l, &*r) {
            (&Value::Fixnum(l, _), &Value::Fixnum(r, _)) => Ok(Value::ordering(Some(l.cmp(&r)))),
            (_, _) => unimplemented!("invalid arg types to <>"),
        }
    })
}

fn op_equ(args: Args) -> Return {
    args!([args, "="](l r) => {
        Ok(Value::bool(l == r))
    })
}

fn panic(args: Args) -> Return {
    Err(RuntimeError::Panic(args))
}

fn show_primitive(args: Args) -> Return {
    args!([args, "show-primitive"](val) => {
        let s = Gc::new(format!("{}", val));
        Ok(Gc::new(Value::String(s, Default::default())))
    })
}

fn string_of_symbol(args: Args) -> Return {
    args!([args, "string<-symbol"](val) => {
        let s = type_check!(symbol <- val);
        Ok(Gc::new(Value::String(Gc::new(s.to_string()), Default::default())))
    })
}

fn symbol_of_string(args: Args) -> Return {
    args!([args, "symbol<-string"](val) => {
        let s = type_check!(string <- val);
        Ok(Gc::new(if str_is_symbol(s) {
            Value::Symbol(s.as_str().into(), Default::default())
        } else {
            Value::Nil(Default::default())
        }))
    })
}

fn unwind_protect(args: Args) -> Return {
    args!([args, "unwind-protect"](try finally) => {
        let val = Context::apply(try, vec![]);
        Context::apply(finally, vec![])?;
        val
    })
}

fn vector_of_list(args: Args) -> Return {
    args!([args, "vector<-list"](l) => {
        let l = type_check!(list <- l);
        Ok(Value::vector(l))
    })
}

fn write_bytes(args: Args) -> Return {
    args!([args, "write-bytes"](val) => {
        let bs = type_check!(bytes <- val);
        stdout().write_all(bs)?;
        Ok(Gc::new(Value::Nil(Default::default())))
    })
}