grift_eval 1.4.0

//! Tests from "Syntactic Extension" (Chapter 8, The Scheme Programming Language)
//!
//! These tests verify code samples from the Syntactic Extension HTML reference.
//! Each test is annotated with the corresponding section and example from the text.

mod common;

use grift_eval::*;
use common::{eval_to_string, eval_to_num, eval_is_true};

// ═══════════════════════════════════════════════════════════════════════════
// Section 8.1: Keyword Bindings
// ═══════════════════════════════════════════════════════════════════════════

/// Section 8.1: define-syntax with syntax-rules to define let*
/// The HTML example defines let* from scratch using syntax-rules.
/// We use my-let* to avoid conflicting with the built-in let*.
#[test]
fn test_sec8_1_define_let_star() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    eval.eval_str(r#"
        (define-syntax my-let*
          (syntax-rules ()
            ((_ () e1 e2 ...) (let () e1 e2 ...))
            ((_ ((i1 v1) (i2 v2) ...) e1 e2 ...)
             (let ((i1 v1))
               (my-let* ((i2 v2) ...) e1 e2 ...)))))
    "#).unwrap();

    assert_eq!(eval_to_num(&lisp, &mut eval, "(my-let* ((a 1) (b (+ a 1))) (+ a b))"), 3);
}

/// Section 8.1: define and define-syntax interleaved in a let body
/// even? is defined as a procedure, odd? as a macro, and they are mutually visible.
#[test]
fn test_sec8_1_even_odd_interleaved() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    assert!(eval_is_true(&lisp, &mut eval, r#"
        (let ()
          (define even?
            (lambda (x)
              (or (= x 0) (odd? (- x 1)))))
          (define-syntax odd?
            (syntax-rules ()
              ((_ x) (not (even? x)))))
          (even? 10))
    "#));
}

/// Section 8.1: bind-to-zero macro that expands to a define form
#[test]
fn test_sec8_1_bind_to_zero() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    assert_eq!(eval_to_num(&lisp, &mut eval, r#"
        (let ()
          (define-syntax bind-to-zero
            (syntax-rules ()
              ((_ id) (define id 0))))
          (bind-to-zero x)
          x)
    "#), 0);
}

/// Section 8.1: let-syntax with nested let-syntax
/// The inner let-syntax rebinds f, but g still refers to the outer f.
#[test]
fn test_sec8_1_nested_let_syntax() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    assert_eq!(eval_to_num(&lisp, &mut eval, r#"
        (let ((f (lambda (x) (+ x 1))))
          (let-syntax ((g (syntax-rules ()
                            ((_ x) (f x)))))
            (let-syntax ((f (syntax-rules ()
                              ((_ x) x))))
              (g 1))))
    "#), 2);
}

// ═══════════════════════════════════════════════════════════════════════════
// Section 8.2: Syntax-Rules
// ═══════════════════════════════════════════════════════════════════════════

/// Section 8.2: or defined with syntax-rules
#[test]
fn test_sec8_2_or_syntax_rules() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    eval.eval_str(r#"
        (define-syntax my-or
          (syntax-rules ()
            ((_) #f)
            ((_ e) e)
            ((_ e1 e2 e3 ...)
             (let ((t e1)) (if t t (my-or e2 e3 ...))))))
    "#).unwrap();

    assert_eq!(eval_to_num(&lisp, &mut eval, "(my-or #f #f 42)"), 42);
    assert_eq!(eval_to_string(&lisp, &mut eval, "(my-or #f)"), "#f");
    assert_eq!(eval_to_num(&lisp, &mut eval, "(my-or 1 2)"), 1);
}

/// Section 8.2: Lambda expansion equivalent showing how or desugars
#[test]
fn test_sec8_2_or_desugared() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    assert_eq!(eval_to_string(&lisp, &mut eval, r#"
        ((lambda (if1)
           ((lambda (t1)
              ((lambda (t2)
                 (if t2 t2 t1))
               if1))
            'okay))
         #f)
    "#), "okay");
}

/// Section 8.2: cond defined with syntax-rules
#[test]
fn test_sec8_2_cond_syntax_rules() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    eval.eval_str(r#"
        (define-syntax my-cond
          (syntax-rules (else)
            ((_ (else e1 e2 ...)) (begin e1 e2 ...))
            ((_ (e0 e1 e2 ...)) (if e0 (begin e1 e2 ...)))
            ((_ (e0 e1 e2 ...) c1 c2 ...)
             (if e0 (begin e1 e2 ...) (my-cond c1 c2 ...)))))
    "#).unwrap();

    assert_eq!(eval_to_num(&lisp, &mut eval, "(my-cond (#f 1) (else 2))"), 2);
    assert_eq!(eval_to_num(&lisp, &mut eval, "(my-cond (#t 1) (else 2))"), 1);
    assert_eq!(eval_to_num(&lisp, &mut eval, "(my-cond (#f 1) (#f 2) (else 3))"), 3);
}

// ═══════════════════════════════════════════════════════════════════════════
// Section 8.3: Syntax-Case
// ═══════════════════════════════════════════════════════════════════════════

/// Section 8.3: or defined with syntax-case
#[test]
fn test_sec8_3_or_syntax_case() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    eval.eval_str(r#"
        (define-syntax my-or2
          (lambda (x)
            (syntax-case x ()
              ((_) (syntax #f))
              ((_ e) (syntax e))
              ((_ e1 e2 e3 ...)
               (syntax (let ((t e1)) (if t t (my-or2 e2 e3 ...))))))))
    "#).unwrap();

    assert_eq!(eval_to_num(&lisp, &mut eval, "(my-or2 #f #f 99)"), 99);
    assert_eq!(eval_to_string(&lisp, &mut eval, "(my-or2 #f)"), "#f");
    assert_eq!(eval_to_num(&lisp, &mut eval, "(my-or2 1)"), 1);
}

/// Section 8.3: with-syntax for binding pattern variables
#[test]
fn test_sec8_3_with_syntax() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    assert_eq!(eval_to_string(&lisp, &mut eval, r#"
        (with-syntax ((a (syntax 1))
                      (b (syntax 2)))
          (list a b))
    "#), "(1 2)");
}

// ═══════════════════════════════════════════════════════════════════════════
// Section 8.4: Examples - rec and named let
// ═══════════════════════════════════════════════════════════════════════════

/// Section 8.4: rec macro for self-referencing definitions
#[test]
fn test_sec8_4_rec() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    eval.eval_str(r#"
        (define-syntax rec
          (syntax-rules ()
            ((_ x e) (letrec ((x e)) x))))
    "#).unwrap();

    assert_eq!(eval_to_string(&lisp, &mut eval, r#"
        (map (rec sum
               (lambda (x)
                 (if (= x 0)
                     0
                     (+ x (sum (- x 1))))))
             '(0 1 2 3 4 5))
    "#), "(0 1 3 6 10 15)");
}

/// Section 8.4: letrec defined with syntax-case (simplified, without generate-temporaries)
#[test]
fn test_sec8_4_letrec_via_syntax_case() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    eval.eval_str(r#"
        (define-syntax my-letrec
          (lambda (x)
            (syntax-case x ()
              ((_ ((i v) ...) e1 e2 ...)
               (syntax (let ((i #f) ...)
                         (set! i v) ...
                         (let () e1 e2 ...)))))))
    "#).unwrap();

    assert!(eval_is_true(&lisp, &mut eval, r#"
        (my-letrec ((even? (lambda (n) (if (= n 0) #t (odd? (- n 1)))))
                    (odd? (lambda (n) (if (= n 0) #f (even? (- n 1))))))
          (even? 10))
    "#));
}

/// Section 8.4: sequence defined with syntax-rules
#[test]
fn test_sec8_4_sequence() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    eval.eval_str(r#"
        (define-syntax sequence
          (syntax-rules ()
            ((_ e0 e1 ...)
             (begin e0 e1 ...))))
    "#).unwrap();

    assert_eq!(eval_to_num(&lisp, &mut eval, "(sequence 1 2 42)"), 42);
}

/// Section 8.4: be-like-begin using escaping ellipsis (... ...)
/// This tests the ability to produce literal ... in macro output.
#[test]
fn test_sec8_4_be_like_begin_escaping_ellipsis() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    eval.eval_str(r#"
        (define-syntax be-like-begin
          (syntax-rules ()
            ((_ name)
             (define-syntax name
               (syntax-rules ()
                 ((_ e0 e1 (... ...))
                  (begin e0 e1 (... ...))))))))
    "#).unwrap();

    eval.eval_str("(be-like-begin sequence2)").unwrap();

    assert_eq!(eval_to_num(&lisp, &mut eval, "(sequence2 1 2 3)"), 3);
}

/// Section 8.4: if macro that wraps the built-in if (recursive macro reference)
/// When called with 3 args it works, but with 2 args it should error.
#[test]
fn test_sec8_4_if_macro_error_on_wrong_arity() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    // (if 1 2) with the wrapping macro should error because the macro
    // only matches 3-argument form
    let result = eval.eval_str(r#"
        (let-syntax ((if (lambda (x)
                           (syntax-case x ()
                             ((_ e1 e2 e3)
                              (syntax (if e1 e2 e3)))))))
          (if 1 2))
    "#);
    assert!(result.is_err());
}

/// Section 8.3: divide - demonstrates that Scheme variables bound in
/// transformer code don't affect syntax templates
#[test]
fn test_sec8_3_divide_template_hygiene() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    // The / in the syntax template refers to the / at the macro use site,
    // not the / rebound to + in the transformer body
    let result = eval_to_num(&lisp, &mut eval, r#"
        (let-syntax ((divide (lambda (x)
                               (let ((/ +))
                                 (syntax-case x ()
                                   ((_ e1 e2)
                                    (syntax (/ e1 e2))))))))
          (let ((/ *)) (divide 2 1)))
    "#);
    // The / in the template resolves to the / at the use site.
    // At the use site, / is bound to * by (let ((/ *)) ...).
    // So (divide 2 1) => (/ 2 1) => (* 2 1) => 2
    // Note: the (let ((/ +)) ...) in the transformer body doesn't affect
    // the syntax template because syntax templates capture use-site bindings.
    assert_eq!(result, 2);
}

// ═══════════════════════════════════════════════════════════════════════════
// Section 8.1: letrec-syntax
// ═══════════════════════════════════════════════════════════════════════════

/// Section 8.1: letrec-syntax allows mutually recursive macro definitions
#[test]
fn test_sec8_1_letrec_syntax_basic() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    // letrec-syntax: g can see f's binding (mutual visibility)
    let result = eval.eval_str(r#"
        (let ((f (lambda (x) (+ x 1))))
          (letrec-syntax ((f (syntax-rules ()
                               ((_ x) x)))
                          (g (syntax-rules ()
                               ((_ x) (f x)))))
            (list (f 1) (g 1))))
    "#);
    // letrec-syntax: both f and g see the macro bindings
    // f is a macro returning x as-is, g calls f (which is the macro)
    assert!(result.is_ok());
}

/// Section 8.4: dolet hygiene example
/// Tests that macro-introduced bindings don't conflict with user bindings.
#[test]
fn test_sec8_3_dolet_hygiene() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    let result = eval_to_num(&lisp, &mut eval, r#"
        (let-syntax ((dolet (lambda (x)
                              (syntax-case x ()
                                ((_ b)
                                 (syntax (let ((a 3) (b 4))
                                           (+ a b))))))))
          (dolet a))
    "#);
    // Per the Dybvig book (Section 8.3), this returns 7 due to hygiene:
    // the 'a' in the template (let ((a 3) (b 4)) ...) is macro-introduced and
    // gets renamed so it doesn't capture the argument 'a' passed by the user.
    // Result: (let ((a_gensym 3) (a 4)) (+ a_gensym a)) = 3 + 4 = 7.
    assert_eq!(result, 7);
}

// ═══════════════════════════════════════════════════════════════════════════
// Additional tests from other sections
// ═══════════════════════════════════════════════════════════════════════════

/// Test that the built-in or works correctly (verification of the macro implementation)
#[test]
fn test_builtin_or_basic() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    assert_eq!(eval_to_string(&lisp, &mut eval, "(or #f #f)"), "#f");
    assert_eq!(eval_to_num(&lisp, &mut eval, "(or #f 42)"), 42);
    assert_eq!(eval_to_num(&lisp, &mut eval, "(or 1 2)"), 1);
}

/// Test that the built-in cond works correctly
#[test]
fn test_builtin_cond_basic() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    assert_eq!(eval_to_num(&lisp, &mut eval, "(cond (#t 1) (else 2))"), 1);
    assert_eq!(eval_to_num(&lisp, &mut eval, "(cond (#f 1) (else 2))"), 2);
    assert_eq!(eval_to_num(&lisp, &mut eval, "(cond (#f 1) (#t 2) (else 3))"), 2);
}

/// Section 8.2: syntax-rules can be defined using syntax-case (meta-definition)
/// This verifies the core syntax-rules implementation in macros.scm
#[test]
fn test_sec8_2_syntax_rules_is_macro() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    // Define a simple macro using syntax-rules (which itself is a macro)
    eval.eval_str(r#"
        (define-syntax triple
          (syntax-rules ()
            ((_ x) (* x 3))))
    "#).unwrap();

    assert_eq!(eval_to_num(&lisp, &mut eval, "(triple 5)"), 15);
    assert_eq!(eval_to_num(&lisp, &mut eval, "(triple (+ 1 2))"), 9);
}

/// Test set! with ellipsis in syntax-case templates
#[test]
fn test_set_ellipsis_in_template() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    eval.eval_str(r#"
        (define-syntax set-all!
          (lambda (x)
            (syntax-case x ()
              ((_ (var ...) (val ...))
               (syntax (begin (set! var val) ...))))))
    "#).unwrap();

    assert_eq!(eval_to_string(&lisp, &mut eval, r#"
        (let ((a 0) (b 0) (c 0))
          (set-all! (a b c) (1 2 3))
          (list a b c))
    "#), "(1 2 3)");
}

/// Test let with ellipsis in syntax-case templates
#[test]
fn test_let_ellipsis_in_template() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    eval.eval_str(r#"
        (define-syntax my-let-init
          (lambda (x)
            (syntax-case x ()
              ((_ (var ...) e1 e2 ...)
               (syntax (let ((var #f) ...) e1 e2 ...))))))
    "#).unwrap();

    assert_eq!(eval_to_string(&lisp, &mut eval, r#"
        (my-let-init (a b c) (list a b c))
    "#), "(#f #f #f)");
}

/// Test generate-temporaries
#[test]
fn test_generate_temporaries() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    // generate-temporaries should return a list of fresh syntax objects
    let result = eval.eval_str("(length (generate-temporaries '(a b c)))").unwrap();
    assert_eq!(lisp.get(result).unwrap().as_number(), Some(3));
}

/// Test that letrec-syntax is recognized as a special form
#[test]
fn test_letrec_syntax_recognized() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    // Simple letrec-syntax that just defines a constant macro
    assert_eq!(eval_to_num(&lisp, &mut eval, r#"
        (letrec-syntax ((const42 (syntax-rules ()
                                   ((_) 42))))
          (const42))
    "#), 42);
}

/// Test letrec-syntax with self-referencing macro
#[test]
fn test_letrec_syntax_self_reference() {
    let lisp: Lisp<30000> = Lisp::new();
    let mut eval = Evaluator::new(&lisp).unwrap();

    // A macro that counts down using recursive self-reference
    assert_eq!(eval_to_num(&lisp, &mut eval, r#"
        (letrec-syntax ((my-begin
                          (syntax-rules ()
                            ((_ e) e)
                            ((_ e1 e2 ...)
                             (let ((t e1)) (my-begin e2 ...))))))
          (my-begin 1 2 42))
    "#), 42);
}