;;; Arl Standard Library - Core Functions

(module core
  (export license
          error warn
          identity values values?
          call-with-values
          funcall r-call get unbind-variable run
          macroexpand-1 macroexpand-all)


;;' @section Error and Warning

  ;;' @description Signal an error with message.
  ;;' @param msg Error message string
  ;;' @examples
  ;;' (try-catch (error "something went wrong")
  ;;'   (catch e ($ e "message")))     ; => "something went wrong"
  ;;' (try-catch (error "oops")
  ;;'   (catch e "caught"))            ; => "caught"
  ;;' @assert
  ;;' (assert-equal "something went wrong" (try-catch (error "something went wrong") (catch e ($ e "message"))))
  ;;' (assert-equal "caught" (try-catch (error "oops") (catch e "caught")))
  ;;' @seealso warn, assert, try-catch
  (define error
    (lambda (msg)
      (stop msg :call. #f)))

  ;;' @description Emit warning with message.
  ;;' @param msg Warning message string
  ;;' @examples
  ;;' (warn "check your input")       ; emits warning, returns #nil
  ;;' @seealso error, trace
  (define warn
    (lambda (msg)
      (warning msg :call. #f)))

;;' @section Identity and Values

  ;;' @description Return argument.
  ;;' @param x Value to return unchanged
  ;;' @examples
  ;;' (identity 42)             ; => 42
  ;;' (identity "hello")        ; => "hello"
  ;;' (map identity '(1 2 3))   ; => (1 2 3)
  ;;' @assert
  ;;' (assert-equal 42 (identity 42))
  ;;' (assert-equal "hello" (identity "hello"))
  ;;' @seealso map
  (define identity
    (lambda (x)
      x))

  ;;' @description Return multiple values to a call-with-values consumer.
  ;;' @param args Values to package together
  ;;' @examples
  ;;' (values 1 2 3)            ; => multiple-values container
  ;;' @assert
  ;;' (assert-true (values? (values 1 2 3)))
  ;;' @seealso values?, call-with-values
  (define values
    (lambda (. args)
      (r-call "structure" (list args :class "arl_values"))))

  ;;' @description Return #t if x is a multiple-values container.
  ;;' @param x Value to test
  ;;' @examples
  ;;' (values? (values 1 2))    ; => #t
  ;;' (values? 42)              ; => #f
  ;;' @assert
  ;;' (assert-true (values? (values 1 2)))
  ;;' (assert-false (values? 42))
  ;;' @seealso values, call-with-values
  (define values?
    (lambda (x)
      (if (is.list x)
        (isTRUE (inherits x "arl_values"))
        #f)))

  ;;' @description Call producer and pass its values to consumer.
  ;;' @param producer Zero-argument function that returns values
  ;;' @param consumer Function that receives the produced values as arguments
  ;;' @examples
  ;;' (call-with-values
  ;;'   (lambda () (values 1 2))
  ;;'   (lambda (a b) (+ a b)))  ; => 3
  ;;' @assert
  ;;' (assert-equal 3 (call-with-values (lambda () (values 1 2)) (lambda (a b) (+ a b))))
  ;;' @seealso values, values?
  (define call-with-values
    (lambda (producer consumer)
      (if (not (is.function producer))
        (stop "call-with-values expects a function as the producer"))
      (if (not (is.function consumer))
        (stop "call-with-values expects a function as the consumer"))
      (define produced (producer))
      (define args
        (if (values? produced)
          (r-call "unclass" (list produced))
          (list produced)))
      (funcall consumer args)))

;;' @section Function Application

  ;;' @description Apply a function with a provided list of arguments.
  ;;' @signature (funcall fn args)
  ;;' @param fn Function to apply
  ;;' @param args List of arguments to pass to fn
  ;;' @examples
  ;;' (funcall + (list 1 2 3))  ; => 6
  ;;' (funcall c (list 1 2 3))  ; => c(1, 2, 3)
  ;;' @assert
  ;;' (assert-equal 6 (funcall + (list 1 2 3)))
  ;;' @seealso apply, r-call
  (define funcall
    (lambda (fn args)
      (do.call fn args :quote #t)))

  ; for use in r-call below: we need R's get, not the get defined below
  ; in terms of r-call itself
  (define _rget base::get)

  ;;' @description Call an R function with optional environment.
  ;;' Searches from .GlobalEnv by default, finding base and loaded
  ;;' package functions.
  ;;' @param fn Symbol or string naming the R function
  ;;' @param args List of arguments to pass (default empty)
  ;;' @param envir Environment to search for fn (default .GlobalEnv)
  ;;' @examples
  ;;' (r-call "mean" (list (c 1 2 3)))   ; => 2
  ;;' (r-call "ls" (list))                ; list .GlobalEnv bindings
  ;;' (r-call "Sys.time" (list))          ; current time
  ;;' @assert
  ;;' (assert-equal 2 (r-call "mean" (list (c 1 2 3))))
  ;;' @note R functions are directly available in Arl without `r-call`. Use `r-call` when you need to look up a function by string name or specify the search environment.
  ;;' @seealso funcall, r-eval
  ;; Private binding to R's base `get` — needed to bootstrap r-call without
  ;; circular dependency (r-call uses _rget; everything else uses r-call).
  (define r-call
    (lambda (fn (args (list)) (envir (globalenv)))
      (define fn-name
        (if (is.symbol fn)
          (as.character fn)
          (if (is.character fn)
            fn
            (error "r-call requires a symbol or string function name"))))
      (define fn-obj (_rget fn-name :envir envir :inherits #t))
      (funcall fn-obj (as.list args))))  ; as.list handles environments

  ;;' @description Get a binding by name, defaulting to .GlobalEnv.
  ;;' @signature (get name [envir] [inherits])
  ;;' @param name Symbol or string naming the binding to look up
  ;;' @param envir Environment to search in (default .GlobalEnv)
  ;;' @param inherits Whether to search parent environments (default #t)
  ;;' @examples
  ;;' (get "mean")              ; => the `mean` function
  ;;' (get "pi" (baseenv))      ; => 3.141593
  ;;' @assert
  ;;' (assert-true (is.function (get "mean")))
  ;;' (assert-true (> (get "pi" (baseenv)) 3.14))
  ;;' @seealso r-call
  (define get
    (lambda (name (envir (globalenv)) (inherits #t))
      (define name-str
        (if (is.symbol name)
          (as.character name)
          name))
      (r-call "get" (list name-str :envir envir :inherits inherits))))

  ;;' @description Remove a variable binding from an environment.
  ;;' @signature (unbind-variable name [envir])
  ;;' @param name Symbol or string naming the variable to remove
  ;;' @param envir Environment to remove from (default current environment)
  ;;' @examples
  ;;' (begin
  ;;'   (define tmp-var 42)
  ;;'   (unbind-variable "tmp-var" (current-env))
  ;;'   (try-catch tmp-var (catch e "gone")))  ; => "gone"
  ;;' @assert
  ;;' (assert-equal "gone" (begin (define ub-test 1) (unbind-variable "ub-test" (current-env)) (try-catch ub-test (catch e "gone"))))
  ;;' @seealso get, define
  (define unbind-variable
    (lambda (name (envir (current-env)))
      (define name-str
        (if (is.symbol name)
          (as.character name)
          name))
      (rm :list name-str :envir envir)))

  ;;' @description Evaluate a file in an isolated child environment.
  ;;' Uses `parent` as the child environment parent. Definitions/imports in
  ;;' the loaded file remain in the child and are not visible in `parent`.
  ;;' @signature (run path [parent])
  ;;' @param path File path to evaluate
  ;;' @param parent Parent environment for the child (default current environment)
  ;;' @examples
  ;;' (define run-demo-path (tempfile :fileext ".arl"))
  ;;' (writeLines (c "(define run-demo-val 1)") run-demo-path)
  ;;' (run run-demo-path)
  ;;' (assert-equal "missing" (try-catch run-demo-val (catch e "missing")))
  ;;' (unlink run-demo-path)
  ;;' @seealso load, current-env
  (define run
    (lambda (path (parent (current-env)))
      (load path (new.env :parent parent))))

;;' @section License

  ;;' @description Display Arl and R license information.
  ;;' @examples
  ;;' (license)                 ; prints Arl and R license info
  (define license
    (lambda ()
      (begin
        (r-call "cat" (list "Arl is licensed under the MIT License:\n\n"))
        (define license-file (r-call "system.file" (list "LICENSE.md" :package "arl")))
        (define license-lines (r-call "readLines" (list license-file)))
        (r-call "cat" (list license-lines :sep "\n"))
        (r-call "cat" (list "\n\nArl is built on R. R's license:\n\n"))
        (r-call "license" (list)))))

;;' @section Macro Introspection

  ;;' @description Expand one layer of macros in expr.
  ;;' @param expr Expression to macro-expand
  ;;' @examples
  ;;' (macroexpand-1 '(when #t 42))  ; => (if #t (begin 42) #nil)
  ;;' @assert
  ;;' (assert-equal '(if #t (begin 42) #nil) (macroexpand-1 '(when #t 42)))
  ;;' @seealso macroexpand, macroexpand-all
  (define macroexpand-1 (lambda (expr) (macroexpand expr 1)))

  ;;' @description Fully expand all macros in expr. Same as macroexpand with no depth.
  ;;' @param expr Expression to recursively macro-expand
  ;;' @examples
  ;;' (macroexpand-all '(when #t 42))  ; => (if #t (begin 42) #nil)
  ;;' @assert
  ;;' (assert-equal '(if #t (begin 42) #nil) (macroexpand-all '(when #t 42)))
  ;;' @seealso macroexpand, macroexpand-1
  (define macroexpand-all macroexpand)
)
