rose-ash/lib/js/stdlib.sx

;; lib/js/stdlib.sx — Phase 22 JS additions
;;
;; Adds to lib/js/runtime.sx (already loaded):
;;   1. Bitwise binary ops (js-bitand/bitor/bitxor/lshift/rshift/urshift/bitnot)
;;   2. Map class (arbitrary-key hash map via list of pairs)
;;   3. Set class (uniqueness collection via SX make-set)
;;   4. RegExp constructor (wraps js-regex-new already in runtime)
;;   5. Wires Map / Set / RegExp into js-global

;; ---------------------------------------------------------------------------
;; 1. Bitwise binary ops
;;    JS coerces operands to 32-bit signed int before applying the op.
;;    Use truncate (not js-num-to-int) since integer / 0 crashes the evaluator.
;; ---------------------------------------------------------------------------

(define
  (js-bitand a b)
  (bitwise-and (truncate (js-to-number a)) (truncate (js-to-number b))))

(define
  (js-bitor a b)
  (bitwise-or (truncate (js-to-number a)) (truncate (js-to-number b))))

(define
  (js-bitxor a b)
  (bitwise-xor (truncate (js-to-number a)) (truncate (js-to-number b))))

;; << : left-shift by (b mod 32) positions
(define
  (js-lshift a b)
  (arithmetic-shift
    (truncate (js-to-number a))
    (modulo (truncate (js-to-number b)) 32)))

;; >> : arithmetic right-shift (sign-extending)
(define
  (js-rshift a b)
  (arithmetic-shift
    (truncate (js-to-number a))
    (- 0 (modulo (truncate (js-to-number b)) 32))))

;; >>> : logical right-shift (zero-extending)
;;   Convert to uint32 first, then divide by 2^n.
(define
  (js-urshift a b)
  (let
    ((u32 (modulo (truncate (js-to-number a)) 4294967296))
      (n (modulo (truncate (js-to-number b)) 32)))
    (quotient u32 (arithmetic-shift 1 n))))

;; ~ : bitwise NOT — equivalent to -(n+1) in 32-bit signed arithmetic
(define (js-bitnot a) (bitwise-not (truncate (js-to-number a))))

;; ---------------------------------------------------------------------------
;; 2. Map class
;;    Stored as {:__js_map__ true :size N :_pairs (list (list key val) ...)}
;;    Mutation via dict-set! on the underlying dict.
;; ---------------------------------------------------------------------------

(define
  (js-map-new)
  (let
    ((m (dict)))
    (dict-set! m "__js_map__" true)
    (dict-set! m "size" 0)
    (dict-set! m "_pairs" (list))
    m))

(define (js-map? v) (and (dict? v) (dict-has? v "__js_map__")))

;; Linear scan for key using ===; returns index or -1
(define
  (js-map-find-idx pairs k)
  (letrec
    ((go (fn (ps i) (cond ((= (len ps) 0) -1) ((js-strict-eq (first (first ps)) k) i) (else (go (rest ps) (+ i 1)))))))
    (go pairs 0)))

(define
  (js-map-get m k)
  (letrec
    ((go (fn (ps) (if (= (len ps) 0) js-undefined (if (js-strict-eq (first (first ps)) k) (nth (first ps) 1) (go (rest ps)))))))
    (go (get m "_pairs"))))

;; Replace element at index i in list
(define
  (js-list-set-nth lst i newval)
  (letrec
    ((go (fn (ps j) (if (= (len ps) 0) (list) (cons (if (= j i) newval (first ps)) (go (rest ps) (+ j 1)))))))
    (go lst 0)))

;; Remove element at index i from list
(define
  (js-list-remove-nth lst i)
  (letrec
    ((go (fn (ps j) (if (= (len ps) 0) (list) (if (= j i) (go (rest ps) (+ j 1)) (cons (first ps) (go (rest ps) (+ j 1))))))))
    (go lst 0)))

(define
  (js-map-set! m k v)
  (let
    ((pairs (get m "_pairs")) (idx (js-map-find-idx (get m "_pairs") k)))
    (if
      (= idx -1)
      (begin
        (dict-set! m "_pairs" (append pairs (list (list k v))))
        (dict-set! m "size" (+ (get m "size") 1)))
      (dict-set! m "_pairs" (js-list-set-nth pairs idx (list k v)))))
  m)

(define
  (js-map-has m k)
  (not (= (js-map-find-idx (get m "_pairs") k) -1)))

(define
  (js-map-delete! m k)
  (let
    ((idx (js-map-find-idx (get m "_pairs") k)))
    (when
      (not (= idx -1))
      (dict-set! m "_pairs" (js-list-remove-nth (get m "_pairs") idx))
      (dict-set! m "size" (- (get m "size") 1))))
  m)

(define
  (js-map-clear! m)
  (dict-set! m "_pairs" (list))
  (dict-set! m "size" 0)
  m)

(define (js-map-keys m) (map first (get m "_pairs")))
(define
  (js-map-vals m)
  (map (fn (p) (nth p 1)) (get m "_pairs")))
(define (js-map-entries m) (get m "_pairs"))

(define
  (js-map-for-each m cb)
  (for-each
    (fn (p) (cb (nth p 1) (first p) m))
    (get m "_pairs"))
  js-undefined)

;; Map method dispatch (called from js-object-method-call in runtime)
(define
  (js-map-method m name args)
  (cond
    ((= name "set")
      (js-map-set! m (nth args 0) (nth args 1)))
    ((= name "get") (js-map-get m (nth args 0)))
    ((= name "has") (js-map-has m (nth args 0)))
    ((= name "delete") (js-map-delete! m (nth args 0)))
    ((= name "clear") (js-map-clear! m))
    ((= name "keys") (js-map-keys m))
    ((= name "values") (js-map-vals m))
    ((= name "entries") (js-map-entries m))
    ((= name "forEach") (js-map-for-each m (nth args 0)))
    ((= name "toString") "[object Map]")
    (else js-undefined)))

(define Map {:__callable__ (fn (&rest args) (let ((m (js-map-new))) (when (and (> (len args) 0) (list? (nth args 0))) (for-each (fn (entry) (js-map-set! m (nth entry 0) (nth entry 1))) (nth args 0))) m)) :prototype {:entries (fn (&rest a) (js-map-entries (js-this))) :delete (fn (&rest a) (js-map-delete! (js-this) (nth a 0))) :get (fn (&rest a) (js-map-get (js-this) (nth a 0))) :values (fn (&rest a) (js-map-vals (js-this))) :toString (fn () "[object Map]") :has (fn (&rest a) (js-map-has (js-this) (nth a 0))) :set (fn (&rest a) (js-map-set! (js-this) (nth a 0) (nth a 1))) :forEach (fn (&rest a) (js-map-for-each (js-this) (nth a 0))) :clear (fn (&rest a) (js-map-clear! (js-this))) :keys (fn (&rest a) (js-map-keys (js-this)))}})

;; ---------------------------------------------------------------------------
;; 3. Set class
;;    {:__js_set__ true :size N :_set <sx-set>}
;;    Note: set-member?/set-add!/set-remove! all take (set item) order.
;; ---------------------------------------------------------------------------

(define
  (js-set-new)
  (let
    ((s (dict)))
    (dict-set! s "__js_set__" true)
    (dict-set! s "size" 0)
    (dict-set! s "_set" (make-set))
    s))

(define (js-set? v) (and (dict? v) (dict-has? v "__js_set__")))

(define
  (js-set-add! s v)
  (let
    ((sx (get s "_set")))
    (when
      (not (set-member? sx v))
      (set-add! sx v)
      (dict-set! s "size" (+ (get s "size") 1))))
  s)

(define (js-set-has s v) (set-member? (get s "_set") v))

(define
  (js-set-delete! s v)
  (let
    ((sx (get s "_set")))
    (when
      (set-member? sx v)
      (set-remove! sx v)
      (dict-set! s "size" (- (get s "size") 1))))
  s)

(define
  (js-set-clear! s)
  (dict-set! s "_set" (make-set))
  (dict-set! s "size" 0)
  s)

(define (js-set-vals s) (set->list (get s "_set")))

(define
  (js-set-for-each s cb)
  (for-each (fn (v) (cb v v s)) (set->list (get s "_set")))
  js-undefined)

(define Set {:__callable__ (fn (&rest args) (let ((s (js-set-new))) (when (and (> (len args) 0) (list? (nth args 0))) (for-each (fn (v) (js-set-add! s v)) (nth args 0))) s)) :prototype {:entries (fn (&rest a) (map (fn (v) (list v v)) (js-set-vals (js-this)))) :delete (fn (&rest a) (js-set-delete! (js-this) (nth a 0))) :values (fn (&rest a) (js-set-vals (js-this))) :add (fn (&rest a) (js-set-add! (js-this) (nth a 0))) :toString (fn () "[object Set]") :has (fn (&rest a) (js-set-has (js-this) (nth a 0))) :forEach (fn (&rest a) (js-set-for-each (js-this) (nth a 0))) :clear (fn (&rest a) (js-set-clear! (js-this))) :keys (fn (&rest a) (js-set-vals (js-this)))}})

;; ---------------------------------------------------------------------------
;; 4. RegExp constructor — callable lambda wrapping js-regex-new
;; ---------------------------------------------------------------------------

(define
  RegExp
  (fn
    (&rest args)
    (cond
      ((= (len args) 0) (js-regex-new "" ""))
      ((= (len args) 1)
        (js-regex-new (js-to-string (nth args 0)) ""))
      (else
        (js-regex-new
          (js-to-string (nth args 0))
          (js-to-string (nth args 1)))))))

;; ---------------------------------------------------------------------------
;; 5. Wire new globals into js-global
;; ---------------------------------------------------------------------------

(dict-set! js-global "Map" Map)
(dict-set! js-global "Set" Set)
(dict-set! js-global "RegExp" RegExp)