litto 0.1.0

use super::types::NativeProcedure;
use super::types::Nil;
use super::TinyLang;
use crate::sexp;
use crate::value::AbstractValue;
use crate::Interpreter;
use gcmodule::Trace;
use std::cell::RefCell;
use std::fmt;
use std::rc::Rc;

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

#[test]
fn test_eval_downcast() {
    let x = Int(42);
    let (value, _) = eval(sexp!(((((λ (f) (λ (x) (f x))) (λ (a) a)) (λ (b) b)) {x})));
    let y = value.downcast_ref::<Int>().unwrap();
    assert_eq!(y.0, x.0);
}

// Code examples are modified from http://matt.might.net/articles/church-encodings-demo-in-scheme/.

#[test]
fn test_curry2() {
    let (_, out) = eval(sexp!((begin
        (define curry2 (λ (f) (λ (x) (λ (y) (f x y)))))
        (define f (lambda (x y) (+ x y)))
        (define f_C (curry2 f))

        (debug (f { Int(3) } { Int(4) }))
        (debug ((f_C { Int(5) }) { Int(6) }))

        (define plus_C (curry2 +))
        (debug (+ { Int(7) } { Int(8) }))
        (debug ((plus_C { Int(9) }) { Int(10) }))
    )));
    assert_eq!(
        out,
        r#"
        (f 3 4) = 7
        ((f_C 5) 6) = 11
        (+ 7 8) = 15
        ((plus_C 9) 10) = 19"#
    );
}

#[test]
fn test_booleans() {
    let (_, out) = eval(sexp!((begin
        // boolean = (-> A) (-> A) -> A
        (define true  (lambda (on_true on_false) (on_true)))
        (define false (lambda (on_true on_false) (on_false)))

        // if! : boolean A A -> A
        (define ["if!"] (lambda (condition true_value false_value)
                                (condition
                                    (lambda () true_value)
                                    (lambda () false_value))))

        (debug (["if!"] true {Int(1)} {Int(2)}))
        (debug (["if!"] false {Int(3)} {Int(4)}))

        // if* : boolean (-> A) (-> A) -> A
        (define ["if*"] (lambda (condition on_true on_false)
                                (condition on_true on_false)))

        (debug (["if*"] true (lambda () {Int(5)}) (lambda () {Int(6)})))
        (debug (["if*"] false (lambda () {Int(7)}) (lambda () {Int(8)})))
    )));

    assert_eq!(
        out,
        r#"
        (if! true 1 2) = 1
        (if! false 3 4) = 4
        (if* true (lambda () 5) (lambda () 6)) = 5
        (if* false (lambda () 7) (lambda () 8)) = 8"#
    );
}

#[test]
fn test_lists() {
    let (_, out) = eval(sexp!((begin
        (define true  {Int(1)})
        (define false {Int(0)})

        // nil : list[*]
        (define nil (lambda (on_null on_pair) (on_null)))

        // kons : A list[A] -> list[A]
        (define kons (lambda (a b)
                      (lambda (on_null on_pair)
                       (on_pair a b))))

        // kar : list[A] -> A
        (define kar (lambda (list)
                     (list (lambda () (error))
                      (lambda (a b) a))))

        // kdr : list[A] -> list[A]
        (define kdr (lambda (list)
                     (list (lambda () (error))
                      (lambda (a b) b))))

        // match-list : list[A] (-> B) (A list[A] -> B) -> B
        (define match_list (lambda (list on_null on_pair)
                            (list on_null on_pair)))

        // kons? : list[A] -> boolean
        (define ["kons?"] (lambda (list)
                           (list (lambda () false)
                            (lambda (a b) true))))

        // nil? : list[A] -> boolean
        (define ["nil?"] (lambda (list)
                          (list (lambda () true)
                           (lambda (a b) false))))

        (debug (kar (kdr (kons {Int(3)} (kons {Int(4)} nil)))))
        (debug (["nil?"] nil))
        (debug (["nil?"] (kons false nil)))
        (debug (["kons?"] nil))
        (debug (["kons?"] (kons false nil)))
        (debug (match_list (kons {Int(3)} {Int(4)})
                (lambda () void)
                (lambda (a b) a)))
    )));
    assert_eq!(
        out,
        r#"
        (kar (kdr (kons 3 (kons 4 nil)))) = 4
        (nil? nil) = 1
        (nil? (kons false nil)) = 0
        (kons? nil) = 0
        (kons? (kons false nil)) = 1
        (match_list (kons 3 4) (lambda () void) (lambda (a b) a)) = 3"#
    );
}

#[test]
fn test_integers() {
    let (_, out) = eval(sexp!((begin
        // Iterative Church numerals.
        // A Church numeral applies its first argument to its
        // second argument n times.
        // That is, n(f)(x) == f^n(x)

        // number = (A -> A) -> A -> A
        // zero : number
        (define zero (lambda (f)
                      (lambda (zero)
                       zero)))

        // succ : number -> number
        (define succ (lambda (n)
                      (lambda (f)
                       (lambda (zero)
                        ((n f) (f zero))))))

        // See https://en.wikipedia.org/wiki/Church_encoding#Derivation_of_predecessor_function
        (define pred (lambda (n)
                      (lambda (f)
                       (lambda (zero)
                        (((n (lambda (g) (lambda (h) (h (g f)))))
                          (lambda (u) zero))
                         (lambda (u) u))))))

        // returns m - n when m > n, otherwise 0
        (define sub (lambda (m n)
                     ((n pred) m)))

        (define iszero (lambda (n)
                        ((n (lambda (x) false)) true)))

        (define ["<="] (lambda (m n)
                        (iszero (sub n m))))

        // one : number
        (define one (succ zero))

        // two : number
        (define two (succ one))

        // add : number number -> number
        (define add (lambda (n m)
                     (lambda (f)
                      (lambda (zero)
                       ((n f) ((m f) zero))))))

        // mul : number number -> number
        (define mul (lambda (n m)
                     (lambda (f)
                      (lambda (zero)
                       ((m (n f)) zero)))))

        // inc_int : Int -> Int
        (define inc_int (lambda (z) (+ z {Int(1)})))

        // Convert from the internal int to a printable Int.
        (define to_int (lambda (n)
                        ((n inc_int) {Int(0)})))

        (define four (add two two))
        (define five (succ four))
        (debug (to_int four))
        (debug (to_int five))
        (debug (to_int (succ zero)))
        (debug (to_int (add four two)))
        (debug (to_int (pred (add five two))))
        (debug (to_int (mul two five)))
    )));
    assert_eq!(
        out,
        r#"
        (to_int four) = 4
        (to_int five) = 5
        (to_int (succ zero)) = 1
        (to_int (add four two)) = 6
        (to_int (pred (add five two))) = 6
        (to_int (mul two five)) = 10"#
    );
}

#[cfg(feature = "parse")]
#[test]
fn test_parse_recursion() {
    let parsed = TinyLang::parse(
        r#"
        ; Recursion.
        ; Recursion is enabled through the U combinator
        ; or the Y combinator.  The U combinator passes its
        ; argument to itself, while the Y combinator finds
        ; the fixed point of its functional argument.

        ; The U combinator passes its argument to itself,
        ; enabling self-reference.

        ; (U F) = (F F)
        ; U : untypeable
        (define U (λ (F) (F F)))

        ; The Y Combinator computes the fixed point of a functional:
        ;  (Y F) = (F (Y F))
        ;  Y = (λ (F) (F (Y F)))
        ;    = (λ (F) (F (λ (x) ((Y F) x))))
        ;    = (U (λ (y) (λ (F) (F (λ (x) (((y y) F) x))))))
        ;    = ((λ (y) (λ (F) (F (λ (x) (((y y) F) x)))))
        ;       (λ (y) (λ (F) (F (λ (x) (((y y) F) x))))))

        ; Y : ((A -> B) -> (A -> B)) -> (A -> B)
        (define Y ((λ (y) (λ (F) (F (λ (x) (((y y) F) x)))))
                   (λ (y) (λ (F) (F (λ (x) (((y y) F) x)))))))
    "#,
    )
    .unwrap();
    assert_eq!(
        parsed.to_string(),
        concat!(
            "(begin (define U (λ (F) (F F))) ",
            "(define Y ((λ (y) (λ (F) (F (λ (x) (((y y) F) x))))) ",
            "(λ (y) (λ (F) (F (λ (x) (((y y) F) x))))))))",
        )
    );
}

// Types and utilities used by tests.

#[derive(Copy, Clone, Debug, Trace)]
struct Int(isize);

impl fmt::Display for Int {
    fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
        write!(f, "{}", self.0)
    }
}

impl Int {
    fn plus(a: &Int, b: &Int) -> Int {
        Int(a.0 + b.0)
    }
}

impl AbstractValue<TinyLang> for Int {}

#[derive(Trace, Debug, Default, Clone)]
struct DebugPrint(Rc<RefCell<String>>);

impl fmt::Display for DebugPrint {
    fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
        self.0.borrow().fmt(f)
    }
}

impl AbstractValue<TinyLang> for DebugPrint {
    fn apply(&self, env: &Env, args: &[Expr]) -> Result<Value, Error> {
        let mut out = self.0.borrow_mut();
        for arg in args {
            out.push_str("\n        ");
            out.push_str(&format!("{} = ", arg));
            let value = TinyLang::evaluate(env, arg)?;
            out.push_str(&format!("{}", value));
        }
        Ok(Value::new(Nil))
    }
}

fn eval(expr: Expr) -> (Value, String) {
    let env = TinyLang::global_env();
    let out = DebugPrint::default();
    let plus = Int::plus as fn(&Int, &Int) -> Int;
    env.set("+", Value::new(NativeProcedure::from(("+", plus))));
    env.set("debug", Value::new(out.clone()));
    let value = TinyLang::evaluate(&env, &expr).unwrap();
    (value, out.to_string())
}