giles
c02ffcf316
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
lib/haskell/runtime.sx (113 forms): numeric type class helpers (hk-div/mod/rem/quot floor semantics), rational numbers (dict-based, GCD-normalised), hk-force for lazy promises, Data.Char (hk-ord/chr, inline ASCII predicates, digit-to-int), Data.Set wrappers, Data.List (take/drop/zip/nub/foldl/foldr/scanl/etc), Maybe/Either ADTs, tuple helpers (hk-pair/fst/snd/curry/uncurry), string helpers (words/lines/ is-prefix-of/is-infix-of/etc), hk-show. test.sh updated to pre-load runtime.sx alongside tokenizer.sx. 143/143 runtime tests + 5/5 parse tests = 148/148 total.
508 lines
13 KiB
Plaintext
508 lines
13 KiB
Plaintext
;; 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))))
|