;; 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 } ;; 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)