litto 0.1.0

//! The standard library of `minilang`.
//!
//! For demonstration purpose. It's not complete.

use super::types::{Bool, Int, List, NativeProcedure, Nil, Procedure, Str};
use super::MiniLang;
use crate::Interpreter;

type Value = <MiniLang as Interpreter>::Value;
type Error = <MiniLang as Interpreter>::Error;
type Expr = <MiniLang as Interpreter>::Expr;
type Env = <MiniLang as Interpreter>::Env;

/// `(set name value)`. Similar to `define`, but can also be used to update
/// parent environments.
pub fn set(env: &Env, args: &[Expr]) -> Result<Value, Error> {
    if args.len() != 2 {
        return Err(format!("set! expected 2 arguments, got {}", args.len()).into());
    }
    if let Expr::Symbol(name) = &args[0] {
        let value = MiniLang::evaluate(env, &args[1])?;
        env.set(&name, value);
        Ok(Value::new(Nil))
    } else {
        return Err("set! requires a symbol".into());
    }
}

/// `(+ int int) -> int`
pub fn plus(a: &Int, b: &Int) -> Result<Int, Error> {
    Ok(Int(a.0 + b.0))
}

/// `(- int int) -> int`
pub fn minus(a: &Int, b: &Int) -> Result<Int, Error> {
    Ok(Int(a.0 - b.0))
}

/// `(* int int) -> int`
pub fn multi(a: &Int, b: &Int) -> Result<Int, Error> {
    Ok(Int(a.0 * b.0))
}

/// `(/ int int) -> int`
pub fn div(a: &Int, b: &Int) -> Result<Int, Error> {
    Ok(Int(a.0 / b.0))
}

/// `(< int int) -> bool`
pub fn le(a: &Int, b: &Int) -> Result<Bool, Error> {
    Ok(Bool(a.0 <= b.0))
}

/// `(> int int) -> bool`
pub fn ge(a: &Int, b: &Int) -> Result<Bool, Error> {
    Ok(Bool(a.0 >= b.0))
}

/// `(<= int int) -> bool`
pub fn lt(a: &Int, b: &Int) -> Result<Bool, Error> {
    Ok(Bool(a.0 < b.0))
}

/// `(>= int int) -> bool`
pub fn gt(a: &Int, b: &Int) -> Result<Bool, Error> {
    Ok(Bool(a.0 > b.0))
}

/// `(= int int) -> bool`
pub fn eq(a: &Int, b: &Int) -> Result<Bool, Error> {
    Ok(Bool(a.0 == b.0))
}

fn eq_internal(a: &Value, b: &Value) -> bool {
    if let (Some(a), Some(b)) = (a.downcast_ref::<Int>(), b.downcast_ref::<Int>()) {
        a.0 == b.0
    } else if let (Some(a), Some(b)) = (a.downcast_ref::<Bool>(), b.downcast_ref::<Bool>()) {
        a.0 == b.0
    } else if let (Some(a), Some(b)) = (a.downcast_ref::<Str>(), b.downcast_ref::<Str>()) {
        a.0 == b.0
    } else if let (Some(a), Some(b)) = (a.downcast_ref::<List>(), b.downcast_ref::<List>()) {
        a.0.len() == b.0.len() && a.0.iter().zip(b.0.iter()).all(|(a, b)| eq_internal(a, b))
    } else {
        a as *const Value == b as *const Value
    }
}

/// `(equal? value value) -> bool`
pub fn equal(env: &Env, args: &[Expr]) -> Result<Value, Error> {
    if args.len() != 2 {
        return Err(format!("equal?: expects 2 arguments, got {}", args.len()).into());
    }

    let a = MiniLang::evaluate(env, &args[0])?;
    let b = MiniLang::evaluate(env, &args[0])?;

    Ok(Value::new(Bool(eq_internal(&a, &b))))
}

/// `(if bool value value)` -> value`
fn r#if(env: &Env, args: &[Expr]) -> Result<Value, Error> {
    if args.len() != 3 {
        return Err(format!("if: expects 3 arguments, got {}", args.len()).into());
    }

    let cond = MiniLang::evaluate(env, &args[0])?;
    if let Some(cond) = cond.downcast_ref::<Bool>() {
        if cond.0 {
            MiniLang::evaluate(env, &args[1])
        } else {
            MiniLang::evaluate(env, &args[2])
        }
    } else {
        return Err(format!("if: {} is not a bool", &cond).into());
    }
}

/// `(while bool value)` -> value | nil`
pub fn r#while(env: &Env, args: &[Expr]) -> Result<Value, Error> {
    if args.len() != 2 {
        return Err(format!("while: expects 2 arguments, got {}", args.len()).into());
    }
    let mut result: Option<Value> = None;

    loop {
        let cond = MiniLang::evaluate(env, &args[0])?;
        if let Some(cond) = cond.downcast_ref::<Bool>() {
            if cond.0 {
                result = Some(MiniLang::evaluate(env, &args[1])?);
            } else {
                break;
            }
        } else {
            return Err(format!("while: {} is not a bool", &cond).into());
        }
    }

    Ok(result.unwrap_or_else(|| Value::new(Nil)))
}

/// `(write value...)`
pub fn write(env: &Env, args: &[Expr]) -> Result<Value, Error> {
    for arg in args {
        let value = MiniLang::evaluate(env, arg)?;
        println!("{}", value);
    }
    Ok(Value::new(Nil))
}

/// `(dbg value...)`
pub fn dbg(env: &Env, args: &[Expr]) -> Result<Value, Error> {
    for arg in args {
        let value = MiniLang::evaluate(env, arg)?;
        eprintln!("{:?} = {:?}\n", arg, value);
    }
    Ok(Value::new(Nil))
}

/// `(define name value)`
///
/// `(define (f x) value)` is a syntactic sugar of `(define f (lambda (x) value))`.
pub fn define(env: &Env, args: &[Expr]) -> Result<Value, Error> {
    if args.len() != 2 {
        return Err(format!("define: expect 2 arguments, got {}", args.len()).into());
    }
    match &args[0] {
        Expr::Symbol(name) => {
            let value = MiniLang::evaluate(env, &args[1])?;
            env.set_local(&name, value);
            Ok(Value::new(Nil))
        }
        Expr::Compound(subargs) if !subargs.is_empty() => {
            // Syntax sugar: (define (f x) x) => (define f (lambda (x) x))
            if let Expr::Symbol(name) = &subargs[0] {
                let body = &args[1];
                let args = &subargs[1..];
                let value = Value::new(Procedure::new(env.clone(), args, body.clone())?);
                env.set_local(&name, value);
                Ok(Value::new(Nil))
            } else {
                Err(format!(
                    "define: requires a symbol for function name, not {:?})",
                    &subargs[0]
                )
                .into())
            }
        }
        _ => Err(format!(
            "define: requires a symbol or a non-empty list, not {:?}",
            &args[0]
        )
        .into()),
    }
}

/// Register stdlib functions to an environment.
pub fn register(env: &Env) {
    NativeProcedure::new("set!", set).register(env);

    let f = plus as fn(&Int, &Int) -> Result<Int, Error>;
    NativeProcedure::from(("+", f)).register(env);

    let f = minus as fn(&Int, &Int) -> Result<Int, Error>;
    NativeProcedure::from(("-", f)).register(env);

    let f = multi as fn(&Int, &Int) -> Result<Int, Error>;
    NativeProcedure::from(("*", f)).register(env);

    let f = div as fn(&Int, &Int) -> Result<Int, Error>;
    NativeProcedure::from(("/", f)).register(env);

    let f = le as fn(&Int, &Int) -> Result<Bool, Error>;
    NativeProcedure::from(("<=", f)).register(env);

    let f = ge as fn(&Int, &Int) -> Result<Bool, Error>;
    NativeProcedure::from((">=", f)).register(env);

    let f = lt as fn(&Int, &Int) -> Result<Bool, Error>;
    NativeProcedure::from(("<", f)).register(env);

    let f = gt as fn(&Int, &Int) -> Result<Bool, Error>;
    NativeProcedure::from((">", f)).register(env);

    let f = eq as fn(&Int, &Int) -> Result<Bool, Error>;
    NativeProcedure::from(("=", f)).register(env);

    NativeProcedure::new("equal?", equal).register(env);
    NativeProcedure::new("if", r#if).register(env);
    NativeProcedure::new("while", r#while).register(env);
    NativeProcedure::new("write", write).register(env);
    NativeProcedure::new("dbg", dbg).register(env);
    NativeProcedure::new("define", define).register(env);
}