test-module-scoping.R
In arl: Embedded Lisp Dialect

# Regression tests for module scoping and macro phase ordering.
# Commit 6dd860b fixed two coupled bugs:
#   1. Module envs parent to builtins_env (not engine_env)
#   2. Module bodies compile/eval interleaved (not batch)
# These tests ensure those fixes don't regress.

thin <- make_cran_thinner()

test_that("variadic arithmetic operators are present as builtins without stdlib", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)
  builtins_env <- engine$.__enclos_env__$private$.compiled_runtime$context$builtins_env

  for (op in c("+", "*", "-", "/")) {
    expect_true(exists(op, envir = builtins_env, inherits = FALSE),
      info = sprintf("%s should be in builtins_env", op))
  }

  # Variadic behavior works without stdlib
  expect_equal(engine$eval_text("(+ 1 2 3)"), 6)
  expect_equal(engine$eval_text("(* 2 3 4)"), 24)
  expect_equal(engine$eval_text("(- 10 3 2)"), 5)
  expect_equal(engine$eval_text("(/ 120 6 2)"), 10)
})

test_that("variadic comparison operators are present as builtins without stdlib", {
  thin()
  engine <- Engine$new(load_prelude = FALSE)
  builtins_env <- engine$.__enclos_env__$private$.compiled_runtime$context$builtins_env

  for (op in c("<", "<=", ">", ">=")) {
    expect_true(exists(op, envir = builtins_env, inherits = FALSE),
      info = sprintf("%s should be in builtins_env", op))
  }

  # Chained comparison works without stdlib
  expect_true(engine$eval_text("(< 1 2 3)"))
  expect_false(engine$eval_text("(< 1 3 2)"))
  expect_true(engine$eval_text("(<= 1 1 2)"))
  expect_true(engine$eval_text("(>= 3 2 1)"))
})

test_that("modules cannot use non-prelude stdlib functions without importing them", {
  thin()
  engine <- make_engine()
  # dict is non-prelude — modules should not have it without explicit import
  expect_error(
    engine$eval_text("
      (module __scoping_bad
        (export foo)
        (define foo (lambda () (dict :a 1))))
      (import __scoping_bad :refer :all)
      (foo)"),
    "dict|not found|object"
  )
})

test_that("macros from imported modules are available in subsequent module body expressions", {
  thin()
  engine <- make_engine()
  result <- engine$eval_text("
    (module __scoping_macro
      (export safe-double)
      (import control :refer :all)
      (define safe-double (lambda (x) (when (> x 0) (* x 2)))))
    (import __scoping_macro :refer :all)
    (safe-double 5)")
  expect_equal(result, 10)
})

test_that("module env chain is module_env -> prelude_env -> builtins_env -> baseenv()", {
  thin()
  engine <- make_engine()
  engine$eval_text("
    (module __scoping_chain
      (export x)
      (define x 1))")

  builtins_env <- engine$.__enclos_env__$private$.compiled_runtime$context$builtins_env
  prelude_env <- engine$.__enclos_env__$private$.compiled_runtime$context$prelude_env
  engine_env <- engine$get_env()
  registry <- get(".__module_registry", envir = builtins_env)
  entry <- get("__scoping_chain", envir = registry)

  # module_env -> prelude_env (not engine_env)
  expect_identical(parent.env(entry$env), prelude_env)
  expect_false(identical(parent.env(entry$env), engine_env))

  # prelude_env -> builtins_env -> default-packages chain -> baseenv()
  expect_identical(parent.env(prelude_env), builtins_env)
  e <- parent.env(builtins_env)
  while (!identical(e, baseenv())) {
    e <- parent.env(e)
  }
  expect_identical(e, baseenv())
})

# =============================================================================
# Environment command helpers
# =============================================================================

test_that("toplevel-env returns engine_env, not builtins_env", {
  thin()
  engine <- make_engine()
  tl <- engine$eval_text("(toplevel-env)")
  engine_env <- engine$get_env()
  builtins_env <- engine$.__enclos_env__$private$.compiled_runtime$context$builtins_env

  expect_identical(tl, engine_env)
  expect_false(identical(tl, builtins_env))
})

test_that("builtins-env returns builtins_env", {
  thin()
  engine <- make_engine()
  be <- engine$eval_text("(builtins-env)")
  builtins_env <- engine$.__enclos_env__$private$.compiled_runtime$context$builtins_env
  prelude_env <- engine$.__enclos_env__$private$.compiled_runtime$context$prelude_env
  engine_env <- engine$get_env()

  expect_identical(be, builtins_env)
  expect_false(identical(be, engine_env))
  # engine_env -> prelude_env -> builtins_env
  expect_identical(parent.env(engine_env), prelude_env)
  expect_identical(parent.env(prelude_env), be)
})

test_that("builtins-env is accessible from inside a module", {
  thin()
  engine <- make_engine()
  result <- engine$eval_text("
    (module __be_test
      (export get-be)
      (define get-be (lambda () (builtins-env))))
    (import __be_test :refer :all)
    (environment? (get-be))")
  expect_true(result)
})

test_that("r-eval works correctly inside a module function", {
  thin()
  engine <- make_engine()
  # r-eval in a module should see the module's local bindings
  result <- engine$eval_text("
    (module __reval_mod
      (export test-fn)
      (define y 42)
      (define test-fn (lambda () (r-eval (quote y)))))
    (import __reval_mod :refer :all)
    (test-fn)")
  expect_equal(result, 42)
})

# =============================================================================
# Default packages visibility
# =============================================================================

test_that("R default package functions are visible without qualification", {
  thin()
  engine <- make_engine()
  # One export from each of the 6 default packages:
  # datasets, utils, grDevices, graphics, stats, methods

  # datasets: iris (lazy data)
  expect_true(engine$eval_text("(is.data.frame iris)"))
  # utils: head
  expect_equal(engine$eval_text("(head (c 1 2 3 4 5) 3)"), c(1, 2, 3))
  # grDevices: rgb
  expect_equal(engine$eval_text("(rgb 1 0 0)"), "#FF0000")
  # graphics: xy.coords (a utility that doesn't draw)
  expect_true(engine$eval_text("(is.list (xy.coords (c 1 2 3) (c 4 5 6)))"))
  # stats: median
  expect_equal(engine$eval_text("(median (c 1 2 3 4 5))"), 3)
  # methods: is
  expect_true(engine$eval_text("(is 1 \"numeric\")"))
})

test_that("Arl builtins still shadow R default package functions", {
  thin()
  engine <- make_engine()
  # Arl's + is variadic (not base R's binary +)
  expect_equal(engine$eval_text("(+ 1 2 3)"), 6)
})

test_that("default-packages chain structure between builtins_env and baseenv()", {
  thin()
  engine <- make_engine()
  builtins_env <- engine$.__enclos_env__$private$.compiled_runtime$context$builtins_env

  # Walk from builtins_env down to baseenv(), collecting package names
  e <- parent.env(builtins_env)
  seen_names <- character()
  while (!identical(e, baseenv())) {
    nm <- attr(e, "name")
    if (!is.null(nm)) seen_names <- c(seen_names, nm)
    e <- parent.env(e)
  }
  # Should have the squashed R packages env
  expect_true(length(seen_names) > 0)
  expect_true("arl:r-packages" %in% seen_names)
})

test_that("empty defaultPackages skips the package chain", {
  thin()
  old <- options(defaultPackages = character(0))
  on.exit(options(old))

  engine <- Engine$new(load_prelude = FALSE, r_packages = getOption("defaultPackages"))
  builtins_env <- engine$.__enclos_env__$private$.compiled_runtime$context$builtins_env

  # builtins_env should parent directly to baseenv() with no packages in between
  expect_identical(parent.env(builtins_env), baseenv())
})

test_that("custom defaultPackages changes which packages are in the chain", {
  thin()
  old <- options(defaultPackages = c("stats"))
  on.exit(options(old))

  engine <- Engine$new(load_prelude = FALSE, r_packages = getOption("defaultPackages"))
  builtins_env <- engine$.__enclos_env__$private$.compiled_runtime$context$builtins_env

  # Should have exactly one squashed package env between builtins_env and baseenv()
  e <- parent.env(builtins_env)
  seen_names <- character()
  while (!identical(e, baseenv())) {
    nm <- attr(e, "name")
    if (!is.null(nm)) seen_names <- c(seen_names, nm)
    e <- parent.env(e)
  }
  expect_equal(seen_names, "arl:r-packages")
})

test_that("modules can use default package functions without importing them", {
  thin()
  engine <- make_engine()
  result <- engine$eval_text("
    (module __dpkg_test
      (export med)
      (define med (lambda (xs) (median xs))))
    (import __dpkg_test :refer :all)
    (med (c 1 2 3 4 5))")
  expect_equal(result, 3)
})

# =============================================================================
# Cross-module macro scoping via value splicing
# =============================================================================

test_that("cross-module macro with private helper function", {
  thin()
  engine <- make_engine()
  result <- engine$eval_text("
    (module __xmacro_helper
      (export my-double-macro)
      (define private-double (lambda (x) (* x 2)))
      (defmacro my-double-macro (val)
        `(private-double ,val)))
    (import __xmacro_helper :refer :all)
    (my-double-macro 21)")
  expect_equal(result, 42)
})

test_that("cross-module macro with private constant", {
  thin()
  engine <- make_engine()
  result <- engine$eval_text("
    (module __xmacro_const
      (export scale-macro)
      (define scale-factor 10)
      (defmacro scale-macro (val)
        `(* scale-factor ,val)))
    (import __xmacro_const :refer :all)
    (scale-macro 5)")
  expect_equal(result, 50)
})

test_that("prelude symbols are NOT resolved as refs (they're universally available)", {
  thin()
  engine <- make_engine()
  # A macro that uses prelude symbols like car, + should NOT create resolved refs
  # because those are available everywhere via the prelude chain
  result <- engine$eval_text("
    (module __xmacro_prelude
      (export inc-macro)
      (defmacro inc-macro (val)
        `(+ ,val 1)))
    (import __xmacro_prelude :refer :all)
    (inc-macro 41)")
  expect_equal(result, 42)
})

test_that("hygiene still works alongside resolved refs", {
  thin()
  engine <- make_engine()
  # Macro introduces both a local binding (should be gensym'd)
  # and a free reference to a private helper (should be resolved)
  result <- engine$eval_text("
    (module __xmacro_hygiene
      (export safe-compute)
      (define private-transform (lambda (x) (* x 3)))
      (defmacro safe-compute (val)
        (let ((tmp (gensym \"tmp\")))
          `(let ((,tmp ,val))
             (private-transform ,tmp)))))
    (import __xmacro_hygiene :refer :all)
    (define private-transform (lambda (x) (+ x 1)))
    (safe-compute 10)")
  # Should use the module's private-transform (* 3), not the caller's (+ 1)
  expect_equal(result, 30)
})

test_that("nested macros across modules resolve correctly", {
  thin()
  engine <- make_engine()
  result <- engine$eval_text("
    (module __xmacro_inner
      (export inner-macro)
      (define inner-helper (lambda (x) (+ x 100)))
      (defmacro inner-macro (val)
        `(inner-helper ,val)))
    (module __xmacro_outer
      (export outer-macro)
      (import __xmacro_inner :refer :all)
      (define outer-helper (lambda (x) (* x 2)))
      (defmacro outer-macro (val)
        `(outer-helper (inner-macro ,val))))
    (import __xmacro_outer :refer :all)
    (outer-macro 5)")
  # inner-macro expands: (inner-helper 5) -> 105
  # outer-macro expands: (outer-helper (inner-macro 5)) -> (* 105 2) -> 210
  expect_equal(result, 210)
})

test_that("cross-module macro works with lambda reference", {
  thin()
  engine <- make_engine()
  # Macro references a private lambda directly (not via define)
  result <- engine$eval_text("
    (module __xmacro_lambda
      (export apply-twice)
      (define do-twice (lambda (f x) (f (f x))))
      (defmacro apply-twice (f val)
        `(do-twice ,f ,val)))
    (import __xmacro_lambda :refer :all)
    (apply-twice (lambda (x) (+ x 1)) 0)")
  expect_equal(result, 2)
})

# =============================================================================
# r_packages parameter
# =============================================================================

test_that("r_packages = NULL exposes only baseenv()", {
  thin()
  engine <- Engine$new(load_prelude = FALSE, r_packages = NULL)
  builtins_env <- engine$.__enclos_env__$private$.compiled_runtime$context$builtins_env

  # builtins_env should parent directly to baseenv()
  expect_identical(parent.env(builtins_env), baseenv())

  # base functions still work
  expect_equal(engine$eval_text("(+ 1 2)"), 3)
  expect_equal(engine$eval_text("(length (c 1 2 3))"), 3L)
})

test_that("r_packages = c('stats') gives exactly one package env", {
  thin()
  engine <- Engine$new(load_prelude = FALSE, r_packages = c("stats"))
  builtins_env <- engine$.__enclos_env__$private$.compiled_runtime$context$builtins_env

  # Should have exactly one squashed package env between builtins_env and baseenv()
  e <- parent.env(builtins_env)
  seen_names <- character()
  while (!identical(e, baseenv())) {
    nm <- attr(e, "name")
    if (!is.null(nm)) seen_names <- c(seen_names, nm)
    e <- parent.env(e)
  }
  expect_equal(seen_names, "arl:r-packages")

  # stats::median is visible
  expect_equal(engine$eval_text("(median (c 1 2 3 4 5))"), 3)
})

test_that("r_packages = 'search_path' picks up current search path", {
  thin()
  engine <- Engine$new(load_prelude = FALSE, r_packages = "search_path")
  builtins_env <- engine$.__enclos_env__$private$.compiled_runtime$context$builtins_env

  # Should have package envs matching the current search() packages
  e <- parent.env(builtins_env)
  seen_names <- character()
  while (!identical(e, baseenv())) {
    nm <- attr(e, "name")
    if (!is.null(nm)) seen_names <- c(seen_names, nm)
    e <- parent.env(e)
  }
  expect_true(length(seen_names) > 0)
  expect_true("arl:r-packages" %in% seen_names)
})

test_that("search_path mode dynamically tracks library() calls", {
  thin()
  engine <- Engine$new(load_prelude = FALSE, r_packages = "search_path")

  # tools is not typically in defaultPackages; ensure it's not loaded
  if ("package:tools" %in% search()) {
    skip("tools package already attached")
  }

  # Before loading tools, file_ext should not be found
  expect_error(engine$eval_text("(file_ext \"foo.R\")"), "file_ext|not found|object")

  # Attach tools
  library(tools)
  on.exit(detach("package:tools", unload = FALSE), add = TRUE)

  # Now file_ext should be visible (search path changed, chain rebuilt on eval)
  expect_equal(engine$eval_text("(file_ext \"foo.R\")"), "R")
})

# ============================================================================
# First-class module features
# ============================================================================

test_that("module? predicate works on module envs", {
  thin()
  engine <- make_engine()
  engine$eval_text("(import math :refer :all)")
  result <- engine$eval_text("(module? math)")
  expect_true(result)
})

test_that("module? returns false for non-modules", {
  thin()
  engine <- make_engine()
  expect_false(engine$eval_text("(module? 42)"))
  expect_false(engine$eval_text("(module? +)"))
})

test_that("module-exports returns export list", {
  thin()
  engine <- make_engine()
  engine$eval_text("(import math :refer :all)")
  exports <- engine$eval_text("(module-exports math)")
  expect_true(is.list(exports))
  expect_true("inc" %in% unlist(exports))
})

test_that("module-name returns canonical name", {
  thin()
  engine <- make_engine()
  engine$eval_text("(import math :refer :all)")
  name <- engine$eval_text("(module-name math)")
  expect_equal(name, "math")
})

test_that("module bindings are locked (immutable from outside)", {
  thin()
  engine <- make_engine()
  engine$eval_text("(import math :refer :all)")
  mod_env <- engine$eval_text("math")
  expect_true(is.environment(mod_env))
  expect_true(bindingIsLocked("inc", mod_env))
})

test_that("bare import binds module env but does not dump exports", {
  thin()
  engine <- make_engine()
  engine$eval_text("(import math)")
  # Module env is bound
  expect_true(engine$eval_text("(module? math)"))
  # Qualified access works
  result <- engine$eval_text("(math/inc 5)")
  expect_equal(result, 6)
  # Unqualified access does NOT work
  expect_error(engine$eval_text("(inc 5)"))
})

test_that(":refer :all dumps exports into scope", {
  thin()
  engine <- make_engine()
  engine$eval_text("(import math :refer :all)")
  # Module env is bound
  expect_true(engine$eval_text("(module? math)"))
  # Unqualified access works
  result <- engine$eval_text("(inc 5)")
  expect_equal(result, 6)
})