tests/testthat/test-compiler-optimizations.R

In arl: Embedded Lisp Dialect

# Compiler Optimization Verification Tests
#
# These tests verify that compiler optimizations actually fire by checking
# properties of the compiled output, not just semantic correctness.
#
# Philosophy: We check properties (e.g., "is not an if statement") rather than
# exact output, making tests resilient to optimization strategy changes while
# still ensuring optimizations are applied.

engine <- Engine$new(load_prelude = FALSE)

# ==============================================================================
# Constant Folding Verification
# ==============================================================================

thin <- make_cran_thinner()

test_that("VERIFY: constant folding produces literals", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # Simple arithmetic should fold to literal
  out <- engine$inspect_compilation("(+ 1 2)")
  expect_true(is.numeric(out$compiled))
  expect_equal(out$compiled, 3)

  # Nested arithmetic should fold to literal
  out <- engine$inspect_compilation("(+ (* 2 3) (* 4 5))")
  expect_true(is.numeric(out$compiled))
  expect_equal(out$compiled, 26)

  # Comparison should fold to literal boolean
  out <- engine$inspect_compilation("(< 1 2)")
  expect_true(is.logical(out$compiled))
  expect_equal(out$compiled, TRUE)

  # Math functions should fold
  out <- engine$inspect_compilation("(sqrt 16)")
  expect_true(is.numeric(out$compiled))
  expect_equal(out$compiled, 4)
})

test_that("VERIFY: constant folding does NOT fold non-constants", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # Variable expressions should NOT fold
  out <- engine$inspect_compilation("(+ x 1)")
  expect_true(is.call(out$compiled))  # Should still be a call

  # Partial folding should work
  out <- engine$inspect_compilation("(+ x (* 2 3))")
  expect_true(is.call(out$compiled))
  # But (* 2 3) part should be folded to 6 in the args
})

# ==============================================================================
# Truthiness Optimization Verification
# ==============================================================================

test_that("VERIFY: truthiness optimization skips wrapper for known booleans", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # Literal TRUE should not have .__true_p wrapper
  out <- engine$inspect_compilation("(if #t 1 2)")
  compiled_str <- paste(out$compiled_deparsed, collapse = " ")
  expect_false(grepl(".__true_p", compiled_str))

  # Comparison should not have wrapper
  out <- engine$inspect_compilation("(if (> x 5) 1 2)")
  compiled_str <- paste(out$compiled_deparsed, collapse = " ")
  expect_false(grepl(".__true_p.*>", compiled_str))

  # Variable SHOULD have wrapper
  out <- engine$inspect_compilation("(if x 1 2)")
  compiled_str <- paste(out$compiled_deparsed, collapse = " ")
  expect_true(grepl(".__true_p", compiled_str))
})

# ==============================================================================
# Dead Code Elimination Verification
# ==============================================================================

test_that("VERIFY: dead code elimination removes unreachable branches", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # (if #t a b) should be just a, not an if statement
  out <- engine$inspect_compilation("(if #t 1 2)")
  expect_false(is.call(out$compiled) && identical(out$compiled[[1]], quote(`if`)))
  expect_equal(out$compiled, 1)

  # (if #f a b) should be just b
  out <- engine$inspect_compilation("(if #f 1 2)")
  expect_false(is.call(out$compiled) && identical(out$compiled[[1]], quote(`if`)))
  expect_equal(out$compiled, 2)

  # Constant-folded condition should also eliminate
  out <- engine$inspect_compilation("(if (< 1 2) 100 200)")
  expect_false(is.call(out$compiled) && identical(out$compiled[[1]], quote(`if`)))
  expect_equal(out$compiled, 100)

  # Variable condition should NOT eliminate
  out <- engine$inspect_compilation("(if x 1 2)")
  expect_true(is.call(out$compiled) && identical(out$compiled[[1]], quote(`if`)))
})

# ==============================================================================
# Begin Simplification Verification
# ==============================================================================

test_that("VERIFY: begin simplification removes single-expression blocks", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # (begin x) should be just x, not a block
  out <- engine$inspect_compilation("(begin 1)")
  expect_false(is.call(out$compiled) && identical(out$compiled[[1]], quote(`{`)))
  expect_equal(out$compiled, 1)

  # (begin (+ 1 2)) should fold and simplify to just 3
  out <- engine$inspect_compilation("(begin (+ 1 2))")
  expect_false(is.call(out$compiled) && identical(out$compiled[[1]], quote(`{`)))
  expect_equal(out$compiled, 3)

  # Multiple expressions should keep block
  out <- engine$inspect_compilation("(begin 1 2 3)")
  expect_true(is.call(out$compiled) && identical(out$compiled[[1]], quote(`{`)))
})

# ==============================================================================
# Identity Elimination Verification
# ==============================================================================

test_that("VERIFY: identity elimination inlines identity lambdas", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # ((lambda (x) x) 42) should be just 42, not a function application
  out <- engine$inspect_compilation("((lambda (x) x) 42)")
  # Check it's NOT a function application (which has as.function in the operator)
  is_funcall <- is.call(out$compiled) && is.call(out$compiled[[1]]) &&
                length(out$compiled[[1]]) > 0 &&
                identical(out$compiled[[1]][[1]], quote(as.function))
  expect_false(is_funcall, info = "Should not be a function application")
  expect_equal(out$compiled, 42)

  # ((lambda (a b) a) 10 20) should be just 10
  out <- engine$inspect_compilation("((lambda (a b) a) 10 20)")
  is_funcall <- is.call(out$compiled) && is.call(out$compiled[[1]]) &&
                length(out$compiled[[1]]) > 0 &&
                identical(out$compiled[[1]][[1]], quote(as.function))
  expect_false(is_funcall)
  expect_equal(out$compiled, 10)

  # Non-identity lambda should still be a function application
  out <- engine$inspect_compilation("((lambda (x) (+ x 1)) 5)")
  is_funcall <- is.call(out$compiled) && is.call(out$compiled[[1]]) &&
                length(out$compiled[[1]]) > 0 &&
                identical(out$compiled[[1]][[1]], quote(as.function))
  expect_true(is_funcall, info = "Non-identity lambda should remain as function call")

  # With constant-folded argument
  out <- engine$inspect_compilation("((lambda (x) x) (+ 1 2))")
  is_funcall <- is.call(out$compiled) && is.call(out$compiled[[1]]) &&
                length(out$compiled[[1]]) > 0 &&
                identical(out$compiled[[1]][[1]], quote(as.function))
  expect_false(is_funcall)
  expect_equal(out$compiled, 3)  # Both optimizations apply!
})

# ==============================================================================
# Optimization Composition Verification
# ==============================================================================

test_that("VERIFY: optimizations compose correctly", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # Constant folding + dead code elimination
  out <- engine$inspect_compilation("(if (< 1 2) (+ 2 3) (+ 4 5))")
  expect_equal(out$compiled, 5)  # Folds (< 1 2) to TRUE, eliminates else, folds (+ 2 3)

  # Constant folding + begin simplification
  out <- engine$inspect_compilation("(begin (+ 1 2))")
  expect_equal(out$compiled, 3)  # Folds and simplifies

  # Identity elimination + constant folding
  out <- engine$inspect_compilation("((lambda (x) x) (+ 1 2))")
  expect_equal(out$compiled, 3)  # Folds argument and eliminates lambda

  # All together: begin + if + constant folding + dead code elimination
  out <- engine$inspect_compilation("(begin (if (< 1 2) (+ 10 20) (+ 30 40)))")
  expect_equal(out$compiled, 30)  # Everything optimizes away to just 30
})

# ==============================================================================
# Boolean Operator Optimization Verification (Phase 2)
# ==============================================================================

test_that("VERIFY: and/or skip temps for simple values", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # Simple literals should NOT generate temporary variables
  out <- engine$inspect_compilation("(and 1 2 3)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  # Should not have assignment to temp for literal 1
  expect_false(grepl("tmp.*<-.*1[^0-9]", compiled_str, perl = TRUE),
    info = "Literal 1 should not be assigned to temp")

  # Symbols should NOT generate temporary variables
  out <- engine$inspect_compilation("(and x y z)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  # Should not have assignment like: tmp <- x
  expect_false(grepl("tmp.*<-.*x[^a-zA-Z]", compiled_str, perl = TRUE),
    info = "Symbol x should not be assigned to temp")

  # Complex expressions SHOULD still get temps (to avoid double evaluation)
  out <- engine$inspect_compilation("(and (+ a 1) (+ b 2))")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  # Should have at least one temp assignment for complex expression
  expect_true(grepl("<-", compiled_str),
    info = "Complex expressions should still use temps")
})

test_that("VERIFY: nested boolean chains flatten", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # Nested AND should flatten: (and (and a b) c) behaves like (and a b c)
  # We check by verifying similar structure/depth
  nested <- engine$inspect_compilation("(and (and a b) c)")
  flat <- engine$inspect_compilation("(and a b c)")

  # Both should short-circuit correctly and have similar complexity
  # We can't check exact equality due to different compilation paths,
  # but we can verify both work correctly
  expect_true(is.language(nested$compiled))
  expect_true(is.language(flat$compiled))

  # Nested OR should flatten similarly
  nested_or <- engine$inspect_compilation("(or (or a b) c)")
  flat_or <- engine$inspect_compilation("(or a b c)")

  expect_true(is.language(nested_or$compiled))
  expect_true(is.language(flat_or$compiled))

  # Mixed operators should NOT flatten
  mixed <- engine$inspect_compilation("(and (or a b) c)")
  # This should remain nested (can't flatten different operators)
  expect_true(is.language(mixed$compiled))
})

# ==============================================================================
# Quasiquote Simplification Verification (Phase 3)
# ==============================================================================

test_that("VERIFY: quasiquote with no unquotes simplifies", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # Pure quoted template (no unquotes) should be simple
  out <- engine$inspect_compilation("`(a b c)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")

  # Should be much simpler than the current 4-level nesting
  # Check that it doesn't have excessive as.call nesting
  as_call_count <- length(gregexpr("as\\.call", compiled_str)[[1]])
  expect_true(as_call_count <= 2,
    info = sprintf("Expected <=2 as.call, got %d", as_call_count))

  # Simple symbols should be very simple
  out <- engine$inspect_compilation("`x")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  expect_true(nchar(compiled_str) < 50,
    info = "Simple quasiquote should generate short code")
})

test_that("VERIFY: quasiquote with unquotes preserves correctness", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # With unquotes, correctness is paramount
  # These tests verify behavior, not optimization
  engine$eval(engine$read("(define x 42)")[[1]])

  result <- engine$eval(engine$read("`(a ,x c)")[[1]])
  # Result is a call object
  expect_true(is.call(result))
  expect_equal(result[[2]], 42)  # Middle element should be unquoted value

  # Nested quasiquote
  result <- engine$eval(engine$read("`(a `(b ,x) c)")[[1]])
  expect_true(is.call(result))
})

test_that("VERIFY: quasiquote code complexity reduction", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # Measure complexity of compiled quasiquote
  simple_qq <- engine$inspect_compilation("`(a b c)")
  with_unquote <- engine$inspect_compilation("`(a ,x c)")

  # Simple case should be simpler than unquote case
  simple_len <- length(deparse(simple_qq$compiled))
  unquote_len <- length(deparse(with_unquote$compiled))

  # Simple should be notably smaller (this will fail before optimization)
  expect_true(simple_len < unquote_len * 0.7,
    info = sprintf("Simple (%d lines) should be <70%% of unquote (%d lines)",
                   simple_len, unquote_len))
})

# ==============================================================================
# Strength Reduction Verification (Phase 3)
# ==============================================================================

test_that("VERIFY: multiplication by 2 reduces to addition", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # (* x 2) should become (+ x x)
  out <- engine$inspect_compilation("(* x 2)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")

  # Should have + instead of *
  expect_true(grepl("\\+", compiled_str),
    info = "Should use addition")
  expect_false(grepl("\\*", compiled_str),
    info = "Should not use multiplication")
})

test_that("VERIFY: power of 2 reduces to multiplication", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # (^ x 2) should become (* x x)
  out <- engine$inspect_compilation("(^ x 2)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")

  # Should have * instead of ^
  expect_true(grepl("\\*", compiled_str),
    info = "Should use multiplication")
  expect_false(grepl("\\^", compiled_str),
    info = "Should not use exponentiation")
})

test_that("VERIFY: strength reduction preserves semantics", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # Test that optimized code produces same results
  engine$eval(engine$read("(define x 5)")[[1]])

  # (* x 2) should still equal 10
  result1 <- engine$eval(engine$read("(* x 2)")[[1]])
  expect_equal(result1, 10)

  # (^ x 2) should still equal 25
  result2 <- engine$eval(engine$read("(^ x 2)")[[1]])
  expect_equal(result2, 25)
})

test_that("VERIFY: strength reduction only applies to safe cases", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # (* x 3) should NOT reduce (not power of 2)
  out <- engine$inspect_compilation("(* x 3)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  expect_true(grepl("\\*", compiled_str),
    info = "Multiplication by 3 should not reduce")

  # (^ x 3) should NOT reduce (not power of 2)
  out <- engine$inspect_compilation("(^ x 3)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  expect_true(grepl("\\^", compiled_str),
    info = "Power of 3 should not reduce")
})

test_that("VERIFY: strength reduction does not duplicate side-effectful expressions", {
  thin()
  engine <- Engine$new(load_prelude = TRUE)

  # (* (begin (set! x (+ x 1)) x) 2) should NOT be reduced to addition,
  # because the expression has side effects that would execute twice
  engine$eval_text("(define x 0)")
  out <- engine$inspect_compilation("(* (begin (set! x (+ x 1)) x) 2)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  # Should still use multiplication (not reduced)
  expect_true(grepl("\\*", compiled_str),
    info = "Side-effectful expression should not be strength-reduced")

  # But (* x 2) with a simple symbol should still reduce
  out <- engine$inspect_compilation("(* x 2)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  expect_true(grepl("\\+", compiled_str),
    info = "Simple symbol should still be strength-reduced")

  # (* (f x) 2) with a function call should NOT reduce
  out <- engine$inspect_compilation("(* (f x) 2)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  expect_true(grepl("\\*", compiled_str),
    info = "Function call should not be strength-reduced")

  # (^ (f x) 2) with a function call should NOT reduce
  out <- engine$inspect_compilation("(^ (f x) 2)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  expect_true(grepl("\\^", compiled_str),
    info = "Function call in exponent base should not be strength-reduced")

  # Semantic correctness: side effects should execute exactly once
  engine$eval_text("(define counter 0)")
  engine$eval_text("(define bump (lambda () (set! counter (+ counter 1)) counter))")
  result <- engine$eval_text("(* (bump) 2)")
  expect_equal(result, 2)  # bump returns 1, * 2 = 2
  expect_equal(engine$eval_text("counter"), 1)  # bump called exactly once
})

# ==============================================================================
# Nesting Depth Restoration Verification
# ==============================================================================

test_that("VERIFY: nesting_depth is restored after compilation errors in define", {
  thin()
  # The observable effect of corrupted nesting_depth is that top-level import
  # compilation would fail (compile_import checks nesting_depth > 0).
  # We test that after a failed define, subsequent compilations still work.
  engine <- Engine$new(load_prelude = FALSE)

  # Compile a valid top-level define
  engine$eval_text("(define x 1)")

  # Attempt to compile a define with an invalid value expression.
  # This should fail gracefully without corrupting compiler state.
  tryCatch(
    engine$eval_text("(define y (undefined-special-form z))"),
    error = function(e) NULL
  )

  # If nesting_depth was corrupted, this define would behave unexpectedly
  # because the compiler would think we're inside a nested scope
  expect_no_error(engine$eval_text("(define z 3)"))
  expect_equal(engine$eval_text("z"), 3)
})

test_that("VERIFY: nesting_depth is restored after compilation errors in set!", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)
  engine$eval_text("(define x 1)")

  # Attempt set! with an invalid value
  tryCatch(
    engine$eval_text("(set! x (undefined-special-form z))"),
    error = function(e) NULL
  )

  # Subsequent define should still work at top level
  expect_no_error(engine$eval_text("(define y 2)"))
  expect_equal(engine$eval_text("y"), 2)
})

# ==============================================================================
# Boolean Flatten Edge Cases
# ==============================================================================

test_that("VERIFY: and/or handle degenerate nested empty forms", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)

  # (and) with no args should return #t (identity for and)
  result <- engine$eval_text("(and)")
  expect_true(result)

  # (or) with no args should return #f (identity for or)
  result <- engine$eval_text("(or)")
  expect_false(result)

  # Single-arg forms should work
  result <- engine$eval_text("(and 42)")
  expect_equal(result, 42)
  result <- engine$eval_text("(or 42)")
  expect_equal(result, 42)
})

# ==============================================================================
# No-Folding Mode: Builtins Match R Semantics Without Constant Folding
# ==============================================================================
#
# Constant folding evaluates pure expressions at compile time using base R.
# When folding is disabled, the same expressions run through Arl's builtin
# wrappers at runtime. These tests verify that builtins produce the same
# results as base R, catching divergences like the NaN == NaN bug where
# variadic_eq returned FALSE instead of NA.

test_that("disable_constant_folding parameter works", {
  thin()
  e_fold <- Engine$new(load_prelude = FALSE)
  e_nofold <- Engine$new(load_prelude = FALSE, disable_constant_folding = TRUE)

  # With folding, (+ 1 2) should be a literal

  out_fold <- e_fold$inspect_compilation("(+ 1 2)")
  expect_true(is.numeric(out_fold$compiled))

  # Without folding, (+ 1 2) should remain a call
  out_nofold <- e_nofold$inspect_compilation("(+ 1 2)")
  expect_true(is.call(out_nofold$compiled))

  # Both should produce the same result
  expect_equal(e_fold$eval_text("(+ 1 2)"), 3)
  expect_equal(e_nofold$eval_text("(+ 1 2)"), 3)
})

test_that("disable_constant_folding via R option works", {
  thin()
  withr::local_options(list(arl.disable_constant_folding = TRUE))
  e <- Engine$new(load_prelude = FALSE)
  out <- e$inspect_compilation("(+ 1 2)")
  expect_true(is.call(out$compiled))
  expect_equal(e$eval_text("(+ 1 2)"), 3)
})

test_that("disable_constant_folding via env var works", {
  thin()
  withr::local_envvar(ARL_DISABLE_CONSTANT_FOLDING = "1")
  e <- Engine$new(load_prelude = FALSE)
  out <- e$inspect_compilation("(+ 1 2)")
  expect_true(is.call(out$compiled))
  expect_equal(e$eval_text("(+ 1 2)"), 3)
})

test_that("arithmetic builtins match R without folding", {
  thin()
  e <- Engine$new(disable_constant_folding = TRUE)

  expect_equal(e$eval_text("(+ 1 2)"), 3)
  expect_equal(e$eval_text("(- 10 3)"), 7)
  expect_equal(e$eval_text("(* 4 5)"), 20)
  expect_equal(e$eval_text("(/ 10 3)"), 10 / 3)
  expect_equal(e$eval_text("(^ 2 10)"), 1024)
  expect_equal(e$eval_text("(%% 10 3)"), 1)
  expect_equal(e$eval_text("(%/% 10 3)"), 3)
})

test_that("comparison builtins match R without folding", {
  thin()
  e <- Engine$new(disable_constant_folding = TRUE)

  expect_true(e$eval_text("(< 1 2)"))
  expect_false(e$eval_text("(< 2 1)"))
  expect_true(e$eval_text("(> 2 1)"))
  expect_false(e$eval_text("(> 1 2)"))
  expect_true(e$eval_text("(<= 1 1)"))
  expect_true(e$eval_text("(>= 1 1)"))
  expect_true(e$eval_text("(!= 1 2)"))
  expect_false(e$eval_text("(!= 1 1)"))
})

test_that("equality builtins handle NaN/NA correctly without folding", {
  thin()
  e <- Engine$new(disable_constant_folding = TRUE)

  # NaN == NaN should return NA (R semantics), not FALSE
  result <- e$eval_text("(== NaN NaN)")
  expect_true(is.na(result))

  # NA == NA should also return NA
  result <- e$eval_text("(== NA NA)")
  expect_true(is.na(result))

  # Normal equality should still work
  expect_true(e$eval_text("(== 1 1)"))
  expect_false(e$eval_text("(== 1 2)"))

  # NULL equality (Arl-specific: NULL-safe)
  expect_true(e$eval_text("(== NULL NULL)"))
  expect_false(e$eval_text("(== 1 NULL)"))
  expect_false(e$eval_text("(== NULL 1)"))

  # != with NaN
  result <- e$eval_text("(!= NaN NaN)")
  expect_true(is.na(result))
})

test_that("logical builtins match R without folding", {
  thin()
  e <- Engine$new(disable_constant_folding = TRUE)

  expect_true(e$eval_text("(& #t #t)"))
  expect_false(e$eval_text("(& #t #f)"))
  expect_true(e$eval_text("(| #f #t)"))
  expect_false(e$eval_text("(| #f #f)"))
  expect_false(e$eval_text("(! #t)"))
  expect_true(e$eval_text("(! #f)"))
})

test_that("math builtins match R without folding", {
  thin()
  e <- Engine$new(disable_constant_folding = TRUE)

  expect_equal(e$eval_text("(abs -5)"), 5)
  expect_equal(e$eval_text("(sqrt 16)"), 4)
  expect_equal(e$eval_text("(floor 3.7)"), 3)
  expect_equal(e$eval_text("(ceiling 3.2)"), 4)
  expect_equal(e$eval_text("(round 3.5)"), 4)

  # Special values
  expect_true(is.nan(suppressWarnings(e$eval_text("(sqrt -1)"))))
  expect_equal(e$eval_text("(abs Inf)"), Inf)
  expect_equal(e$eval_text("(log 1)"), 0)
})

test_that("folded and unfolded results agree on edge cases", {
  thin()
  e_fold <- Engine$new()
  e_nofold <- Engine$new(disable_constant_folding = TRUE)

  cases <- c(
    "(+ 0 0)", "(* 0 1)", "(/ 1 0)", "(- 0 0)",
    "(== 1 1)", "(== 1 2)", "(!= 1 1)", "(!= 1 2)",
    "(< 1 1)", "(<= 1 1)", "(> 1 1)", "(>= 1 1)",
    "(abs -0)", "(sqrt 0)", "(log Inf)"
  )
  for (expr in cases) {
    r_fold <- e_fold$eval_text(expr)
    r_nofold <- e_nofold$eval_text(expr)
    # Use identical() to catch NA vs FALSE etc.
    expect_identical(r_fold, r_nofold,
      info = sprintf("Mismatch for %s: folded=%s, unfolded=%s",
                     expr, deparse(r_fold), deparse(r_nofold)))
  }
})

# ==============================================================================
# All-Optimizations-Disabled Mode
# ==============================================================================
#
# These tests verify correctness when ALL compiler optimizations are disabled
# via the disable_optimizations parameter, R option, or env var.

test_that("disable_optimizations parameter works", {
  thin()
  e <- Engine$new(load_prelude = FALSE, disable_optimizations = TRUE)
  compiler <- e$.__enclos_env__$private$.compiler

  expect_false(compiler$enable_constant_folding)
  expect_false(compiler$enable_tco)
  expect_false(compiler$enable_dead_code_elim)
  expect_false(compiler$enable_strength_reduction)
  expect_false(compiler$enable_identity_elim)
  expect_false(compiler$enable_truthiness_opt)
  expect_false(compiler$enable_begin_simplify)
  expect_false(compiler$enable_boolean_flatten)
})

test_that("disable_optimizations via R option works", {
  thin()
  withr::local_options(list(arl.disable_optimizations = TRUE))
  e <- Engine$new(load_prelude = FALSE)
  compiler <- e$.__enclos_env__$private$.compiler

  expect_false(compiler$enable_constant_folding)
  expect_false(compiler$enable_tco)
  expect_false(compiler$enable_dead_code_elim)
  expect_false(compiler$enable_strength_reduction)
  expect_false(compiler$enable_identity_elim)
  expect_false(compiler$enable_truthiness_opt)
  expect_false(compiler$enable_begin_simplify)
  expect_false(compiler$enable_boolean_flatten)
})

test_that("disable_optimizations via env var works", {
  thin()
  withr::local_envvar(ARL_DISABLE_OPTIMIZATIONS = "1")
  e <- Engine$new(load_prelude = FALSE)
  compiler <- e$.__enclos_env__$private$.compiler

  expect_false(compiler$enable_constant_folding)
  expect_false(compiler$enable_dead_code_elim)
})

test_that("arithmetic and comparison correct without optimizations", {
  thin()
  e <- Engine$new(disable_optimizations = TRUE)

  expect_equal(e$eval_text("(+ 1 2)"), 3)
  expect_equal(e$eval_text("(- 10 3)"), 7)
  expect_equal(e$eval_text("(* 4 5)"), 20)
  expect_equal(e$eval_text("(/ 10 3)"), 10 / 3)
  expect_true(e$eval_text("(< 1 2)"))
  expect_false(e$eval_text("(> 1 2)"))
  expect_true(e$eval_text("(== 1 1)"))
  expect_false(e$eval_text("(== 1 2)"))
})

test_that("NaN/NA edge cases correct without optimizations", {
  thin()
  e <- Engine$new(disable_optimizations = TRUE)

  result <- e$eval_text("(== NaN NaN)")
  expect_true(is.na(result))

  result <- e$eval_text("(== NA NA)")
  expect_true(is.na(result))

  result <- e$eval_text("(!= NaN NaN)")
  expect_true(is.na(result))
})

test_that("if with constant tests works without dead code elimination", {
  thin()
  e <- Engine$new(load_prelude = FALSE, disable_optimizations = TRUE)

  # Should still produce correct results even without DCE
  expect_equal(e$eval_text("(if #t 1 2)"), 1)
  expect_equal(e$eval_text("(if #f 1 2)"), 2)
  expect_equal(e$eval_text("(if #t 42 99)"), 42)

  # Compiled output should retain the if structure (not eliminated)
  out <- e$inspect_compilation("(if #t 1 2)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  expect_true(grepl("if", compiled_str),
    info = "if should not be eliminated when DCE is off")
})

test_that("strength reduction disabled produces correct results", {
  thin()
  e <- Engine$new(load_prelude = FALSE, disable_optimizations = TRUE)
  e$eval_text("(define x 5)")

  # (* x 2) should still equal 10
  expect_equal(e$eval_text("(* x 2)"), 10)

  # (^ x 2) should still equal 25
  expect_equal(e$eval_text("(^ x 2)"), 25)

  # Compiled output should use original operators
  out <- e$inspect_compilation("(* x 2)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  expect_true(grepl("\\*", compiled_str),
    info = "Should use multiplication when strength reduction is off")

  out <- e$inspect_compilation("(^ x 2)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  expect_true(grepl("\\^", compiled_str),
    info = "Should use exponentiation when strength reduction is off")
})

test_that("identity elimination disabled produces correct results", {
  thin()
  e <- Engine$new(load_prelude = FALSE, disable_optimizations = TRUE)

  # ((lambda (x) x) 42) should still return 42
  expect_equal(e$eval_text("((lambda (x) x) 42)"), 42)

  # But the compiled output should be a function application, not inlined
  out <- e$inspect_compilation("((lambda (x) x) 42)")
  is_funcall <- is.call(out$compiled) && is.call(out$compiled[[1]]) &&
                length(out$compiled[[1]]) > 0 &&
                identical(out$compiled[[1]][[1]], quote(as.function))
  expect_true(is_funcall,
    info = "Identity lambda should remain as function call when elimination is off")
})

test_that("truthiness optimization disabled uses .__true_p wrapper", {
  thin()
  e <- Engine$new(load_prelude = FALSE, disable_optimizations = TRUE)

  # Even for known-boolean tests, .__true_p should be present
  out <- e$inspect_compilation("(if (> x 5) 1 2)")
  compiled_str <- paste(deparse(out$compiled), collapse = " ")
  expect_true(grepl(".__true_p", compiled_str),
    info = ".__true_p should be used when truthiness optimization is off")
})

test_that("begin simplification disabled keeps block wrapper", {
  thin()
  e <- Engine$new(load_prelude = FALSE, disable_optimizations = TRUE)

  # (begin expr) should keep the block wrapper
  out <- e$inspect_compilation("(begin 42)")
  expect_true(is.call(out$compiled) && identical(out$compiled[[1]], quote(`{`)),
    info = "Single-expression begin should keep block when simplification is off")
})

test_that("boolean flatten disabled preserves nesting", {
  thin()
  e <- Engine$new(load_prelude = FALSE, disable_optimizations = TRUE)

  # (and (and a b) c) should NOT flatten when disabled
  # The inner (and a b) should be compiled as its own short-circuit sequence
  nested <- e$inspect_compilation("(and (and a b) c)")
  flat <- e$inspect_compilation("(and a b c)")

  # Nested and flat should produce different compiled structures
  nested_str <- paste(deparse(nested$compiled), collapse = " ")
  flat_str <- paste(deparse(flat$compiled), collapse = " ")
  expect_false(identical(nested_str, flat_str),
    info = "Nested and flat (and) should differ when flattening is off")
})

test_that("recursive functions work without TCO (small depth)", {
  thin()
  e <- Engine$new(disable_optimizations = TRUE)

  # Small depth to avoid stack overflow without TCO
  e$eval_text("
    (define factorial
      (lambda (n)
        (if (<= n 1) 1 (* n (factorial (- n 1))))))
  ")
  expect_equal(e$eval_text("(factorial 10)"), 3628800)
})