;;; Arl Standard Library - Control Flow Macros

(module control
  (export when unless cond case try try-catch
          call-cc call-with-current-continuation)
  ;; Note: 'and' and 'or' removed from exports - now compiler special forms

  (import types :refer (symbol? list? null?))
  (import list :refer (call))


;;' @section Control Flow Macros

;;' @description Evaluate body forms when test is truthy.
;;' @param test Condition to evaluate
;;' @param body Expressions to evaluate when test is truthy
;;' @examples
;;' (when #t "yes")          ; => "yes"
;;' (when #f "yes")          ; => #nil
;;' (when (> 3 2) (+ 1 1))   ; => 2
;;' @assert
;;' (assert-equal "yes" (when #t "yes"))
;;' (assert-equal #nil (when #f "yes"))
;;' (assert-equal 2 (when (> 3 2) (+ 1 1)))
;;' @seealso unless, if, cond
(defmacro when (test . body)
  `(if ,test (begin ,@body) #nil))

;;' @description Evaluate body forms when test is falsy.
;;' @param test Condition to evaluate
;;' @param body Expressions to evaluate when test is falsy
;;' @examples
;;' (unless #f "fallback")    ; => "fallback"
;;' (unless #t "fallback")    ; => #nil
;;' (unless (= 1 2) "nope")  ; => "nope"
;;' @assert
;;' (assert-equal "fallback" (unless #f "fallback"))
;;' (assert-equal #nil (unless #t "fallback"))
;;' (assert-equal "nope" (unless (= 1 2) "nope"))
;;' @seealso when, if
(defmacro unless (test . body)
  `(if ,test #nil (begin ,@body)))

;;' @section Conditional Macros

;;' @description Multi-branch conditional.
;;' @param clause First (test body...) clause
;;' @param rest Additional clauses; last may be (else body...)
;;' @examples
;;' (cond
;;'   ((= 1 2) "a")
;;'   ((= 1 1) "b")
;;'   (else "c"))            ; => "b"
;;'
;;' (cond
;;'   ((> 10 20) "big")
;;'   (else "small"))        ; => "small"
;;' @assert
;;' (assert-equal "b" (cond ((= 1 2) "a") ((= 1 1) "b") (else "c")))
;;' (assert-equal "small" (cond ((> 10 20) "big") (else "small")))
;;' @seealso case, if, when
(defmacro cond (clause . rest)
  (if (null? clause)
    (error "cond: Missing required parameter (else clause)")
    (begin
      (define test (car clause))
      (define body (cdr clause))
      (if (and (symbol? test) (= (as.character test) "else"))
        `(begin ,@body)
        (if (null? rest)
          `(if ,test (begin ,@body) #nil)
          `(if ,test (begin ,@body) (cond ,@rest)))))))

;; Helper: generate case clause expansion using already-bound key symbol.
(define _case-clauses
  (lambda (key-sym clause rest)
    (if (null? clause)
      (error "case: Missing required parameter (else clause)")
      (begin
        (define datums (car clause))
        (define body (cdr clause))
        (if (and (symbol? datums) (= (as.character datums) "else"))
          `(begin ,@body)
          (begin
            ;; datums is a list of values to match against
            (define test-expr
              (if (= (length datums) 1)
                `(= ,key-sym (quote ,(car datums)))
                `(or ,@(lapply datums (lambda (d) `(= ,key-sym (quote ,d)))))))
            (if (null? rest)
              `(if ,test-expr (begin ,@body) #nil)
              `(if ,test-expr (begin ,@body)
                   ,(_case-clauses key-sym (car rest) (cdr rest))))))))))

;;' @description Branch on key equality. Each clause:
;;' ((datum ...) body ...) or (else body ...).
;;' Key expression is evaluated only once.
;;' @param key Expression to match (evaluated once)
;;' @param clause First match clause: ((datum...) body...)
;;' @param rest Additional clauses; last may be (else body...)
;;' @examples
;;' (case (+ 1 1)
;;'   ((1) "one")
;;'   ((2) "two")
;;'   ((3) "three")
;;'   (else "other"))        ; => "two"
;;'
;;' (case 'x
;;'   ((a b) "ab")
;;'   ((x y) "xy")
;;'   (else "?"))            ; => "xy"
;;' @assert
;;' (assert-equal "two" (case (+ 1 1) ((1) "one") ((2) "two") ((3) "three") (else "other")))
;;' (assert-equal "xy" (case 'x ((a b) "ab") ((x y) "xy") (else "?")))
;;' @note The key expression is evaluated only once. Each clause datum list can contain multiple values.
;;' @seealso cond, if
(defmacro case (key clause . rest)
  (define key-sym (gensym "case-key"))
  `((lambda (,key-sym) ,(_case-clauses key-sym clause rest)) ,key))

;;' @section Error Handling

;;' @description Evaluate thunk with error/finally handlers.
;;' @signature (try thunk [error_handler] [finally_handler])
;;' @param thunk Zero-argument function to execute
;;' @param error_handler Function receiving error condition (default #f)
;;' @param finally_handler Zero-argument cleanup function (default #f)
;;' @examples
;;' (try (lambda () 42))                           ; => 42
;;' (try (lambda () (stop "oops"))
;;'       :error_handler (lambda (e) "caught"))      ; => "caught"
;;' (try (lambda () 1)
;;'       :finally_handler (lambda () (display "done")))  ; => 1
;;' @assert
;;' (assert-equal 42 (try (lambda () 42)))
;;' (assert-equal "caught" (try (lambda () (stop "oops")) :error_handler (lambda (e) "caught")))
;;' @note Low-level functional interface to R's tryCatch.
;;' @seealso try-catch
(define try
  (lambda (thunk (error_handler #f) (finally_handler #f))
    (if (not (is.function thunk))
      (stop "try expects a function as first argument"))
    (if (and error_handler (not (is.function error_handler)))
      (stop "try error handler must be a function"))
    (if (and finally_handler (not (is.function finally_handler)))
      (stop "try finally handler must be a function"))
    (define thunk-expr (call (list thunk)))
    (if (not error_handler)
      (if (not finally_handler)
        (thunk)
        (r-eval (call (list 'tryCatch thunk-expr
                            :finally (call (list finally_handler))))
                (current-env)))
      (if (not finally_handler)
        (r-eval (call (list 'tryCatch thunk-expr
                            :error error_handler))
                (current-env))
        (r-eval (call (list 'tryCatch thunk-expr
                            :error error_handler
                            :finally (call (list finally_handler))))
                (current-env))))))

;;' @description Macro wrapper around try with catch/finally.
;;' @param body Expression to evaluate
;;' @param clauses Optional (catch var body...) and/or (finally body...) clauses
;;' @examples
;;' ;; Basic try with catch
;;' (try-catch (/ 1 0)
;;'   (catch e (string-append "caught: " ($ e "message"))))
;;'
;;' ;; try with finally (always runs)
;;' (try-catch (+ 1 2)
;;'   (finally (display "cleanup")))    ; => 3
;;'
;;' ;; try with both catch and finally
;;' (try-catch (stop "oops")
;;'   (catch e (string-append "error: " ($ e "message")))
;;'   (finally (display "done")))       ; => "error: oops"
;;'
;;' ;; try with no handlers (just evaluates body)
;;' (try-catch (+ 1 2))                       ; => 3
;;' @assert
;;' (assert-equal 3 (try-catch (+ 1 2)))
;;' (assert-equal "error: oops" (try-catch (stop "oops") (catch e (string-append "error: " ($ e "message")))))
;;' @note Macro wrapper around `try` that provides familiar catch/finally syntax. The catch clause binds the error condition to the given variable. The finally clause runs regardless of success or failure.
;;' @seealso try
(defmacro try-catch (body . clauses)
  (begin
    (define catch-clause #nil)
    (define finally-clause #nil)
    (define first (car clauses))
    (define second (car (cdr clauses)))
    (if (and (list? first) (symbol? (car first)) (= (as.character (car first)) "catch"))
      (begin
        (define catch-clause first)
        (if (and (list? second) (symbol? (car second)) (= (as.character (car second)) "finally"))
          (define finally-clause second)))
      (if (and (list? first) (symbol? (car first)) (= (as.character (car first)) "finally"))
        (define finally-clause first)))
    (if (null? catch-clause)
      (if (null? finally-clause)
        `(try (lambda () ,body))
        `(try (lambda () ,body)
           :finally_handler (lambda () ,@(cdr finally-clause))))
      (if (null? finally-clause)
        `(try (lambda () ,body)
           :error_handler (lambda (,(car (cdr catch-clause))) ,@(cdr (cdr catch-clause))))
        `(try (lambda () ,body)
           :error_handler (lambda (,(car (cdr catch-clause))) ,@(cdr (cdr catch-clause)))
           :finally_handler (lambda () ,@(cdr finally-clause)))))))

;;' @section Continuations

  ;;' @description Invoke receiver with the current continuation (escape procedure).
  ;;' @signature (call-cc receiver)
  ;;' @param receiver Function that receives the current continuation as its argument
  ;;' @examples
  ;;' (call-cc (lambda (k) (k 42)))  ; => 42
  ;;' @assert
  ;;' (assert-equal 42 (call-cc (lambda (k) (k 42))))
  ;;' @note Alias for R's `callCC`. The receiver is passed the current continuation.
  ;;' @seealso call-with-current-continuation
  (define call-cc callCC)

  ;;' @description Full name alias for call-cc.
  ;;' @signature (call-with-current-continuation receiver)
  ;;' @param receiver Function that receives the current continuation as its argument
  ;;' @examples
  ;;' (call-with-current-continuation (lambda (k) (k 42)))  ; => 42
  ;;' @assert
  ;;' (assert-equal 42 (call-with-current-continuation (lambda (k) (k 42))))
  ;;' @note Full name alias for `call-cc`.
  ;;' @seealso call-cc
  (define call-with-current-continuation callCC)
)
