;; lib/haskell/runtime.sx — Haskell-on-SX runtime layer
;;
;; Covers the Haskell primitives now reachable via SX spec:
;;  1. Numeric type class helpers (Num / Integral / Fractional)
;;  2. Rational numbers (dict-based: {:_rational true :num n :den d})
;;  3. Lazy evaluation — hk-force for promises created by delay
;;  4. Char utilities (Data.Char)
;;  5. Data.Set wrappers
;;  6. Data.List utilities
;;  7. Maybe / Either ADTs
;;  8. Tuples (lists, since list->vector unreliable in sx_server)
;;  9. String helpers (words/lines/isPrefixOf/etc.)
;; 10. Show helper

;; ===========================================================================
;; 1. Numeric type class helpers
;; ===========================================================================

(define hk-is-integer? integer?)
(define hk-is-float? float?)
(define hk-is-num? number?)

;; fromIntegral — coerce integer to Float
(define (hk-to-float x) (exact->inexact x))

;; truncate / round toward zero
(define hk-to-integer truncate)
(define hk-from-integer (fn (n) n))

;; Haskell div: floor division (rounds toward -inf)
(define
  (hk-div a b)
  (let
    ((q (quotient a b)) (r (remainder a b)))
    (if
      (and
        (not (= r 0))
        (or
          (and (< a 0) (> b 0))
          (and (> a 0) (< b 0))))
      (- q 1)
      q)))

;; Haskell mod: result has same sign as divisor
(define hk-mod modulo)

;; Haskell rem: result has same sign as dividend
(define hk-rem remainder)

;; Haskell quot: truncation division
(define hk-quot quotient)

;; divMod and quotRem return pairs (lists)
(define (hk-div-mod a b) (list (hk-div a b) (hk-mod a b)))
(define (hk-quot-rem a b) (list (hk-quot a b) (hk-rem a b)))

(define (hk-abs x) (if (< x 0) (- 0 x) x))
(define
  (hk-signum x)
  (cond
    ((> x 0) 1)
    ((< x 0) -1)
    (else 0)))

(define hk-gcd gcd)
(define hk-lcm lcm)

(define (hk-even? n) (= (modulo n 2) 0))
(define (hk-odd? n) (not (= (modulo n 2) 0)))

;; ===========================================================================
;; 2. Rational numbers (dict implementation — no built-in rational in sx_server)
;; ===========================================================================

(define
  (hk-make-rational n d)
  (let
    ((g (gcd (hk-abs n) (hk-abs d))))
    (if (< d 0) {:num (quotient (- 0 n) g) :den (quotient (- 0 d) g) :_rational true} {:num (quotient n g) :den (quotient d g) :_rational true})))

(define
  (hk-rational? x)
  (and (dict? x) (not (= (get x :_rational) nil))))
(define (hk-numerator r) (get r :num))
(define (hk-denominator r) (get r :den))

(define
  (hk-rational-add r1 r2)
  (hk-make-rational
    (+
      (* (hk-numerator r1) (hk-denominator r2))
      (* (hk-numerator r2) (hk-denominator r1)))
    (* (hk-denominator r1) (hk-denominator r2))))

(define
  (hk-rational-sub r1 r2)
  (hk-make-rational
    (-
      (* (hk-numerator r1) (hk-denominator r2))
      (* (hk-numerator r2) (hk-denominator r1)))
    (* (hk-denominator r1) (hk-denominator r2))))

(define
  (hk-rational-mul r1 r2)
  (hk-make-rational
    (* (hk-numerator r1) (hk-numerator r2))
    (* (hk-denominator r1) (hk-denominator r2))))

(define
  (hk-rational-div r1 r2)
  (hk-make-rational
    (* (hk-numerator r1) (hk-denominator r2))
    (* (hk-denominator r1) (hk-numerator r2))))

(define
  (hk-rational-to-float r)
  (exact->inexact (/ (hk-numerator r) (hk-denominator r))))

(define (hk-show-rational r) (str (hk-numerator r) "%" (hk-denominator r)))

;; ===========================================================================
;; 3. Lazy evaluation — promises (created via SX delay)
;; ===========================================================================

(define
  (hk-force p)
  (if
    (and (dict? p) (not (= (get p :_promise) nil)))
    (if (get p :forced) (get p :value) ((get p :thunk)))
    p))

;; ===========================================================================
;; 4. Char utilities (Data.Char)
;; ===========================================================================

(define hk-ord char->integer)
(define hk-chr integer->char)

;; Inline ASCII predicates — char-alphabetic?/char-numeric? unreliable in sx_server
(define
  (hk-is-alpha? c)
  (let
    ((n (char->integer c)))
    (or
      (and (>= n 65) (<= n 90))
      (and (>= n 97) (<= n 122)))))

(define
  (hk-is-digit? c)
  (let ((n (char->integer c))) (and (>= n 48) (<= n 57))))

(define
  (hk-is-alnum? c)
  (let
    ((n (char->integer c)))
    (or
      (and (>= n 48) (<= n 57))
      (and (>= n 65) (<= n 90))
      (and (>= n 97) (<= n 122)))))

(define
  (hk-is-upper? c)
  (let ((n (char->integer c))) (and (>= n 65) (<= n 90))))

(define
  (hk-is-lower? c)
  (let ((n (char->integer c))) (and (>= n 97) (<= n 122))))

(define
  (hk-is-space? c)
  (let
    ((n (char->integer c)))
    (or
      (= n 32)
      (= n 9)
      (= n 10)
      (= n 13)
      (= n 12)
      (= n 11))))

(define hk-to-upper char-upcase)
(define hk-to-lower char-downcase)

;; digitToInt: '0'-'9' → 0-9, 'a'-'f'/'A'-'F' → 10-15
(define
  (hk-digit-to-int c)
  (let
    ((n (char->integer c)))
    (cond
      ((and (>= n 48) (<= n 57)) (- n 48))
      ((and (>= n 65) (<= n 70)) (- n 55))
      ((and (>= n 97) (<= n 102)) (- n 87))
      (else (error (str "hk-digit-to-int: not a hex digit: " c))))))

;; intToDigit: 0-15 → char
(define
  (hk-int-to-digit n)
  (cond
    ((and (>= n 0) (<= n 9))
      (integer->char (+ n 48)))
    ((and (>= n 10) (<= n 15))
      (integer->char (+ n 87)))
    (else (error (str "hk-int-to-digit: out of range: " n)))))

;; ===========================================================================
;; 5. Data.Set wrappers
;; ===========================================================================

(define (hk-set-empty) (make-set))
(define hk-set? set?)
(define hk-set-member? set-member?)

(define (hk-set-insert x s) (begin (set-add! s x) s))

(define (hk-set-delete x s) (begin (set-remove! s x) s))

(define hk-set-union set-union)
(define hk-set-intersection set-intersection)
(define hk-set-difference set-difference)
(define hk-set-from-list list->set)
(define hk-set-to-list set->list)
(define (hk-set-null? s) (= (len (set->list s)) 0))
(define (hk-set-size s) (len (set->list s)))

(define (hk-set-singleton x) (let ((s (make-set))) (set-add! s x) s))

;; ===========================================================================
;; 6. Data.List utilities
;; ===========================================================================

(define hk-head first)
(define hk-tail rest)
(define (hk-null? lst) (= (len lst) 0))
(define hk-length len)

(define
  (hk-take n lst)
  (if
    (or (= n 0) (= (len lst) 0))
    (list)
    (cons (first lst) (hk-take (- n 1) (rest lst)))))

(define
  (hk-drop n lst)
  (if
    (or (= n 0) (= (len lst) 0))
    lst
    (hk-drop (- n 1) (rest lst))))

(define
  (hk-take-while pred lst)
  (if
    (or (= (len lst) 0) (not (pred (first lst))))
    (list)
    (cons (first lst) (hk-take-while pred (rest lst)))))

(define
  (hk-drop-while pred lst)
  (if
    (or (= (len lst) 0) (not (pred (first lst))))
    lst
    (hk-drop-while pred (rest lst))))

(define
  (hk-zip a b)
  (if
    (or (= (len a) 0) (= (len b) 0))
    (list)
    (cons (list (first a) (first b)) (hk-zip (rest a) (rest b)))))

(define
  (hk-zip-with f a b)
  (if
    (or (= (len a) 0) (= (len b) 0))
    (list)
    (cons (f (first a) (first b)) (hk-zip-with f (rest a) (rest b)))))

(define
  (hk-unzip pairs)
  (list
    (map (fn (p) (first p)) pairs)
    (map (fn (p) (nth p 1)) pairs)))

(define
  (hk-elem x lst)
  (cond
    ((= (len lst) 0) false)
    ((= x (first lst)) true)
    (else (hk-elem x (rest lst)))))

(define (hk-not-elem x lst) (not (hk-elem x lst)))

(define
  (hk-nub lst)
  (letrec
    ((go (fn (seen acc items) (if (= (len items) 0) (reverse acc) (let ((h (first items)) (t (rest items))) (if (hk-elem h seen) (go seen acc t) (go (cons h seen) (cons h acc) t)))))))
    (go (list) (list) lst)))

(define (hk-sum lst) (reduce + 0 lst))
(define (hk-product lst) (reduce * 1 lst))

(define
  (hk-maximum lst)
  (reduce (fn (a b) (if (> a b) a b)) (first lst) (rest lst)))

(define
  (hk-minimum lst)
  (reduce (fn (a b) (if (< a b) a b)) (first lst) (rest lst)))

(define (hk-concat lsts) (reduce append (list) lsts))

(define (hk-concat-map f lst) (hk-concat (map f lst)))

(define hk-sort sort)

(define
  (hk-span pred lst)
  (list (hk-take-while pred lst) (hk-drop-while pred lst)))

(define (hk-break pred lst) (hk-span (fn (x) (not (pred x))) lst))

(define
  (hk-foldl f acc lst)
  (if
    (= (len lst) 0)
    acc
    (hk-foldl f (f acc (first lst)) (rest lst))))

(define
  (hk-foldr f z lst)
  (if
    (= (len lst) 0)
    z
    (f (first lst) (hk-foldr f z (rest lst)))))

(define
  (hk-scanl f acc lst)
  (if
    (= (len lst) 0)
    (list acc)
    (cons acc (hk-scanl f (f acc (first lst)) (rest lst)))))

(define
  (hk-replicate n x)
  (if (= n 0) (list) (cons x (hk-replicate (- n 1) x))))

(define
  (hk-intersperse sep lst)
  (if
    (or (= (len lst) 0) (= (len lst) 1))
    lst
    (cons (first lst) (cons sep (hk-intersperse sep (rest lst))))))

;; ===========================================================================
;; 7. Maybe / Either ADTs
;; ===========================================================================

(define hk-nothing {:_maybe true :_tag "nothing"})
(define (hk-just x) {:_maybe true :value x :_tag "just"})
(define (hk-is-nothing? m) (= (get m :_tag) "nothing"))
(define (hk-is-just? m) (= (get m :_tag) "just"))
(define (hk-from-just m) (get m :value))
(define (hk-from-maybe def m) (if (hk-is-nothing? m) def (hk-from-just m)))
(define
  (hk-maybe def f m)
  (if (hk-is-nothing? m) def (f (hk-from-just m))))

(define (hk-left x) {:value x :_either true :_tag "left"})
(define (hk-right x) {:value x :_either true :_tag "right"})
(define (hk-is-left? e) (= (get e :_tag) "left"))
(define (hk-is-right? e) (= (get e :_tag) "right"))
(define (hk-from-left e) (get e :value))
(define (hk-from-right e) (get e :value))
(define
  (hk-either f g e)
  (if (hk-is-left? e) (f (hk-from-left e)) (g (hk-from-right e))))

;; ===========================================================================
;; 8. Tuples (lists — list->vector unreliable in sx_server)
;; ===========================================================================

(define (hk-pair a b) (list a b))
(define hk-fst first)
(define (hk-snd t) (nth t 1))

(define (hk-triple a b c) (list a b c))
(define hk-fst3 first)
(define (hk-snd3 t) (nth t 1))
(define (hk-thd3 t) (nth t 2))

(define (hk-curry f) (fn (a) (fn (b) (f a b))))
(define (hk-uncurry f) (fn (p) (f (hk-fst p) (hk-snd p))))

;; ===========================================================================
;; 9. String helpers (Data.List / Data.Char for strings)
;; ===========================================================================

;; words: split on whitespace
(define
  (hk-words s)
  (letrec
    ((slen (len s))
      (skip-ws
        (fn
          (i)
          (if
            (>= i slen)
            (list)
            (let
              ((c (substring s i (+ i 1))))
              (if
                (or (= c " ") (= c "\t") (= c "\n"))
                (skip-ws (+ i 1))
                (collect-word i (+ i 1)))))))
      (collect-word
        (fn
          (start i)
          (if
            (>= i slen)
            (list (substring s start i))
            (let
              ((c (substring s i (+ i 1))))
              (if
                (or (= c " ") (= c "\t") (= c "\n"))
                (cons (substring s start i) (skip-ws (+ i 1)))
                (collect-word start (+ i 1))))))))
    (skip-ws 0)))

;; unwords: join with spaces
(define
  (hk-unwords lst)
  (if
    (= (len lst) 0)
    ""
    (reduce (fn (a b) (str a " " b)) (first lst) (rest lst))))

;; lines: split on newline
(define
  (hk-lines s)
  (letrec
    ((slen (len s))
      (go
        (fn
          (start i acc)
          (if
            (>= i slen)
            (reverse (cons (substring s start i) acc))
            (if
              (= (substring s i (+ i 1)) "\n")
              (go
                (+ i 1)
                (+ i 1)
                (cons (substring s start i) acc))
              (go start (+ i 1) acc))))))
    (if (= slen 0) (list) (go 0 0 (list)))))

;; unlines: join, each with trailing newline
(define (hk-unlines lst) (reduce (fn (a b) (str a b "\n")) "" lst))

;; isPrefixOf
(define
  (hk-is-prefix-of pre s)
  (and (<= (len pre) (len s)) (= pre (substring s 0 (len pre)))))

;; isSuffixOf
(define
  (hk-is-suffix-of suf s)
  (let
    ((sl (len suf)) (tl (len s)))
    (and (<= sl tl) (= suf (substring s (- tl sl) tl)))))

;; isInfixOf — linear scan
(define
  (hk-is-infix-of pat s)
  (let
    ((plen (len pat)) (slen (len s)))
    (letrec
      ((go (fn (i) (if (> (+ i plen) slen) false (if (= pat (substring s i (+ i plen))) true (go (+ i 1)))))))
      (if (= plen 0) true (go 0)))))

;; ===========================================================================
;; 10. Show helper
;; ===========================================================================

(define
  (hk-show x)
  (cond
    ((= x nil) "Nothing")
    ((= x true) "True")
    ((= x false) "False")
    ((hk-rational? x) (hk-show-rational x))
    ((integer? x) (str x))
    ((float? x) (str x))
    ((= (type-of x) "string") (str "\"" x "\""))
    ((= (type-of x) "char") (str "'" (str x) "'"))
    ((list? x)
      (str
        "["
        (if
          (= (len x) 0)
          ""
          (reduce
            (fn (a b) (str a "," (hk-show b)))
            (hk-show (first x))
            (rest x)))
        "]"))
    (else (str x))))