merge: architecture → hs-f (R7RS steps 4-6, IO suspension, JIT, language libs)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
Brings in 306 commits from architecture: - R7RS: call/cc, raise/guard, records, parameters, syntax-rules, define-library/import - IO suspension: perform/resume, third CEK phase - JIT expansion: component/island JIT, OP_SWAP, exception handler stack, scope forms - OCaml: HTML renderer, Python bridge, epoch protocol, sx_scope.ml - Language libs: common-lisp, erlang, forth, apl, prolog, tcl, smalltalk, ruby Conflict resolution: hs-f version kept for all hyperscript .sx files (superseding architecture's smaller additions). Architecture's platform.py kept with hs-f's domListen _driveAsync fix applied. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
56
spec/coroutines.sx
Normal file
56
spec/coroutines.sx
Normal file
@@ -0,0 +1,56 @@
|
||||
(define-library
|
||||
(sx coroutines)
|
||||
(export
|
||||
make-coroutine
|
||||
coroutine?
|
||||
coroutine-alive?
|
||||
coroutine-yield
|
||||
coroutine-handle-result
|
||||
coroutine-resume)
|
||||
(begin
|
||||
(define make-coroutine (fn (thunk) {:suspension nil :thunk thunk :type "coroutine" :state "ready"}))
|
||||
(define
|
||||
coroutine?
|
||||
(fn (v) (and (dict? v) (= (get v "type") "coroutine"))))
|
||||
(define
|
||||
coroutine-alive?
|
||||
(fn (c) (and (coroutine? c) (not (= (get c "state") "dead")))))
|
||||
(define coroutine-yield (fn (val) (perform {:value val :op "coroutine-yield"})))
|
||||
(define
|
||||
coroutine-handle-result
|
||||
(fn
|
||||
(c result)
|
||||
(if
|
||||
(cek-terminal? result)
|
||||
(do (dict-set! c "state" "dead") {:done true :value (cek-value result)})
|
||||
(let
|
||||
((request (cek-io-request result)))
|
||||
(if
|
||||
(and (dict? request) (= (get request "op") "coroutine-yield"))
|
||||
(do
|
||||
(dict-set! c "state" "suspended")
|
||||
(dict-set! c "suspension" result)
|
||||
{:done false :value (get request "value")})
|
||||
(perform request))))))
|
||||
(define
|
||||
coroutine-resume
|
||||
(fn
|
||||
(c val)
|
||||
(cond
|
||||
(not (coroutine? c))
|
||||
(error "coroutine-resume: not a coroutine")
|
||||
(= (get c "state") "dead")
|
||||
(error "coroutine-resume: coroutine is dead")
|
||||
(= (get c "state") "ready")
|
||||
(do
|
||||
(dict-set! c "state" "running")
|
||||
(coroutine-handle-result
|
||||
c
|
||||
(cek-step-loop
|
||||
(make-cek-state (list (get c "thunk")) (make-env) (list)))))
|
||||
(= (get c "state") "suspended")
|
||||
(do
|
||||
(dict-set! c "state" "running")
|
||||
(coroutine-handle-result c (cek-resume (get c "suspension") val)))
|
||||
:else (error
|
||||
(str "coroutine-resume: unexpected state: " (get c "state"))))))))
|
||||
File diff suppressed because it is too large
Load Diff
743
spec/parser.sx
743
spec/parser.sx
@@ -14,13 +14,15 @@
|
||||
;; list → '(' expr* ')'
|
||||
;; vector → '[' expr* ']' (sugar for list)
|
||||
;; map → '{' (key expr)* '}'
|
||||
;; atom → string | number | keyword | symbol | boolean | nil
|
||||
;; atom → string | number | rational | keyword | symbol | boolean | nil | char
|
||||
;; string → '"' (char | escape)* '"'
|
||||
;; number → '-'? digit+ ('.' digit+)? ([eE] [+-]? digit+)?
|
||||
;; rational → integer '/' digit+
|
||||
;; keyword → ':' ident
|
||||
;; symbol → ident
|
||||
;; boolean → 'true' | 'false'
|
||||
;; nil → 'nil'
|
||||
;; char → '#\' (ident | single-char)
|
||||
;; ident → ident-start ident-char*
|
||||
;; comment → ';' to end of line (discarded)
|
||||
;;
|
||||
@@ -34,6 +36,8 @@
|
||||
;; #;expr → datum comment (read and discard expr)
|
||||
;; #|raw chars| → raw string literal (no escape processing)
|
||||
;; #'expr → (quote expr)
|
||||
;; #\a → character literal (char value)
|
||||
;; #\space → named character (space = 32)
|
||||
;; #name expr → extensible dispatch (calls registered handler)
|
||||
;;
|
||||
;; Platform interface (each target implements natively):
|
||||
@@ -42,6 +46,11 @@
|
||||
;; (make-symbol name) → Symbol value
|
||||
;; (make-keyword name) → Keyword value
|
||||
;; (escape-string s) → string with " and \ escaped for serialization
|
||||
;; (make-char n) → Char value from Unicode codepoint
|
||||
;; (make-rational n d) → Rational value (auto-reduced by GCD)
|
||||
;; (char->integer c) → Unicode codepoint of char c
|
||||
;; (char-from-code n) → single-char string from codepoint
|
||||
;; (char-code s) → codepoint of first char in string s
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
@@ -51,308 +60,436 @@
|
||||
;; Returns a list of top-level AST expressions.
|
||||
|
||||
;; Parse SX source string into AST
|
||||
(define sx-parse :effects []
|
||||
(fn ((source :as string))
|
||||
(let ((pos 0)
|
||||
(len-src (len source)))
|
||||
|
||||
;; -- Cursor helpers (closure over pos, source, len-src) --
|
||||
|
||||
(define skip-comment :effects []
|
||||
(fn ()
|
||||
(when (and (< pos len-src) (not (= (nth source pos) "\n")))
|
||||
(define
|
||||
sx-parse
|
||||
:effects ()
|
||||
(fn
|
||||
((source :as string))
|
||||
(let
|
||||
((pos 0) (len-src (len source)))
|
||||
(define
|
||||
skip-comment
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and (< pos len-src) (not (= (nth source pos) "\n")))
|
||||
(set! pos (inc pos))
|
||||
(skip-comment))))
|
||||
|
||||
(define skip-ws :effects []
|
||||
(fn ()
|
||||
(when (< pos len-src)
|
||||
(let ((ch (nth source pos)))
|
||||
(define
|
||||
skip-ws
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(< pos len-src)
|
||||
(let
|
||||
((ch (nth source pos)))
|
||||
(cond
|
||||
;; Whitespace
|
||||
(or (= ch " ") (= ch "\t") (= ch "\n") (= ch "\r"))
|
||||
(do (set! pos (inc pos)) (skip-ws))
|
||||
;; Comment — skip to end of line
|
||||
(do (set! pos (inc pos)) (skip-ws))
|
||||
(= ch ";")
|
||||
(do (set! pos (inc pos))
|
||||
(skip-comment)
|
||||
(skip-ws))
|
||||
;; Not whitespace or comment — stop
|
||||
(do (set! pos (inc pos)) (skip-comment) (skip-ws))
|
||||
:else nil)))))
|
||||
|
||||
;; -- Atom readers --
|
||||
|
||||
(define hex-digit-value :effects []
|
||||
(define
|
||||
hex-digit-value
|
||||
:effects ()
|
||||
(fn (ch) (index-of "0123456789abcdef" (lower ch))))
|
||||
|
||||
(define read-string :effects []
|
||||
(fn ()
|
||||
(set! pos (inc pos)) ;; skip opening "
|
||||
(let ((buf ""))
|
||||
(define read-str-loop :effects []
|
||||
(fn ()
|
||||
(if (>= pos len-src)
|
||||
(define
|
||||
read-string
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(set! pos (inc pos))
|
||||
(let
|
||||
((buf ""))
|
||||
(define
|
||||
read-str-loop
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(>= pos len-src)
|
||||
(error "Unterminated string")
|
||||
(let ((ch (nth source pos)))
|
||||
(let
|
||||
((ch (nth source pos)))
|
||||
(cond
|
||||
(= ch "\"")
|
||||
(do (set! pos (inc pos)) nil) ;; done
|
||||
(do (set! pos (inc pos)) nil)
|
||||
(= ch "\\")
|
||||
(do (set! pos (inc pos))
|
||||
(let ((esc (nth source pos)))
|
||||
(if (= esc "u")
|
||||
;; Unicode escape: \uXXXX → char
|
||||
(do (set! pos (inc pos))
|
||||
(let ((d0 (hex-digit-value (nth source pos)))
|
||||
(_ (set! pos (inc pos)))
|
||||
(d1 (hex-digit-value (nth source pos)))
|
||||
(_ (set! pos (inc pos)))
|
||||
(d2 (hex-digit-value (nth source pos)))
|
||||
(_ (set! pos (inc pos)))
|
||||
(d3 (hex-digit-value (nth source pos)))
|
||||
(_ (set! pos (inc pos))))
|
||||
(set! buf (str buf (char-from-code
|
||||
(+ (* d0 4096) (* d1 256) (* d2 16) d3))))
|
||||
(read-str-loop)))
|
||||
;; Standard escapes: \n \t \r or literal
|
||||
(do (set! buf (str buf
|
||||
(cond
|
||||
(= esc "n") "\n"
|
||||
(= esc "t") "\t"
|
||||
(= esc "r") "\r"
|
||||
:else esc)))
|
||||
(set! pos (inc pos))
|
||||
(read-str-loop)))))
|
||||
:else
|
||||
(do (set! buf (str buf ch))
|
||||
(set! pos (inc pos))
|
||||
(read-str-loop)))))))
|
||||
(do
|
||||
(set! pos (inc pos))
|
||||
(let
|
||||
((esc (nth source pos)))
|
||||
(if
|
||||
(= esc "u")
|
||||
(do
|
||||
(set! pos (inc pos))
|
||||
(let
|
||||
((d0 (hex-digit-value (nth source pos)))
|
||||
(_ (set! pos (inc pos)))
|
||||
(d1 (hex-digit-value (nth source pos)))
|
||||
(_ (set! pos (inc pos)))
|
||||
(d2 (hex-digit-value (nth source pos)))
|
||||
(_ (set! pos (inc pos)))
|
||||
(d3 (hex-digit-value (nth source pos)))
|
||||
(_ (set! pos (inc pos))))
|
||||
(set!
|
||||
buf
|
||||
(str
|
||||
buf
|
||||
(char-from-code
|
||||
(+
|
||||
(* d0 4096)
|
||||
(* d1 256)
|
||||
(* d2 16)
|
||||
d3))))
|
||||
(read-str-loop)))
|
||||
(do
|
||||
(set!
|
||||
buf
|
||||
(str
|
||||
buf
|
||||
(cond
|
||||
(= esc "n")
|
||||
"\n"
|
||||
(= esc "t")
|
||||
"\t"
|
||||
(= esc "r")
|
||||
"\r"
|
||||
:else esc)))
|
||||
(set! pos (inc pos))
|
||||
(read-str-loop)))))
|
||||
:else (do
|
||||
(set! buf (str buf ch))
|
||||
(set! pos (inc pos))
|
||||
(read-str-loop)))))))
|
||||
(read-str-loop)
|
||||
buf)))
|
||||
|
||||
(define read-ident :effects []
|
||||
(fn ()
|
||||
(let ((start pos))
|
||||
(define read-ident-loop :effects []
|
||||
(fn ()
|
||||
(when (and (< pos len-src)
|
||||
(ident-char? (nth source pos)))
|
||||
(define
|
||||
read-ident
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((start pos))
|
||||
(define
|
||||
read-ident-loop
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and (< pos len-src) (ident-char? (nth source pos)))
|
||||
(set! pos (inc pos))
|
||||
(read-ident-loop))))
|
||||
(read-ident-loop)
|
||||
(slice source start pos))))
|
||||
|
||||
(define read-keyword :effects []
|
||||
(fn ()
|
||||
(set! pos (inc pos)) ;; skip :
|
||||
(make-keyword (read-ident))))
|
||||
|
||||
(define read-number :effects []
|
||||
(fn ()
|
||||
(let ((start pos))
|
||||
;; Optional leading minus
|
||||
(when (and (< pos len-src) (= (nth source pos) "-"))
|
||||
(define
|
||||
read-keyword
|
||||
:effects ()
|
||||
(fn () (set! pos (inc pos)) (make-keyword (read-ident))))
|
||||
(define
|
||||
read-number
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((start pos))
|
||||
(when
|
||||
(and (< pos len-src) (= (nth source pos) "-"))
|
||||
(set! pos (inc pos)))
|
||||
;; Integer digits
|
||||
(define read-digits :effects []
|
||||
(fn ()
|
||||
(when (and (< pos len-src)
|
||||
(let ((c (nth source pos)))
|
||||
(and (>= c "0") (<= c "9"))))
|
||||
(define
|
||||
read-digits
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and
|
||||
(< pos len-src)
|
||||
(let
|
||||
((c (nth source pos)))
|
||||
(and (>= c "0") (<= c "9"))))
|
||||
(set! pos (inc pos))
|
||||
(read-digits))))
|
||||
(read-digits)
|
||||
;; Decimal part
|
||||
(when (and (< pos len-src) (= (nth source pos) "."))
|
||||
(set! pos (inc pos))
|
||||
(read-digits))
|
||||
;; Exponent
|
||||
(when (and (< pos len-src)
|
||||
(or (= (nth source pos) "e")
|
||||
(= (nth source pos) "E")))
|
||||
(set! pos (inc pos))
|
||||
(when (and (< pos len-src)
|
||||
(or (= (nth source pos) "+")
|
||||
(= (nth source pos) "-")))
|
||||
(set! pos (inc pos)))
|
||||
(read-digits))
|
||||
(parse-number (slice source start pos)))))
|
||||
|
||||
(define read-symbol :effects []
|
||||
(fn ()
|
||||
(let ((name (read-ident)))
|
||||
(if
|
||||
(and
|
||||
(< pos len-src)
|
||||
(= (nth source pos) "/")
|
||||
(< (inc pos) len-src)
|
||||
(let
|
||||
((nc (nth source (inc pos))))
|
||||
(and (>= nc "0") (<= nc "9"))))
|
||||
(let
|
||||
((numer (parse-number (slice source start pos))))
|
||||
(set! pos (inc pos))
|
||||
(let
|
||||
((denom-start pos))
|
||||
(read-digits)
|
||||
(make-rational
|
||||
numer
|
||||
(parse-number (slice source denom-start pos)))))
|
||||
(do
|
||||
(when
|
||||
(and (< pos len-src) (= (nth source pos) "."))
|
||||
(set! pos (inc pos))
|
||||
(read-digits))
|
||||
(when
|
||||
(and
|
||||
(< pos len-src)
|
||||
(or (= (nth source pos) "e") (= (nth source pos) "E")))
|
||||
(set! pos (inc pos))
|
||||
(when
|
||||
(and
|
||||
(< pos len-src)
|
||||
(or
|
||||
(= (nth source pos) "+")
|
||||
(= (nth source pos) "-")))
|
||||
(set! pos (inc pos)))
|
||||
(read-digits))
|
||||
(parse-number (slice source start pos)))))))
|
||||
(define
|
||||
read-symbol
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (read-ident)))
|
||||
(cond
|
||||
(= name "true") true
|
||||
(= name "false") false
|
||||
(= name "nil") nil
|
||||
:else (make-symbol name)))))
|
||||
|
||||
;; -- Composite readers --
|
||||
|
||||
(define read-list :effects []
|
||||
(fn ((close-ch :as string))
|
||||
(let ((items (list)))
|
||||
(define read-list-loop :effects []
|
||||
(fn ()
|
||||
(= name "true")
|
||||
true
|
||||
(= name "false")
|
||||
false
|
||||
(= name "nil")
|
||||
nil
|
||||
:else (make-symbol name)))))
|
||||
(define
|
||||
read-list
|
||||
:effects ()
|
||||
(fn
|
||||
((close-ch :as string))
|
||||
(let
|
||||
((items (list)))
|
||||
(define
|
||||
read-list-loop
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(skip-ws)
|
||||
(if (>= pos len-src)
|
||||
(if
|
||||
(>= pos len-src)
|
||||
(error "Unterminated list")
|
||||
(if (= (nth source pos) close-ch)
|
||||
(do (set! pos (inc pos)) nil) ;; done
|
||||
(do (append! items (read-expr))
|
||||
(read-list-loop))))))
|
||||
(if
|
||||
(= (nth source pos) close-ch)
|
||||
(do (set! pos (inc pos)) nil)
|
||||
(do (append! items (read-expr)) (read-list-loop))))))
|
||||
(read-list-loop)
|
||||
items)))
|
||||
|
||||
(define read-map :effects []
|
||||
(fn ()
|
||||
(let ((result (dict)))
|
||||
(define read-map-loop :effects []
|
||||
(fn ()
|
||||
(define
|
||||
read-map
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((result (dict)))
|
||||
(define
|
||||
read-map-loop
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(skip-ws)
|
||||
(if (>= pos len-src)
|
||||
(if
|
||||
(>= pos len-src)
|
||||
(error "Unterminated map")
|
||||
(if (= (nth source pos) "}")
|
||||
(do (set! pos (inc pos)) nil) ;; done
|
||||
(let ((key-expr (read-expr))
|
||||
(key-str (if (= (type-of key-expr) "keyword")
|
||||
(keyword-name key-expr)
|
||||
(str key-expr)))
|
||||
(val-expr (read-expr)))
|
||||
(if
|
||||
(= (nth source pos) "}")
|
||||
(do (set! pos (inc pos)) nil)
|
||||
(let
|
||||
((key-expr (read-expr))
|
||||
(key-str
|
||||
(if
|
||||
(= (type-of key-expr) "keyword")
|
||||
(keyword-name key-expr)
|
||||
(str key-expr)))
|
||||
(val-expr (read-expr)))
|
||||
(dict-set! result key-str val-expr)
|
||||
(read-map-loop))))))
|
||||
(read-map-loop)
|
||||
result)))
|
||||
|
||||
;; -- Raw string reader (for #|...|) --
|
||||
|
||||
(define read-raw-string :effects []
|
||||
(fn ()
|
||||
(let ((buf ""))
|
||||
(define raw-loop :effects []
|
||||
(fn ()
|
||||
(if (>= pos len-src)
|
||||
(define
|
||||
read-raw-string
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((buf ""))
|
||||
(define
|
||||
raw-loop
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(>= pos len-src)
|
||||
(error "Unterminated raw string")
|
||||
(let ((ch (nth source pos)))
|
||||
(if (= ch "|")
|
||||
(do (set! pos (inc pos)) nil) ;; done
|
||||
(do (set! buf (str buf ch))
|
||||
(set! pos (inc pos))
|
||||
(raw-loop)))))))
|
||||
(let
|
||||
((ch (nth source pos)))
|
||||
(if
|
||||
(= ch "|")
|
||||
(do (set! pos (inc pos)) nil)
|
||||
(do
|
||||
(set! buf (str buf ch))
|
||||
(set! pos (inc pos))
|
||||
(raw-loop)))))))
|
||||
(raw-loop)
|
||||
buf)))
|
||||
|
||||
;; -- Main expression reader --
|
||||
|
||||
(define read-expr :effects []
|
||||
(fn ()
|
||||
(define
|
||||
read-char-literal
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(>= pos len-src)
|
||||
(error "Unexpected end of input after #\\")
|
||||
(let
|
||||
((first-ch (nth source pos)))
|
||||
(if
|
||||
(ident-start? first-ch)
|
||||
(let
|
||||
((char-start pos))
|
||||
(define
|
||||
read-char-name-loop
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and (< pos len-src) (ident-char? (nth source pos)))
|
||||
(set! pos (inc pos))
|
||||
(read-char-name-loop))))
|
||||
(read-char-name-loop)
|
||||
(let
|
||||
((char-name (slice source char-start pos)))
|
||||
(make-char
|
||||
(cond
|
||||
(= char-name "space")
|
||||
32
|
||||
(= char-name "newline")
|
||||
10
|
||||
(= char-name "tab")
|
||||
9
|
||||
(= char-name "nul")
|
||||
0
|
||||
(= char-name "null")
|
||||
0
|
||||
(= char-name "return")
|
||||
13
|
||||
(= char-name "escape")
|
||||
27
|
||||
(= char-name "delete")
|
||||
127
|
||||
(= char-name "backspace")
|
||||
8
|
||||
(= char-name "altmode")
|
||||
27
|
||||
(= char-name "rubout")
|
||||
127
|
||||
:else (char-code first-ch)))))
|
||||
(do (set! pos (inc pos)) (make-char (char-code first-ch))))))))
|
||||
(define
|
||||
read-expr
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(skip-ws)
|
||||
(if (>= pos len-src)
|
||||
(if
|
||||
(>= pos len-src)
|
||||
(error "Unexpected end of input")
|
||||
(let ((ch (nth source pos)))
|
||||
(let
|
||||
((ch (nth source pos)))
|
||||
(cond
|
||||
;; Lists
|
||||
(= ch "(")
|
||||
(do (set! pos (inc pos)) (read-list ")"))
|
||||
(do (set! pos (inc pos)) (read-list ")"))
|
||||
(= ch "[")
|
||||
(do (set! pos (inc pos)) (read-list "]"))
|
||||
|
||||
;; Map
|
||||
(do (set! pos (inc pos)) (read-list "]"))
|
||||
(= ch "{")
|
||||
(do (set! pos (inc pos)) (read-map))
|
||||
|
||||
;; String
|
||||
(do (set! pos (inc pos)) (read-map))
|
||||
(= ch "\"")
|
||||
(read-string)
|
||||
|
||||
;; Keyword
|
||||
(read-string)
|
||||
(= ch ":")
|
||||
(read-keyword)
|
||||
|
||||
;; Quote sugar
|
||||
(read-keyword)
|
||||
(= ch "'")
|
||||
(do (set! pos (inc pos))
|
||||
(list (make-symbol "quote") (read-expr)))
|
||||
|
||||
;; Quasiquote sugar
|
||||
(do
|
||||
(set! pos (inc pos))
|
||||
(list (make-symbol "quote") (read-expr)))
|
||||
(= ch "`")
|
||||
(do (set! pos (inc pos))
|
||||
(list (make-symbol "quasiquote") (read-expr)))
|
||||
|
||||
;; Unquote / splice-unquote
|
||||
(do
|
||||
(set! pos (inc pos))
|
||||
(list (make-symbol "quasiquote") (read-expr)))
|
||||
(= ch ",")
|
||||
(do (set! pos (inc pos))
|
||||
(if (and (< pos len-src) (= (nth source pos) "@"))
|
||||
(do (set! pos (inc pos))
|
||||
(list (make-symbol "splice-unquote") (read-expr)))
|
||||
(list (make-symbol "unquote") (read-expr))))
|
||||
|
||||
;; Reader macros: #
|
||||
(do
|
||||
(set! pos (inc pos))
|
||||
(if
|
||||
(and (< pos len-src) (= (nth source pos) "@"))
|
||||
(do
|
||||
(set! pos (inc pos))
|
||||
(list (make-symbol "splice-unquote") (read-expr)))
|
||||
(list (make-symbol "unquote") (read-expr))))
|
||||
(= ch "#")
|
||||
(do (set! pos (inc pos))
|
||||
(if (>= pos len-src)
|
||||
(error "Unexpected end of input after #")
|
||||
(let ((dispatch-ch (nth source pos)))
|
||||
(cond
|
||||
;; #; — datum comment: read and discard next expr
|
||||
(= dispatch-ch ";")
|
||||
(do (set! pos (inc pos))
|
||||
(read-expr) ;; read and discard
|
||||
(read-expr)) ;; return the NEXT expr
|
||||
|
||||
;; #| — raw string
|
||||
(= dispatch-ch "|")
|
||||
(do (set! pos (inc pos))
|
||||
(read-raw-string))
|
||||
|
||||
;; #' — quote shorthand
|
||||
(= dispatch-ch "'")
|
||||
(do (set! pos (inc pos))
|
||||
(list (make-symbol "quote") (read-expr)))
|
||||
|
||||
;; #name — extensible dispatch
|
||||
(ident-start? dispatch-ch)
|
||||
(let ((macro-name (read-ident)))
|
||||
(let ((handler (reader-macro-get macro-name)))
|
||||
(if handler
|
||||
(handler (read-expr))
|
||||
(error (str "Unknown reader macro: #" macro-name)))))
|
||||
|
||||
:else
|
||||
(error (str "Unknown reader macro: #" dispatch-ch))))))
|
||||
|
||||
;; Number (or negative number)
|
||||
(or (and (>= ch "0") (<= ch "9"))
|
||||
(and (= ch "-")
|
||||
(< (inc pos) len-src)
|
||||
(let ((next-ch (nth source (inc pos))))
|
||||
(and (>= next-ch "0") (<= next-ch "9")))))
|
||||
(read-number)
|
||||
|
||||
;; Ellipsis (... as a symbol)
|
||||
(and (= ch ".")
|
||||
(< (+ pos 2) len-src)
|
||||
(= (nth source (+ pos 1)) ".")
|
||||
(= (nth source (+ pos 2)) "."))
|
||||
(do (set! pos (+ pos 3))
|
||||
(make-symbol "..."))
|
||||
|
||||
;; Symbol (must be ident-start char)
|
||||
(do
|
||||
(set! pos (inc pos))
|
||||
(if
|
||||
(>= pos len-src)
|
||||
(error "Unexpected end of input after #")
|
||||
(let
|
||||
((dispatch-ch (nth source pos)))
|
||||
(cond
|
||||
(= dispatch-ch ";")
|
||||
(do (set! pos (inc pos)) (read-expr) (read-expr))
|
||||
(= dispatch-ch "|")
|
||||
(do (set! pos (inc pos)) (read-raw-string))
|
||||
(= dispatch-ch "'")
|
||||
(do
|
||||
(set! pos (inc pos))
|
||||
(list (make-symbol "quote") (read-expr)))
|
||||
(= dispatch-ch "\\")
|
||||
(do (set! pos (inc pos)) (read-char-literal))
|
||||
(ident-start? dispatch-ch)
|
||||
(let
|
||||
((macro-name (read-ident)))
|
||||
(let
|
||||
((handler (reader-macro-get macro-name)))
|
||||
(if
|
||||
handler
|
||||
(handler (read-expr))
|
||||
(error
|
||||
(str "Unknown reader macro: #" macro-name)))))
|
||||
:else (error (str "Unknown reader macro: #" dispatch-ch))))))
|
||||
(or
|
||||
(and (>= ch "0") (<= ch "9"))
|
||||
(and
|
||||
(= ch "-")
|
||||
(< (inc pos) len-src)
|
||||
(let
|
||||
((next-ch (nth source (inc pos))))
|
||||
(and (>= next-ch "0") (<= next-ch "9")))))
|
||||
(read-number)
|
||||
(and
|
||||
(= ch ".")
|
||||
(< (+ pos 2) len-src)
|
||||
(= (nth source (+ pos 1)) ".")
|
||||
(= (nth source (+ pos 2)) "."))
|
||||
(do (set! pos (+ pos 3)) (make-symbol "..."))
|
||||
(ident-start? ch)
|
||||
(read-symbol)
|
||||
|
||||
;; Unexpected
|
||||
:else
|
||||
(error (str "Unexpected character: " ch)))))))
|
||||
|
||||
;; -- Entry point: parse all top-level expressions --
|
||||
(let ((exprs (list)))
|
||||
(define parse-loop :effects []
|
||||
(fn ()
|
||||
(read-symbol)
|
||||
:else (error (str "Unexpected character: " ch)))))))
|
||||
(let
|
||||
((exprs (list)))
|
||||
(define
|
||||
parse-loop
|
||||
:effects ()
|
||||
(fn
|
||||
()
|
||||
(skip-ws)
|
||||
(when (< pos len-src)
|
||||
(append! exprs (read-expr))
|
||||
(parse-loop))))
|
||||
(when (< pos len-src) (append! exprs (read-expr)) (parse-loop))))
|
||||
(parse-loop)
|
||||
exprs))))
|
||||
|
||||
@@ -362,30 +499,77 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
;; Serialize AST value back to SX source
|
||||
(define sx-serialize :effects []
|
||||
(fn (val)
|
||||
(case (type-of val)
|
||||
"nil" "nil"
|
||||
"boolean" (if val "true" "false")
|
||||
"number" (str val)
|
||||
"string" (str "\"" (escape-string val) "\"")
|
||||
"symbol" (symbol-name val)
|
||||
"keyword" (str ":" (keyword-name val))
|
||||
"list" (str "(" (join " " (map sx-serialize val)) ")")
|
||||
"dict" (sx-serialize-dict val)
|
||||
"sx-expr" (sx-expr-source val)
|
||||
"spread" (str "(make-spread " (sx-serialize-dict (spread-attrs val)) ")")
|
||||
:else (str val))))
|
||||
(define
|
||||
sx-serialize
|
||||
:effects ()
|
||||
(fn
|
||||
(val)
|
||||
(case
|
||||
(type-of val)
|
||||
"nil"
|
||||
"nil"
|
||||
"boolean"
|
||||
(if val "true" "false")
|
||||
"number"
|
||||
(str val)
|
||||
"rational"
|
||||
(str (numerator val) "/" (denominator val))
|
||||
"string"
|
||||
(str "\"" (escape-string val) "\"")
|
||||
"symbol"
|
||||
(symbol-name val)
|
||||
"keyword"
|
||||
(str ":" (keyword-name val))
|
||||
"list"
|
||||
(str "(" (join " " (map sx-serialize val)) ")")
|
||||
"dict"
|
||||
(sx-serialize-dict val)
|
||||
"sx-expr"
|
||||
(sx-expr-source val)
|
||||
"spread"
|
||||
(str "(make-spread " (sx-serialize-dict (spread-attrs val)) ")")
|
||||
"char"
|
||||
(let
|
||||
((n (char->integer val)))
|
||||
(str
|
||||
"#\\"
|
||||
(cond
|
||||
(= n 32)
|
||||
"space"
|
||||
(= n 10)
|
||||
"newline"
|
||||
(= n 9)
|
||||
"tab"
|
||||
(= n 13)
|
||||
"return"
|
||||
(= n 0)
|
||||
"nul"
|
||||
(= n 27)
|
||||
"escape"
|
||||
(= n 127)
|
||||
"delete"
|
||||
(= n 8)
|
||||
"backspace"
|
||||
:else (char-from-code n))))
|
||||
:else (str val))))
|
||||
|
||||
|
||||
;; Serialize a dict to SX {:key val} format
|
||||
(define sx-serialize-dict :effects []
|
||||
(fn ((d :as dict))
|
||||
(str "{"
|
||||
(join " "
|
||||
(define
|
||||
sx-serialize-dict
|
||||
:effects ()
|
||||
(fn
|
||||
((d :as dict))
|
||||
(str
|
||||
"{"
|
||||
(join
|
||||
" "
|
||||
(reduce
|
||||
(fn ((acc :as list) (key :as string))
|
||||
(concat acc (list (str ":" key) (sx-serialize (dict-get d key)))))
|
||||
(fn
|
||||
((acc :as list) (key :as string))
|
||||
(concat
|
||||
acc
|
||||
(list (str ":" key) (sx-serialize (dict-get d key)))))
|
||||
(list)
|
||||
(keys d)))
|
||||
"}")))
|
||||
@@ -407,13 +591,18 @@
|
||||
;; True for: ident-start chars plus: 0-9 . : / # ,
|
||||
;;
|
||||
;; Constructors (provided by the SX runtime):
|
||||
;; (make-symbol name) → Symbol value
|
||||
;; (make-keyword name) → Keyword value
|
||||
;; (parse-number s) → number (int or float from string)
|
||||
;; (make-symbol name) → Symbol value
|
||||
;; (make-keyword name) → Keyword value
|
||||
;; (parse-number s) → number (int or float from string)
|
||||
;; (make-char n) → Char value from Unicode codepoint n
|
||||
;; (make-rational n d) → Rational value (auto-reduced by GCD; d=0 is an error)
|
||||
;; (char->integer c) → Unicode codepoint of char c
|
||||
;;
|
||||
;; String utilities:
|
||||
;; (escape-string s) → string with " and \ escaped
|
||||
;; (sx-expr-source e) → unwrap SxExpr to its source string
|
||||
;; (char-from-code n) → single-char string from codepoint n
|
||||
;; (char-code s) → codepoint of first char in string s
|
||||
;;
|
||||
;; Reader macro registry:
|
||||
;; (reader-macro-get name) → handler fn or nil
|
||||
|
||||
@@ -43,35 +43,35 @@
|
||||
"+"
|
||||
:params (&rest (args :as number))
|
||||
:returns "number"
|
||||
:doc "Sum all arguments."
|
||||
:doc "Sum all arguments. Returns integer iff all args are exact integers (float contagion)."
|
||||
:body (reduce (fn (a b) (native-add a b)) 0 args))
|
||||
|
||||
(define-primitive
|
||||
"-"
|
||||
:params ((a :as number) &rest (b :as number))
|
||||
:returns "number"
|
||||
:doc "Subtract. Unary: negate. Binary: a - b."
|
||||
:doc "Subtract. Unary: negate. Binary: a - b. Float contagion: returns integer iff all args are integers."
|
||||
:body (if (empty? b) (native-neg a) (native-sub a (first b))))
|
||||
|
||||
(define-primitive
|
||||
"*"
|
||||
:params (&rest (args :as number))
|
||||
:returns "number"
|
||||
:doc "Multiply all arguments."
|
||||
:doc "Multiply all arguments. Float contagion: integer result iff all args are exact integers."
|
||||
:body (reduce (fn (a b) (native-mul a b)) 1 args))
|
||||
|
||||
(define-primitive
|
||||
"/"
|
||||
:params ((a :as number) (b :as number))
|
||||
:returns "number"
|
||||
:doc "Divide a by b."
|
||||
:returns "float"
|
||||
:doc "Divide a by b. Always returns inexact float."
|
||||
:body (native-div a b))
|
||||
|
||||
(define-primitive
|
||||
"mod"
|
||||
:params ((a :as number) (b :as number))
|
||||
:returns "number"
|
||||
:doc "Modulo a % b."
|
||||
:doc "Modulo a % b. Returns integer iff both args are integers."
|
||||
:body (native-mod a b))
|
||||
|
||||
(define-primitive
|
||||
@@ -108,26 +108,26 @@
|
||||
(define-primitive
|
||||
"floor"
|
||||
:params ((x :as number))
|
||||
:returns "number"
|
||||
:doc "Floor to integer.")
|
||||
:returns "integer"
|
||||
:doc "Floor toward negative infinity — returns exact integer.")
|
||||
|
||||
(define-primitive
|
||||
"ceil"
|
||||
:params ((x :as number))
|
||||
:returns "number"
|
||||
:doc "Ceiling to integer.")
|
||||
:returns "integer"
|
||||
:doc "Ceiling toward positive infinity — returns exact integer.")
|
||||
|
||||
(define-primitive
|
||||
"round"
|
||||
:params ((x :as number) &rest (ndigits :as number))
|
||||
:returns "number"
|
||||
:doc "Round to ndigits decimal places (default 0).")
|
||||
:doc "Round to ndigits decimal places (default 0). Returns integer when ndigits is 0.")
|
||||
|
||||
(define-primitive
|
||||
"truncate"
|
||||
:params (((x :as number)))
|
||||
:returns "number"
|
||||
:doc "Truncate toward zero.")
|
||||
:params ((x :as number))
|
||||
:returns "integer"
|
||||
:doc "Truncate toward zero — returns exact integer.")
|
||||
|
||||
(define-primitive
|
||||
"remainder"
|
||||
@@ -143,42 +143,42 @@
|
||||
|
||||
(define-primitive
|
||||
"exact?"
|
||||
:params (((x :as number)))
|
||||
:params ((x :as number))
|
||||
:returns "boolean"
|
||||
:doc "True if x is exact (integer-valued).")
|
||||
:doc "True if x is an exact integer (not an inexact float).")
|
||||
|
||||
(define-primitive
|
||||
"inexact?"
|
||||
:params (((x :as number)))
|
||||
:params ((x :as number))
|
||||
:returns "boolean"
|
||||
:doc "True if x is inexact (non-integer).")
|
||||
:doc "True if x is an inexact float (not an exact integer).")
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Core — Comparison
|
||||
;; --------------------------------------------------------------------------
|
||||
(define-primitive
|
||||
"exact->inexact"
|
||||
:params (((x :as number)))
|
||||
:returns "number"
|
||||
:doc "Convert exact to inexact (identity for float tower).")
|
||||
:params ((x :as number))
|
||||
:returns "float"
|
||||
:doc "Convert exact integer to inexact float. Floats pass through unchanged.")
|
||||
|
||||
(define-primitive
|
||||
"inexact->exact"
|
||||
:params (((x :as number)))
|
||||
:returns "number"
|
||||
:doc "Convert inexact to nearest exact integer.")
|
||||
:params ((x :as number))
|
||||
:returns "integer"
|
||||
:doc "Convert inexact float to nearest exact integer (truncates). Integers pass through unchanged.")
|
||||
|
||||
(define-primitive
|
||||
"make-vector"
|
||||
:params ((n :as number))
|
||||
:params ((n :as number) (fill :as any :optional true))
|
||||
:returns "vector"
|
||||
:doc "Create vector of size n, optionally filled.")
|
||||
:doc "Create vector of length n, each element initialised to fill (default nil).")
|
||||
|
||||
(define-primitive
|
||||
"vector"
|
||||
:params ()
|
||||
:params (:rest (elts :as any))
|
||||
:returns "vector"
|
||||
:doc "Create vector from arguments.")
|
||||
:doc "Construct a vector from its arguments.")
|
||||
|
||||
(define-primitive
|
||||
"vector?"
|
||||
@@ -190,31 +190,31 @@
|
||||
"vector-length"
|
||||
:params ((v :as vector))
|
||||
:returns "number"
|
||||
:doc "Number of elements.")
|
||||
:doc "Number of elements in vector v.")
|
||||
|
||||
(define-primitive
|
||||
"vector-ref"
|
||||
:params ((v :as vector) (i :as number))
|
||||
:returns "any"
|
||||
:doc "Element at index.")
|
||||
:doc "Element at 0-based index i. Error if out of bounds.")
|
||||
|
||||
(define-primitive
|
||||
"vector-set!"
|
||||
:params ((v :as vector) (i :as number) (val :as any))
|
||||
:returns "nil"
|
||||
:doc "Set element at index.")
|
||||
:doc "Mutate element at index i to val. Error if out of bounds.")
|
||||
|
||||
(define-primitive
|
||||
"vector->list"
|
||||
:params ((v :as vector))
|
||||
:returns "list"
|
||||
:doc "Convert vector to list.")
|
||||
:doc "Convert vector to a fresh list.")
|
||||
|
||||
(define-primitive
|
||||
"list->vector"
|
||||
:params ((l :as list))
|
||||
:returns "vector"
|
||||
:doc "Convert list to vector.")
|
||||
:doc "Convert list to a fresh vector.")
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Core — Predicates
|
||||
@@ -223,13 +223,15 @@
|
||||
"vector-fill!"
|
||||
:params ((v :as vector) (val :as any))
|
||||
:returns "nil"
|
||||
:doc "Fill all elements.")
|
||||
:doc "Set every element of v to val in place.")
|
||||
|
||||
(define-primitive
|
||||
"vector-copy"
|
||||
:params ((v :as vector))
|
||||
:params ((v :as vector)
|
||||
(start :as number :optional true)
|
||||
(end :as number :optional true))
|
||||
:returns "vector"
|
||||
:doc "Independent shallow copy.")
|
||||
:doc "Shallow copy of vector, optionally sliced from start (inclusive) to end (exclusive).")
|
||||
|
||||
(define-primitive
|
||||
"min"
|
||||
@@ -372,8 +374,20 @@
|
||||
"number?"
|
||||
:params (x)
|
||||
:returns "boolean"
|
||||
:doc "True if x is a number (int or float)."
|
||||
:body (= (type-of x) "number"))
|
||||
:doc "True if x is any number — exact integer or inexact float."
|
||||
:body (or (= (type-of x) "number") (integer? x)))
|
||||
|
||||
(define-primitive
|
||||
"integer?"
|
||||
:params (x)
|
||||
:returns "boolean"
|
||||
:doc "True if x is an exact integer, or a float with no fractional part (e.g. 1.0).")
|
||||
|
||||
(define-primitive
|
||||
"float?"
|
||||
:params (x)
|
||||
:returns "boolean"
|
||||
:doc "True if x is an inexact float (Number type). Does not match exact integers.")
|
||||
|
||||
(define-primitive
|
||||
"string?"
|
||||
@@ -478,6 +492,12 @@
|
||||
:returns "string"
|
||||
:doc "Convert Unicode code point to single-character string.")
|
||||
|
||||
(define-primitive
|
||||
"char-code"
|
||||
:params ((s :as string))
|
||||
:returns "number"
|
||||
:doc "Unicode codepoint of the first character of string s.")
|
||||
|
||||
(define-primitive
|
||||
"substring"
|
||||
:params ((s :as string) (start :as number) (end :as number))
|
||||
@@ -532,15 +552,15 @@
|
||||
:returns "boolean"
|
||||
:doc "True if string s starts with prefix.")
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Core — Dict operations
|
||||
;; --------------------------------------------------------------------------
|
||||
(define-primitive
|
||||
"ends-with?"
|
||||
:params ((s :as string) (suffix :as string))
|
||||
:returns "boolean"
|
||||
:doc "True if string s ends with suffix.")
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Core — Dict operations
|
||||
;; --------------------------------------------------------------------------
|
||||
(define-module :core.collections)
|
||||
|
||||
(define-primitive
|
||||
@@ -585,15 +605,15 @@
|
||||
:returns "any"
|
||||
:doc "Last element, or nil if empty.")
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Stdlib — Format
|
||||
;; --------------------------------------------------------------------------
|
||||
(define-primitive
|
||||
"rest"
|
||||
:params ((coll :as list))
|
||||
:returns "list"
|
||||
:doc "All elements except the first.")
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Stdlib — Format
|
||||
;; --------------------------------------------------------------------------
|
||||
(define-primitive
|
||||
"nth"
|
||||
:params ((coll :as list) (n :as number))
|
||||
@@ -618,15 +638,15 @@
|
||||
:returns "list"
|
||||
:doc "Mutate coll by appending x in-place. Returns coll.")
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Stdlib — Text
|
||||
;; --------------------------------------------------------------------------
|
||||
(define-primitive
|
||||
"reverse"
|
||||
:params ((coll :as list))
|
||||
:returns "list"
|
||||
:doc "Return coll in reverse order.")
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Stdlib — Text
|
||||
;; --------------------------------------------------------------------------
|
||||
(define-primitive
|
||||
"flatten"
|
||||
:params ((coll :as list))
|
||||
@@ -645,29 +665,29 @@
|
||||
:returns "list"
|
||||
:doc "Consecutive pairs: (1 2 3 4) → ((1 2) (2 3) (3 4)).")
|
||||
|
||||
(define-module :core.dict)
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Stdlib — Style
|
||||
;; --------------------------------------------------------------------------
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Stdlib — Debug
|
||||
;; --------------------------------------------------------------------------
|
||||
(define-module :core.dict)
|
||||
|
||||
(define-primitive
|
||||
"keys"
|
||||
:params ((d :as dict))
|
||||
:returns "list"
|
||||
:doc "List of dict keys.")
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Type introspection — platform primitives
|
||||
;; --------------------------------------------------------------------------
|
||||
(define-primitive
|
||||
"vals"
|
||||
:params ((d :as dict))
|
||||
:returns "list"
|
||||
:doc "List of dict values.")
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Type introspection — platform primitives
|
||||
;; --------------------------------------------------------------------------
|
||||
(define-primitive
|
||||
"merge"
|
||||
:params (&rest (dicts :as dict))
|
||||
@@ -783,3 +803,532 @@
|
||||
:params ((source :as string))
|
||||
:returns "list"
|
||||
:doc "Parse SX source string into a list of AST expressions.")
|
||||
|
||||
(define-primitive
|
||||
"make-string-buffer"
|
||||
:params ()
|
||||
:returns "string-buffer"
|
||||
:doc "Create a new empty mutable string buffer for O(1) amortised append.")
|
||||
|
||||
(define-module :stdlib.coroutines)
|
||||
|
||||
(define-module :stdlib.bitwise)
|
||||
|
||||
(define-primitive
|
||||
"bitwise-and"
|
||||
:params (((a :as number) (b :as number)))
|
||||
:returns "number"
|
||||
:doc "Bitwise AND of two integers.")
|
||||
|
||||
(define-primitive
|
||||
"bitwise-or"
|
||||
:params (((a :as number) (b :as number)))
|
||||
:returns "number"
|
||||
:doc "Bitwise OR of two integers.")
|
||||
|
||||
(define-primitive
|
||||
"bitwise-xor"
|
||||
:params (((a :as number) (b :as number)))
|
||||
:returns "number"
|
||||
:doc "Bitwise XOR of two integers.")
|
||||
|
||||
(define-primitive
|
||||
"bitwise-not"
|
||||
:params ((a :as number))
|
||||
:returns "number"
|
||||
:doc "Bitwise NOT (one's complement) of an integer.")
|
||||
|
||||
(define-primitive
|
||||
"arithmetic-shift"
|
||||
:params (((a :as number) (count :as number)))
|
||||
:returns "number"
|
||||
:doc "Arithmetic shift: left if count > 0, right if count < 0.")
|
||||
|
||||
(define-primitive
|
||||
"bit-count"
|
||||
:params ((a :as number))
|
||||
:returns "number"
|
||||
:doc "Count set bits (popcount) in a non-negative integer.")
|
||||
|
||||
(define-primitive
|
||||
"integer-length"
|
||||
:params ((a :as number))
|
||||
:returns "number"
|
||||
:doc "Number of bits needed to represent integer a (excluding sign).")
|
||||
|
||||
(define-module :stdlib.ports)
|
||||
|
||||
(define-primitive
|
||||
"eof-object"
|
||||
:params ()
|
||||
:returns "eof-object"
|
||||
:doc "The EOF sentinel value.")
|
||||
|
||||
(define-primitive
|
||||
"eof-object?"
|
||||
:params (v)
|
||||
:returns "boolean"
|
||||
:doc "True if v is the EOF sentinel.")
|
||||
|
||||
(define-primitive
|
||||
"open-input-string"
|
||||
:params ((s :as string))
|
||||
:returns "input-port"
|
||||
:doc "Open a string as an input port.")
|
||||
|
||||
(define-primitive
|
||||
"open-output-string"
|
||||
:params ()
|
||||
:returns "output-port"
|
||||
:doc "Open a fresh output string port.")
|
||||
|
||||
(define-primitive
|
||||
"get-output-string"
|
||||
:params ((p :as output-port))
|
||||
:returns "string"
|
||||
:doc "Flush output port contents to a string.")
|
||||
|
||||
(define-primitive
|
||||
"port?"
|
||||
:params (v)
|
||||
:returns "boolean"
|
||||
:doc "True if v is any port.")
|
||||
|
||||
(define-primitive
|
||||
"input-port?"
|
||||
:params (v)
|
||||
:returns "boolean"
|
||||
:doc "True if v is an input port.")
|
||||
|
||||
(define-primitive
|
||||
"output-port?"
|
||||
:params (v)
|
||||
:returns "boolean"
|
||||
:doc "True if v is an output port.")
|
||||
|
||||
(define-primitive
|
||||
"close-port"
|
||||
:params ((p :as port))
|
||||
:returns "nil"
|
||||
:doc "Close a port.")
|
||||
|
||||
(define-primitive
|
||||
"read-char"
|
||||
:params (&rest (p :as input-port))
|
||||
:returns "any"
|
||||
:doc "Read next char from port; returns eof-object at end.")
|
||||
|
||||
(define-primitive
|
||||
"peek-char"
|
||||
:params (&rest (p :as input-port))
|
||||
:returns "any"
|
||||
:doc "Peek next char without consuming; returns eof-object at end.")
|
||||
|
||||
(define-primitive
|
||||
"read-line"
|
||||
:params (&rest (p :as input-port))
|
||||
:returns "any"
|
||||
:doc "Read a line from port; returns eof-object at end.")
|
||||
|
||||
(define-primitive
|
||||
"write-char"
|
||||
:params ((c :as char) &rest (p :as output-port))
|
||||
:returns "nil"
|
||||
:doc "Write a char to output port.")
|
||||
|
||||
(define-primitive
|
||||
"write-string"
|
||||
:params ((s :as string) &rest (p :as output-port))
|
||||
:returns "nil"
|
||||
:doc "Write a string to output port.")
|
||||
|
||||
(define-primitive
|
||||
"char-ready?"
|
||||
:params (&rest (p :as input-port))
|
||||
:returns "boolean"
|
||||
:doc "True if a char is immediately available on the port.")
|
||||
|
||||
|
||||
(define-primitive
|
||||
"read"
|
||||
:params (&rest (p :as input-port))
|
||||
:returns "any"
|
||||
:doc "Read one datum from port; returns eof-object at end.")
|
||||
|
||||
(define-primitive
|
||||
"write"
|
||||
:params (v &rest (p :as output-port))
|
||||
:returns "nil"
|
||||
:doc "Serialize v to port with quoting — strings quoted, chars as #\\a notation.")
|
||||
|
||||
(define-primitive
|
||||
"display"
|
||||
:params (v &rest (p :as output-port))
|
||||
:returns "nil"
|
||||
:doc "Serialize v to port without quoting — strings unquoted, chars as characters.")
|
||||
|
||||
(define-primitive
|
||||
"newline"
|
||||
:params (&rest (p :as output-port))
|
||||
:returns "nil"
|
||||
:doc "Write a newline to port.")
|
||||
|
||||
(define-primitive
|
||||
"write-to-string"
|
||||
:params (v)
|
||||
:returns "string"
|
||||
:doc "Serialize v with write quoting, return as string.")
|
||||
|
||||
(define-primitive
|
||||
"display-to-string"
|
||||
:params (v)
|
||||
:returns "string"
|
||||
:doc "Serialize v with display format, return as string.")
|
||||
|
||||
(define-primitive
|
||||
"current-input-port"
|
||||
:params ()
|
||||
:returns "any"
|
||||
:doc "Return current default input port.")
|
||||
|
||||
(define-primitive
|
||||
"current-output-port"
|
||||
:params ()
|
||||
:returns "any"
|
||||
:doc "Return current default output port.")
|
||||
|
||||
(define-primitive
|
||||
"current-error-port"
|
||||
:params ()
|
||||
:returns "any"
|
||||
:doc "Return current error port.")
|
||||
|
||||
(define-module :stdlib.math)
|
||||
|
||||
(define-primitive
|
||||
"sin"
|
||||
:params ((x :as number))
|
||||
:returns "float"
|
||||
:doc "Sine of x (radians).")
|
||||
|
||||
(define-primitive
|
||||
"cos"
|
||||
:params ((x :as number))
|
||||
:returns "float"
|
||||
:doc "Cosine of x (radians).")
|
||||
|
||||
(define-primitive
|
||||
"tan"
|
||||
:params ((x :as number))
|
||||
:returns "float"
|
||||
:doc "Tangent of x (radians).")
|
||||
|
||||
(define-primitive
|
||||
"asin"
|
||||
:params ((x :as number))
|
||||
:returns "float"
|
||||
:doc "Arc sine of x; result in radians.")
|
||||
|
||||
(define-primitive
|
||||
"acos"
|
||||
:params ((x :as number))
|
||||
:returns "float"
|
||||
:doc "Arc cosine of x; result in radians.")
|
||||
|
||||
(define-primitive
|
||||
"atan"
|
||||
:params ((x :as number) &rest (y :as number))
|
||||
:returns "float"
|
||||
:doc "Arc tangent. (atan x) → radians in (-π/2, π/2). (atan y x) → atan2(y, x).")
|
||||
|
||||
(define-primitive
|
||||
"exp"
|
||||
:params ((x :as number))
|
||||
:returns "float"
|
||||
:doc "e raised to the power x.")
|
||||
|
||||
(define-primitive
|
||||
"log"
|
||||
:params ((x :as number))
|
||||
:returns "float"
|
||||
:doc "Natural logarithm of x.")
|
||||
|
||||
(define-primitive
|
||||
"expt"
|
||||
:params ((base :as number) (exp :as number))
|
||||
:returns "number"
|
||||
:doc "base raised to the power exp. Alias: pow.")
|
||||
|
||||
(define-primitive
|
||||
"quotient"
|
||||
:params ((a :as number) (b :as number))
|
||||
:returns "integer"
|
||||
:doc "Integer quotient: truncate(a / b) toward zero. Sign follows dividend.")
|
||||
|
||||
(define-primitive
|
||||
"gcd"
|
||||
:params ((a :as number) (b :as number))
|
||||
:returns "integer"
|
||||
:doc "Greatest common divisor of a and b.")
|
||||
|
||||
(define-primitive
|
||||
"lcm"
|
||||
:params ((a :as number) (b :as number))
|
||||
:returns "integer"
|
||||
:doc "Least common multiple of a and b.")
|
||||
|
||||
(define-primitive
|
||||
"number->string"
|
||||
:params ((n :as number) &rest (radix :as number))
|
||||
:returns "string"
|
||||
:doc "Convert number n to string. Optional radix (default 10). E.g. (number->string 255 16) → \"ff\".")
|
||||
|
||||
(define-primitive
|
||||
"string->number"
|
||||
:params ((s :as string) &rest (radix :as number))
|
||||
:returns "any"
|
||||
:doc "Parse string s as a number. Optional radix (default 10). Returns nil on failure.")
|
||||
|
||||
(define-module :stdlib.rational)
|
||||
|
||||
(define-primitive
|
||||
"make-rational"
|
||||
:params (n d)
|
||||
:returns "rational"
|
||||
:doc "Rational n/d, auto-reduced by GCD. Error if d=0.")
|
||||
|
||||
(define-primitive
|
||||
"rational?"
|
||||
:params (v)
|
||||
:returns "boolean"
|
||||
:doc "True if v is a rational number.")
|
||||
|
||||
(define-primitive
|
||||
"numerator"
|
||||
:params ((r :as rational))
|
||||
:returns "integer"
|
||||
:doc "Numerator of rational r (after reduction).")
|
||||
|
||||
(define-primitive
|
||||
"denominator"
|
||||
:params ((r :as rational))
|
||||
:returns "integer"
|
||||
:doc "Denominator of rational r (after reduction, always positive).")
|
||||
|
||||
(define-module :stdlib.hash-table)
|
||||
|
||||
(define-module :stdlib.sets)
|
||||
|
||||
(define-primitive
|
||||
"make-set"
|
||||
:params (&rest (lst :as list))
|
||||
:returns "set"
|
||||
:doc "Create a fresh empty set. Optional list argument seeds the set: (make-set '(1 2 3)).")
|
||||
|
||||
(define-primitive
|
||||
"set?"
|
||||
:params (v)
|
||||
:returns "boolean"
|
||||
:doc "True if v is a set.")
|
||||
|
||||
(define-primitive
|
||||
"set-add!"
|
||||
:params (s val)
|
||||
:returns "nil"
|
||||
:doc "Add val to set s in place. No-op if already present.")
|
||||
|
||||
(define-primitive
|
||||
"set-member?"
|
||||
:params (s val)
|
||||
:returns "boolean"
|
||||
:doc "True if val is in set s.")
|
||||
|
||||
(define-primitive
|
||||
"set-remove!"
|
||||
:params (s val)
|
||||
:returns "nil"
|
||||
:doc "Remove val from set s in place. No-op if absent.")
|
||||
|
||||
(define-primitive
|
||||
"set-size"
|
||||
:params (s)
|
||||
:returns "integer"
|
||||
:doc "Number of elements in set s.")
|
||||
|
||||
(define-primitive
|
||||
"set->list"
|
||||
:params (s)
|
||||
:returns "list"
|
||||
:doc "All elements of set s as a list (unspecified order).")
|
||||
|
||||
(define-primitive
|
||||
"list->set"
|
||||
:params (lst)
|
||||
:returns "set"
|
||||
:doc "Create a new set containing all elements of lst.")
|
||||
|
||||
(define-primitive
|
||||
"set-union"
|
||||
:params (s1 s2)
|
||||
:returns "set"
|
||||
:doc "New set with all elements from s1 and s2.")
|
||||
|
||||
(define-primitive
|
||||
"set-intersection"
|
||||
:params (s1 s2)
|
||||
:returns "set"
|
||||
:doc "New set with elements present in both s1 and s2.")
|
||||
|
||||
(define-primitive
|
||||
"set-difference"
|
||||
:params (s1 s2)
|
||||
:returns "set"
|
||||
:doc "New set with elements in s1 that are not in s2.")
|
||||
|
||||
(define-primitive
|
||||
"set-for-each"
|
||||
:params (s fn)
|
||||
:returns "nil"
|
||||
:doc "Call (fn val) for each element in set s. Order unspecified.")
|
||||
|
||||
(define-primitive
|
||||
"set-map"
|
||||
:params (s fn)
|
||||
:returns "set"
|
||||
:doc "New set of results of (fn val) for each element in s.")
|
||||
|
||||
(define-module :stdlib.regexp)
|
||||
|
||||
(define-primitive
|
||||
"make-regexp"
|
||||
:params ((pattern :as string) &rest (flags :as string))
|
||||
:returns "regexp"
|
||||
:doc "Compile regexp from pattern string and optional flags string (\"i\" case-insensitive, \"m\" multiline, \"s\" dotall).")
|
||||
|
||||
(define-primitive
|
||||
"regexp?"
|
||||
:params (v)
|
||||
:returns "boolean"
|
||||
:doc "True if v is a compiled regexp.")
|
||||
|
||||
(define-primitive
|
||||
"regexp-source"
|
||||
:params ((re :as regexp))
|
||||
:returns "string"
|
||||
:doc "Pattern string of a regexp.")
|
||||
|
||||
(define-primitive
|
||||
"regexp-flags"
|
||||
:params ((re :as regexp))
|
||||
:returns "string"
|
||||
:doc "Flags string of a regexp.")
|
||||
|
||||
(define-primitive
|
||||
"regexp-match"
|
||||
:params ((re :as regexp) (str :as string))
|
||||
:returns "any"
|
||||
:doc "First match of re in str. Returns {:match \"...\" :start N :end N :groups (...)} or nil.")
|
||||
|
||||
(define-primitive
|
||||
"regexp-match-all"
|
||||
:params ((re :as regexp) (str :as string))
|
||||
:returns "list"
|
||||
:doc "All non-overlapping matches of re in str as a list of match dicts.")
|
||||
|
||||
(define-primitive
|
||||
"regexp-replace"
|
||||
:params ((re :as regexp) (str :as string) (replacement :as string))
|
||||
:returns "string"
|
||||
:doc "Replace first match of re in str with replacement. $& = whole match, $1..$9 = groups.")
|
||||
|
||||
(define-primitive
|
||||
"regexp-replace-all"
|
||||
:params ((re :as regexp) (str :as string) (replacement :as string))
|
||||
:returns "string"
|
||||
:doc "Replace all matches of re in str with replacement.")
|
||||
|
||||
(define-primitive
|
||||
"regexp-split"
|
||||
:params ((re :as regexp) (str :as string))
|
||||
:returns "list"
|
||||
:doc "Split str on every match of re; returns list of strings.")
|
||||
|
||||
(define-module :stdlib.bytevectors)
|
||||
|
||||
(define-primitive
|
||||
"make-bytevector"
|
||||
:params (n &rest fill)
|
||||
:returns "bytevector"
|
||||
:doc "Create a bytevector of n bytes, all initialised to fill (default 0).")
|
||||
|
||||
(define-primitive
|
||||
"bytevector?"
|
||||
:params (v)
|
||||
:returns "boolean"
|
||||
:doc "True if v is a bytevector.")
|
||||
|
||||
(define-primitive
|
||||
"bytevector-length"
|
||||
:params ((bv :as bytevector))
|
||||
:returns "number"
|
||||
:doc "Number of bytes in bv.")
|
||||
|
||||
(define-primitive
|
||||
"bytevector-u8-ref"
|
||||
:params ((bv :as bytevector) (i :as number))
|
||||
:returns "number"
|
||||
:doc "Byte value 0-255 at index i.")
|
||||
|
||||
(define-primitive
|
||||
"bytevector-u8-set!"
|
||||
:params ((bv :as bytevector) (i :as number) (byte :as number))
|
||||
:returns "nil"
|
||||
:doc "Set byte at index i to byte 0-255. Mutates bv.")
|
||||
|
||||
(define-primitive
|
||||
"bytevector-copy"
|
||||
:params ((bv :as bytevector) &rest bounds)
|
||||
:returns "bytevector"
|
||||
:doc "Fresh copy of bv, optionally sliced to [start, end).")
|
||||
|
||||
(define-primitive
|
||||
"bytevector-copy!"
|
||||
:params ((dst :as bytevector) (at :as number) (src :as bytevector) &rest bounds)
|
||||
:returns "nil"
|
||||
:doc "Copy bytes from src[start..end) into dst starting at at. Mutates dst.")
|
||||
|
||||
(define-primitive
|
||||
"bytevector-append"
|
||||
:params (&rest bvs)
|
||||
:returns "bytevector"
|
||||
:doc "Concatenate bytevectors into a new bytevector.")
|
||||
|
||||
(define-primitive
|
||||
"utf8->string"
|
||||
:params ((bv :as bytevector) &rest bounds)
|
||||
:returns "string"
|
||||
:doc "Decode bv[start..end) as UTF-8 and return the string.")
|
||||
|
||||
(define-primitive
|
||||
"string->utf8"
|
||||
:params ((s :as string) &rest bounds)
|
||||
:returns "bytevector"
|
||||
:doc "Encode s[start..end) as UTF-8 and return a bytevector.")
|
||||
|
||||
(define-primitive
|
||||
"bytevector->list"
|
||||
:params ((bv :as bytevector))
|
||||
:returns "list"
|
||||
:doc "Convert bytevector to a list of byte integers.")
|
||||
|
||||
(define-primitive
|
||||
"list->bytevector"
|
||||
:params ((lst :as list))
|
||||
:returns "bytevector"
|
||||
:doc "Build a bytevector from a list of byte integers 0-255.")
|
||||
|
||||
(define-primitive
|
||||
"format"
|
||||
:params ((template :as string) &rest args)
|
||||
:returns "string"
|
||||
:doc "CL-style format string. Directives: ~a display, ~s write, ~d decimal, ~x hex, ~o octal, ~b binary, ~f fixed-point, ~e scientific, ~% newline, ~& fresh-line, ~~ tilde, ~t tab. Optional first arg: output-port.")
|
||||
|
||||
134
spec/stdlib.sx
Normal file
134
spec/stdlib.sx
Normal file
@@ -0,0 +1,134 @@
|
||||
;; ==========================================================================
|
||||
;; stdlib.sx — Pure SX standard library functions
|
||||
;;
|
||||
;; Loaded by test runners after primitives. These functions are implemented
|
||||
;; in SX and require no host-specific code.
|
||||
;;
|
||||
;; IMPORTANT: SX let/when bodies evaluate only the LAST expression.
|
||||
;; Multi-step bodies must be wrapped in (do expr1 expr2 ...).
|
||||
;; ==========================================================================
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; format — CL-style string formatting
|
||||
;;
|
||||
;; Directives:
|
||||
;; ~a display (no quotes) ~s write (with quotes)
|
||||
;; ~d decimal ~x hex ~o octal ~b binary
|
||||
;; ~f fixed-point (6dp) ~% newline
|
||||
;; ~& fresh line ~~ literal tilde
|
||||
;; ~t tab
|
||||
;;
|
||||
;; Signature: (format template arg...) -> string
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define
|
||||
(format template &rest args)
|
||||
(let
|
||||
((buf (make-string-buffer)) (n (string-length template)))
|
||||
(define
|
||||
(consume-arg args)
|
||||
(if
|
||||
(nil? args)
|
||||
(list "" nil)
|
||||
(list (display-to-string (first args)) (rest args))))
|
||||
(define
|
||||
(consume-num args radix)
|
||||
(if
|
||||
(nil? args)
|
||||
(list "" nil)
|
||||
(list (number->string (first args) radix) (rest args))))
|
||||
(define
|
||||
(loop i args)
|
||||
(cond
|
||||
((>= i n) (string-buffer->string buf))
|
||||
((and (= (substring template i (+ i 1)) "~") (< (+ i 1) n))
|
||||
(let
|
||||
((dir (substring template (+ i 1) (+ i 2))))
|
||||
(cond
|
||||
((= dir "a")
|
||||
(let
|
||||
((p (consume-arg args)))
|
||||
(do
|
||||
(string-buffer-append! buf (first p))
|
||||
(loop (+ i 2) (first (rest p))))))
|
||||
((= dir "s")
|
||||
(if
|
||||
(nil? args)
|
||||
(loop (+ i 2) args)
|
||||
(do
|
||||
(string-buffer-append!
|
||||
buf
|
||||
(write-to-string (first args)))
|
||||
(loop (+ i 2) (rest args)))))
|
||||
((= dir "d")
|
||||
(let
|
||||
((p (consume-num args 10)))
|
||||
(do
|
||||
(string-buffer-append! buf (first p))
|
||||
(loop (+ i 2) (first (rest p))))))
|
||||
((= dir "x")
|
||||
(let
|
||||
((p (consume-num args 16)))
|
||||
(do
|
||||
(string-buffer-append! buf (first p))
|
||||
(loop (+ i 2) (first (rest p))))))
|
||||
((= dir "o")
|
||||
(let
|
||||
((p (consume-num args 8)))
|
||||
(do
|
||||
(string-buffer-append! buf (first p))
|
||||
(loop (+ i 2) (first (rest p))))))
|
||||
((= dir "b")
|
||||
(let
|
||||
((p (consume-num args 2)))
|
||||
(do
|
||||
(string-buffer-append! buf (first p))
|
||||
(loop (+ i 2) (first (rest p))))))
|
||||
((= dir "f")
|
||||
(if
|
||||
(nil? args)
|
||||
(loop (+ i 2) args)
|
||||
(do
|
||||
(string-buffer-append!
|
||||
buf
|
||||
(format-decimal (first args) 6))
|
||||
(loop (+ i 2) (rest args)))))
|
||||
((= dir "%")
|
||||
(do
|
||||
(string-buffer-append! buf "\n")
|
||||
(loop (+ i 2) args)))
|
||||
((= dir "&")
|
||||
(do
|
||||
(let
|
||||
((so-far (string-buffer->string buf)))
|
||||
(when
|
||||
(or
|
||||
(= (string-length so-far) 0)
|
||||
(not
|
||||
(=
|
||||
(substring
|
||||
so-far
|
||||
(- (string-length so-far) 1)
|
||||
(string-length so-far))
|
||||
"\n")))
|
||||
(string-buffer-append! buf "\n")))
|
||||
(loop (+ i 2) args)))
|
||||
((= dir "~")
|
||||
(do
|
||||
(string-buffer-append! buf "~")
|
||||
(loop (+ i 2) args)))
|
||||
((= dir "t")
|
||||
(do
|
||||
(string-buffer-append! buf "\t")
|
||||
(loop (+ i 2) args)))
|
||||
(else
|
||||
(do
|
||||
(string-buffer-append! buf "~")
|
||||
(loop (+ i 1) args))))))
|
||||
(else
|
||||
(do
|
||||
(string-buffer-append!
|
||||
buf
|
||||
(substring template i (+ i 1)))
|
||||
(loop (+ i 1) args)))))
|
||||
(loop 0 args)))
|
||||
278
spec/tests/test-adt.sx
Normal file
278
spec/tests/test-adt.sx
Normal file
@@ -0,0 +1,278 @@
|
||||
(defsuite
|
||||
"algebraic-data-types"
|
||||
(deftest
|
||||
"constructor creates dict with adt marker"
|
||||
(do
|
||||
(define-type Maybe (Just value) (Nothing))
|
||||
(assert= true (get (Just 42) :_adt))))
|
||||
(deftest
|
||||
"constructor stores type name"
|
||||
(do
|
||||
(define-type Shape (Circle radius) (Square side))
|
||||
(assert= "Shape" (get (Circle 5) :_type))
|
||||
(assert= "Shape" (get (Square 3) :_type))))
|
||||
(deftest
|
||||
"constructor stores constructor name"
|
||||
(do
|
||||
(define-type Opt (Some val) (None))
|
||||
(assert= "Some" (get (Some 1) :_ctor))
|
||||
(assert= "None" (get (None) :_ctor))))
|
||||
(deftest
|
||||
"constructor stores fields as list"
|
||||
(do
|
||||
(define-type Pair (Pair-of fst snd))
|
||||
(assert-equal
|
||||
(list 1 2)
|
||||
(get (Pair-of 1 2) :_fields))))
|
||||
(deftest
|
||||
"zero-arg constructor has empty fields"
|
||||
(do
|
||||
(define-type Flag (Set) (Unset))
|
||||
(assert-equal (list) (get (Set) :_fields))
|
||||
(assert-equal (list) (get (Unset) :_fields))))
|
||||
(deftest
|
||||
"type predicate true for all constructors"
|
||||
(do
|
||||
(define-type Expr (Num n) (Add left right) (Neg e))
|
||||
(assert= true (Expr? (Num 5)))
|
||||
(assert= true (Expr? (Add (Num 1) (Num 2))))
|
||||
(assert= true (Expr? (Neg (Num 3))))))
|
||||
(deftest
|
||||
"type predicate false for non-adt values"
|
||||
(do
|
||||
(define-type Box (Box-of x))
|
||||
(assert= false (Box? 42))
|
||||
(assert= false (Box? "hello"))
|
||||
(assert= false (Box? nil))
|
||||
(assert= false (Box? (list 1 2)))
|
||||
(assert= false (Box? {}))))
|
||||
(deftest
|
||||
"type predicate false for wrong adt type"
|
||||
(do
|
||||
(define-type AT (AV x))
|
||||
(define-type BT (BV x))
|
||||
(assert= false (AT? (BV 1)))
|
||||
(assert= false (BT? (AV 1)))))
|
||||
(deftest
|
||||
"constructor predicate true for matching constructor"
|
||||
(do
|
||||
(define-type Result (Ok value) (Err msg))
|
||||
(assert= true (Ok? (Ok 42)))
|
||||
(assert= true (Err? (Err "bad")))))
|
||||
(deftest
|
||||
"constructor predicate false for wrong constructor"
|
||||
(do
|
||||
(define-type Coin (Heads) (Tails))
|
||||
(assert= false (Heads? (Tails)))
|
||||
(assert= false (Tails? (Heads)))))
|
||||
(deftest
|
||||
"constructor predicate false for non-adt"
|
||||
(do
|
||||
(define-type Wrap (Wrapped x))
|
||||
(assert= false (Wrapped? 42))
|
||||
(assert= false (Wrapped? nil))
|
||||
(assert= false (Wrapped? "str"))))
|
||||
(deftest
|
||||
"single-field accessor returns field value"
|
||||
(do
|
||||
(define-type Holder (Held content))
|
||||
(assert= 99 (Held-content (Held 99)))
|
||||
(assert= "hello" (Held-content (Held "hello")))))
|
||||
(deftest
|
||||
"multi-field accessors return correct fields"
|
||||
(do
|
||||
(define-type Triple (Triple-of a b c))
|
||||
(let
|
||||
((t (Triple-of 10 20 30)))
|
||||
(assert= 10 (Triple-of-a t))
|
||||
(assert= 20 (Triple-of-b t))
|
||||
(assert= 30 (Triple-of-c t)))))
|
||||
(deftest
|
||||
"tree constructors and accessors"
|
||||
(do
|
||||
(define-type Tree (Leaf) (Node left val right))
|
||||
(let
|
||||
((t (Node (Leaf) 5 (Node (Leaf) 3 (Leaf)))))
|
||||
(assert= true (Node? t))
|
||||
(assert= 5 (Node-val t))
|
||||
(assert= true (Leaf? (Node-left t)))
|
||||
(assert= true (Node? (Node-right t)))
|
||||
(assert= 3 (Node-val (Node-right t))))))
|
||||
(deftest
|
||||
"arity error on too few args"
|
||||
(do
|
||||
(define-type Pair2 (Pair2-of a b))
|
||||
(let
|
||||
((ok false))
|
||||
(guard (exn (else (set! ok true))) (Pair2-of 1))
|
||||
(assert ok))))
|
||||
(deftest
|
||||
"arity error on too many args"
|
||||
(do
|
||||
(define-type Single (Single-of x))
|
||||
(let
|
||||
((ok false))
|
||||
(guard
|
||||
(exn (else (set! ok true)))
|
||||
(Single-of 1 2))
|
||||
(assert ok))))
|
||||
(deftest
|
||||
"multiple types are independent"
|
||||
(do
|
||||
(define-type Color2 (Red2) (Green2) (Blue2))
|
||||
(define-type Suit (Hearts) (Diamonds) (Clubs) (Spades))
|
||||
(assert= false (Color2? (Hearts)))
|
||||
(assert= false (Suit? (Red2)))
|
||||
(assert= true (Color2? (Blue2)))
|
||||
(assert= true (Suit? (Spades)))))
|
||||
(deftest
|
||||
"adt fields can hold any value"
|
||||
(do
|
||||
(define-type Container (Hold x))
|
||||
(assert-equal
|
||||
(list 1 2 3)
|
||||
(Hold-x (Hold (list 1 2 3))))
|
||||
(assert-equal {:a 1} (Hold-x (Hold {:a 1})))))
|
||||
(deftest
|
||||
"adt-registry tracks type constructor names"
|
||||
(do
|
||||
(define-type Days (Mon) (Tue) (Wed) (Thu) (Fri))
|
||||
(assert-equal
|
||||
(list "Mon" "Tue" "Wed" "Thu" "Fri")
|
||||
(get *adt-registry* "Days"))))
|
||||
(deftest
|
||||
"constructors with same field name in different types are independent"
|
||||
(do
|
||||
(define-type P1 (P1-ctor value))
|
||||
(define-type P2 (P2-ctor value))
|
||||
(assert= 10 (P1-ctor-value (P1-ctor 10)))
|
||||
(assert= 20 (P2-ctor-value (P2-ctor 20)))))
|
||||
(deftest
|
||||
"match dispatches on first matching constructor"
|
||||
(do
|
||||
(define-type Color (Red) (Green) (Blue))
|
||||
(assert= "red" (match (Red) ((Red) "red") ((Green) "green") ((Blue) "blue")))
|
||||
(assert= "green" (match (Green) ((Red) "red") ((Green) "green") ((Blue) "blue")))
|
||||
(assert= "blue" (match (Blue) ((Red) "red") ((Green) "green") ((Blue) "blue")))))
|
||||
(deftest
|
||||
"match binds field to variable"
|
||||
(do
|
||||
(define-type Wrapper (Wrap val))
|
||||
(assert= 42 (match (Wrap 42) ((Wrap v) v)))
|
||||
(assert= "hi" (match (Wrap "hi") ((Wrap v) v)))))
|
||||
(deftest
|
||||
"match zero-arg constructor"
|
||||
(do
|
||||
(define-type Signal (On) (Off))
|
||||
(assert= "on" (match (On) ((On) "on") ((Off) "off")))
|
||||
(assert= "off" (match (Off) ((On) "on") ((Off) "off")))))
|
||||
(deftest
|
||||
"match multi-field constructor binds all fields"
|
||||
(do
|
||||
(define-type Vec2 (V2 x y))
|
||||
(let ((v (V2 3 4)))
|
||||
(assert= 7 (match v ((V2 a b) (+ a b)))))))
|
||||
(deftest
|
||||
"match with else clause"
|
||||
(do
|
||||
(define-type Opt2 (Some2 val) (None2))
|
||||
(assert= 10 (match (Some2 10) ((Some2 v) v) (else 0)))
|
||||
(assert= 0 (match (None2) ((Some2 v) v) (else 0)))))
|
||||
(deftest
|
||||
"match else catches non-adt values"
|
||||
(do
|
||||
(assert= "other" (match 42 ((else) "other") (else "other")))
|
||||
(assert= "other" (match "str" (else "other")))))
|
||||
(deftest
|
||||
"match returns body expression value"
|
||||
(do
|
||||
(define-type Num (Num-of n))
|
||||
(assert= 100 (match (Num-of 10) ((Num-of n) (* n n))))))
|
||||
(deftest
|
||||
"match second arm fires when first does not match"
|
||||
(do
|
||||
(define-type Either (Left val) (Right val))
|
||||
(assert= "left-1" (match (Left 1) ((Left v) (str "left-" v)) ((Right v) (str "right-" v))))
|
||||
(assert= "right-2" (match (Right 2) ((Left v) (str "left-" v)) ((Right v) (str "right-" v))))))
|
||||
(deftest
|
||||
"match wildcard _ in constructor pattern"
|
||||
(do
|
||||
(define-type Pair3 (Pair3-of a b))
|
||||
(assert= 5 (match (Pair3-of 5 99) ((Pair3-of x _) x)))
|
||||
(assert= 99 (match (Pair3-of 5 99) ((Pair3-of _ y) y)))))
|
||||
(deftest
|
||||
"match nested adt constructor pattern"
|
||||
(do
|
||||
(define-type Tree2 (Leaf2) (Node2 left val right))
|
||||
(let ((t (Node2 (Leaf2) 7 (Leaf2))))
|
||||
(assert= 7 (match t ((Node2 _ v _) v)))
|
||||
(assert= true (match t ((Node2 (Leaf2) _ _) true) (else false))))))
|
||||
(deftest
|
||||
"match literal pattern"
|
||||
(do
|
||||
(assert= "zero" (match 0 (0 "zero") (else "nonzero")))
|
||||
(assert= "hello" (match "hello" ("hello" "hello") (else "other")))))
|
||||
(deftest
|
||||
"match symbol binding pattern"
|
||||
(do
|
||||
(assert= 42 (match 42 (x x)))))
|
||||
(deftest
|
||||
"match no matching clause raises error"
|
||||
(do
|
||||
(define-type AB (A-val) (B-val))
|
||||
(let ((ok false))
|
||||
(guard (exn (else (set! ok true)))
|
||||
(match (A-val) ((B-val) "b")))
|
||||
(assert ok))))
|
||||
(deftest
|
||||
"match result used in further computation"
|
||||
(do
|
||||
(define-type Num2 (N v))
|
||||
(assert= 30
|
||||
(+
|
||||
(match (N 10) ((N v) v))
|
||||
(match (N 20) ((N v) v))))))
|
||||
(deftest
|
||||
"match with define"
|
||||
(do
|
||||
(define-type Tag (Tagged label value))
|
||||
(define get-label (fn (t) (match t ((Tagged lbl _) lbl))))
|
||||
(define get-value (fn (t) (match t ((Tagged _ val) val))))
|
||||
(let ((t (Tagged "name" 99)))
|
||||
(assert= "name" (get-label t))
|
||||
(assert= 99 (get-value t)))))
|
||||
(deftest
|
||||
"match three-field constructor"
|
||||
(do
|
||||
(define-type Triple2 (T3 a b c))
|
||||
(assert= 6 (match (T3 1 2 3) ((T3 a b c) (+ a b c))))))
|
||||
(deftest
|
||||
"match clauses tried in order"
|
||||
(do
|
||||
(define-type Expr2 (Lit n) (Add l r) (Mul l r))
|
||||
(define eval-expr2 (fn (e)
|
||||
(match e
|
||||
((Lit n) n)
|
||||
((Add l r) (+ (eval-expr2 l) (eval-expr2 r)))
|
||||
((Mul l r) (* (eval-expr2 l) (eval-expr2 r))))))
|
||||
(assert= 7 (eval-expr2 (Add (Lit 3) (Lit 4))))
|
||||
(assert= 12 (eval-expr2 (Mul (Lit 3) (Lit 4))))
|
||||
(assert= 11 (eval-expr2 (Add (Lit 2) (Mul (Lit 3) (Lit 3)))))))
|
||||
(deftest
|
||||
"match else binding captures value"
|
||||
(do
|
||||
(define-type Coin2 (Heads2) (Tails2))
|
||||
(assert= "Tails2" (match (Tails2) ((Heads2) "Heads2") (x (get x :_ctor))))))
|
||||
(deftest
|
||||
"match on adt with string field"
|
||||
(do
|
||||
(define-type Msg (Hello name) (Bye name))
|
||||
(assert= "Hello, Alice" (match (Hello "Alice") ((Hello n) (str "Hello, " n)) ((Bye n) (str "Bye, " n))))
|
||||
(assert= "Bye, Bob" (match (Bye "Bob") ((Hello n) (str "Hello, " n)) ((Bye n) (str "Bye, " n))))))
|
||||
(deftest
|
||||
"match nested pattern with variable binding"
|
||||
(do
|
||||
(define-type Box2 (Box2-of v))
|
||||
(define-type Inner (Inner-of n))
|
||||
(assert= 5 (match (Box2-of (Inner-of 5)) ((Box2-of (Inner-of n)) n)))))
|
||||
)
|
||||
157
spec/tests/test-bitwise.sx
Normal file
157
spec/tests/test-bitwise.sx
Normal file
@@ -0,0 +1,157 @@
|
||||
(defsuite
|
||||
"bitwise-operations"
|
||||
(deftest
|
||||
"bitwise-and basic"
|
||||
(do
|
||||
(assert= 0 (bitwise-and 0 0))
|
||||
(assert= 1 (bitwise-and 3 1))
|
||||
(assert= 0 (bitwise-and 5 2))
|
||||
(assert= 4 (bitwise-and 12 6))))
|
||||
(deftest
|
||||
"bitwise-and identity and zero"
|
||||
(do
|
||||
(assert= 255 (bitwise-and 255 255))
|
||||
(assert= 0 (bitwise-and 255 0))))
|
||||
(deftest
|
||||
"bitwise-or basic"
|
||||
(do
|
||||
(assert= 0 (bitwise-or 0 0))
|
||||
(assert= 3 (bitwise-or 1 2))
|
||||
(assert= 7 (bitwise-or 5 3))
|
||||
(assert= 15 (bitwise-or 9 6))))
|
||||
(deftest
|
||||
"bitwise-or identity"
|
||||
(do
|
||||
(assert= 255 (bitwise-or 255 0))
|
||||
(assert= 255 (bitwise-or 0 255))))
|
||||
(deftest
|
||||
"bitwise-xor basic"
|
||||
(do
|
||||
(assert= 0 (bitwise-xor 0 0))
|
||||
(assert= 3 (bitwise-xor 1 2))
|
||||
(assert= 6 (bitwise-xor 3 5))
|
||||
(assert= 0 (bitwise-xor 255 255))))
|
||||
(deftest
|
||||
"bitwise-xor toggle bits"
|
||||
(do
|
||||
(assert= 14 (bitwise-xor 10 4))
|
||||
(assert= 10 (bitwise-xor 14 4))))
|
||||
(deftest
|
||||
"bitwise-not zero"
|
||||
(do (assert= -1 (bitwise-not 0))))
|
||||
(deftest
|
||||
"bitwise-not positive"
|
||||
(do
|
||||
(assert= -2 (bitwise-not 1))
|
||||
(assert= -5 (bitwise-not 4))
|
||||
(assert= -256 (bitwise-not 255))))
|
||||
(deftest
|
||||
"bitwise-not negative"
|
||||
(do
|
||||
(assert= 0 (bitwise-not -1))
|
||||
(assert= 1 (bitwise-not -2))
|
||||
(assert= 4 (bitwise-not -5))))
|
||||
(deftest
|
||||
"bitwise-not double negation"
|
||||
(do
|
||||
(assert= 42 (bitwise-not (bitwise-not 42)))
|
||||
(assert= 0 (bitwise-not (bitwise-not 0)))))
|
||||
(deftest
|
||||
"arithmetic-shift left"
|
||||
(do
|
||||
(assert= 2 (arithmetic-shift 1 1))
|
||||
(assert= 4 (arithmetic-shift 1 2))
|
||||
(assert= 16 (arithmetic-shift 1 4))
|
||||
(assert= 8 (arithmetic-shift 2 2))))
|
||||
(deftest
|
||||
"arithmetic-shift right"
|
||||
(do
|
||||
(assert= 1 (arithmetic-shift 2 -1))
|
||||
(assert= 1 (arithmetic-shift 4 -2))
|
||||
(assert= 5 (arithmetic-shift 10 -1))
|
||||
(assert= 2 (arithmetic-shift 16 -3))))
|
||||
(deftest
|
||||
"arithmetic-shift by zero"
|
||||
(do
|
||||
(assert= 42 (arithmetic-shift 42 0))
|
||||
(assert= 0 (arithmetic-shift 0 5))))
|
||||
(deftest
|
||||
"arithmetic-shift negative value right preserves sign"
|
||||
(do
|
||||
(assert= -1 (arithmetic-shift -1 -1))
|
||||
(assert= -2 (arithmetic-shift -4 -1))))
|
||||
(deftest
|
||||
"bit-count zero"
|
||||
(do (assert= 0 (bit-count 0))))
|
||||
(deftest
|
||||
"bit-count powers of two"
|
||||
(do
|
||||
(assert= 1 (bit-count 1))
|
||||
(assert= 1 (bit-count 2))
|
||||
(assert= 1 (bit-count 4))
|
||||
(assert= 1 (bit-count 128))))
|
||||
(deftest
|
||||
"bit-count all-ones values"
|
||||
(do
|
||||
(assert= 8 (bit-count 255))
|
||||
(assert= 4 (bit-count 15))
|
||||
(assert= 2 (bit-count 3))))
|
||||
(deftest
|
||||
"bit-count mixed"
|
||||
(do
|
||||
(assert= 3 (bit-count 7))
|
||||
(assert= 2 (bit-count 5))
|
||||
(assert= 3 (bit-count 11))
|
||||
(assert= 4 (bit-count 30))))
|
||||
(deftest
|
||||
"integer-length zero"
|
||||
(do (assert= 0 (integer-length 0))))
|
||||
(deftest
|
||||
"integer-length powers of two"
|
||||
(do
|
||||
(assert= 1 (integer-length 1))
|
||||
(assert= 2 (integer-length 2))
|
||||
(assert= 3 (integer-length 4))
|
||||
(assert= 4 (integer-length 8))
|
||||
(assert= 8 (integer-length 128))))
|
||||
(deftest
|
||||
"integer-length non-powers"
|
||||
(do
|
||||
(assert= 2 (integer-length 3))
|
||||
(assert= 3 (integer-length 5))
|
||||
(assert= 3 (integer-length 7))
|
||||
(assert= 8 (integer-length 255))
|
||||
(assert= 9 (integer-length 256))))
|
||||
(deftest
|
||||
"bitwise ops compose"
|
||||
(do
|
||||
(assert=
|
||||
5
|
||||
(bitwise-and
|
||||
(bitwise-or 5 3)
|
||||
(bitwise-xor 7 2)))
|
||||
(assert= 0 (bitwise-and 170 85))))
|
||||
(deftest
|
||||
"arithmetic-shift round-trip"
|
||||
(do
|
||||
(assert=
|
||||
10
|
||||
(arithmetic-shift (arithmetic-shift 10 3) -3))))
|
||||
(deftest
|
||||
"extract bits with mask"
|
||||
(do
|
||||
(let
|
||||
((x 52))
|
||||
(assert=
|
||||
5
|
||||
(bitwise-and (arithmetic-shift x -2) 7)))))
|
||||
(deftest
|
||||
"clear low bits with bitwise-not mask"
|
||||
(do
|
||||
(assert= 252 (bitwise-and 255 (bitwise-not 3)))))
|
||||
(deftest
|
||||
"integer-length after shift"
|
||||
(do
|
||||
(assert=
|
||||
4
|
||||
(integer-length (arithmetic-shift 1 3))))))
|
||||
236
spec/tests/test-bytevectors.sx
Normal file
236
spec/tests/test-bytevectors.sx
Normal file
@@ -0,0 +1,236 @@
|
||||
;; ==========================================================================
|
||||
;; test-bytevectors.sx — Tests for bytevector primitives
|
||||
;; ==========================================================================
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; make-bytevector / bytevector?
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"bv:create"
|
||||
(deftest
|
||||
"make-bytevector returns bytevector"
|
||||
(assert (bytevector? (make-bytevector 4))))
|
||||
(deftest
|
||||
"make-bytevector zeroes by default"
|
||||
(let
|
||||
((bv (make-bytevector 3)))
|
||||
(assert
|
||||
(and
|
||||
(= (bytevector-u8-ref bv 0) 0)
|
||||
(= (bytevector-u8-ref bv 1) 0)
|
||||
(= (bytevector-u8-ref bv 2) 0)))))
|
||||
(deftest
|
||||
"make-bytevector with fill"
|
||||
(let
|
||||
((bv (make-bytevector 3 42)))
|
||||
(assert
|
||||
(and
|
||||
(= (bytevector-u8-ref bv 0) 42)
|
||||
(= (bytevector-u8-ref bv 1) 42)
|
||||
(= (bytevector-u8-ref bv 2) 42)))))
|
||||
(deftest
|
||||
"make-bytevector length 0"
|
||||
(assert= (bytevector-length (make-bytevector 0)) 0))
|
||||
(deftest
|
||||
"bytevector? true for bytevector"
|
||||
(assert (bytevector? (make-bytevector 2))))
|
||||
(deftest
|
||||
"bytevector? false for string"
|
||||
(assert (not (bytevector? "hello"))))
|
||||
(deftest "bytevector? false for nil" (assert (not (bytevector? nil))))
|
||||
(deftest
|
||||
"bytevector? false for list"
|
||||
(assert (not (bytevector? (list 1 2 3))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; bytevector-length / u8-ref / u8-set!
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"bv:access"
|
||||
(deftest
|
||||
"bytevector-length"
|
||||
(assert= (bytevector-length (make-bytevector 5)) 5))
|
||||
(deftest
|
||||
"u8-ref reads fill byte"
|
||||
(assert=
|
||||
(bytevector-u8-ref (make-bytevector 4 99) 2)
|
||||
99))
|
||||
(deftest
|
||||
"u8-set! mutates"
|
||||
(let
|
||||
((bv (make-bytevector 3 0)))
|
||||
(bytevector-u8-set! bv 1 200)
|
||||
(assert= (bytevector-u8-ref bv 1) 200)))
|
||||
(deftest
|
||||
"u8-set! boundary byte 255"
|
||||
(let
|
||||
((bv (make-bytevector 1 0)))
|
||||
(bytevector-u8-set! bv 0 255)
|
||||
(assert= (bytevector-u8-ref bv 0) 255)))
|
||||
(deftest
|
||||
"u8-set! byte 0"
|
||||
(let
|
||||
((bv (make-bytevector 1 255)))
|
||||
(bytevector-u8-set! bv 0 0)
|
||||
(assert= (bytevector-u8-ref bv 0) 0))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; bytevector-copy
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"bv:copy"
|
||||
(deftest
|
||||
"copy produces equal content"
|
||||
(let
|
||||
((bv (make-bytevector 3 7)))
|
||||
(let
|
||||
((bv2 (bytevector-copy bv)))
|
||||
(assert
|
||||
(and
|
||||
(= (bytevector-u8-ref bv2 0) 7)
|
||||
(= (bytevector-u8-ref bv2 1) 7)
|
||||
(= (bytevector-u8-ref bv2 2) 7))))))
|
||||
(deftest
|
||||
"copy is independent"
|
||||
(let
|
||||
((bv (make-bytevector 2 0)))
|
||||
(let
|
||||
((bv2 (bytevector-copy bv)))
|
||||
(bytevector-u8-set! bv2 0 99)
|
||||
(assert= (bytevector-u8-ref bv 0) 0))))
|
||||
(deftest
|
||||
"copy with start"
|
||||
(let
|
||||
((bv (list->bytevector (list 10 20 30 40))))
|
||||
(let
|
||||
((bv2 (bytevector-copy bv 2)))
|
||||
(assert
|
||||
(and
|
||||
(= (bytevector-length bv2) 2)
|
||||
(= (bytevector-u8-ref bv2 0) 30))))))
|
||||
(deftest
|
||||
"copy with start and end"
|
||||
(let
|
||||
((bv (list->bytevector (list 10 20 30 40))))
|
||||
(let
|
||||
((bv2 (bytevector-copy bv 1 3)))
|
||||
(assert
|
||||
(and
|
||||
(= (bytevector-length bv2) 2)
|
||||
(= (bytevector-u8-ref bv2 0) 20)
|
||||
(= (bytevector-u8-ref bv2 1) 30)))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; bytevector-copy!
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"bv:copy-bang"
|
||||
(deftest
|
||||
"copy! overwrites dst region"
|
||||
(let
|
||||
((dst (make-bytevector 4 0)))
|
||||
(let
|
||||
((src (list->bytevector (list 1 2 3))))
|
||||
(bytevector-copy! dst 1 src)
|
||||
(assert
|
||||
(and
|
||||
(= (bytevector-u8-ref dst 0) 0)
|
||||
(= (bytevector-u8-ref dst 1) 1)
|
||||
(= (bytevector-u8-ref dst 2) 2)
|
||||
(= (bytevector-u8-ref dst 3) 3))))))
|
||||
(deftest
|
||||
"copy! with src bounds"
|
||||
(let
|
||||
((dst (make-bytevector 2 0)))
|
||||
(let
|
||||
((src (list->bytevector (list 10 20 30 40))))
|
||||
(bytevector-copy! dst 0 src 1 3)
|
||||
(assert
|
||||
(and
|
||||
(= (bytevector-u8-ref dst 0) 20)
|
||||
(= (bytevector-u8-ref dst 1) 30)))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; bytevector-append
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"bv:append"
|
||||
(deftest
|
||||
"append two bytevectors"
|
||||
(let
|
||||
((bv (bytevector-append (list->bytevector (list 1 2)) (list->bytevector (list 3 4)))))
|
||||
(assert
|
||||
(and
|
||||
(= (bytevector-length bv) 4)
|
||||
(= (bytevector-u8-ref bv 0) 1)
|
||||
(= (bytevector-u8-ref bv 3) 4)))))
|
||||
(deftest
|
||||
"append three bytevectors"
|
||||
(let
|
||||
((bv (bytevector-append (list->bytevector (list 1)) (list->bytevector (list 2)) (list->bytevector (list 3)))))
|
||||
(assert= (bytevector-length bv) 3)))
|
||||
(deftest
|
||||
"append empty"
|
||||
(assert=
|
||||
(bytevector-length
|
||||
(bytevector-append
|
||||
(make-bytevector 0)
|
||||
(make-bytevector 0)))
|
||||
0)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; list->bytevector / bytevector->list
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"bv:conversion"
|
||||
(deftest
|
||||
"list->bytevector roundtrip"
|
||||
(let
|
||||
((lst (list 10 20 30)))
|
||||
(assert= (bytevector->list (list->bytevector lst)) lst)))
|
||||
(deftest
|
||||
"list->bytevector empty"
|
||||
(assert= (bytevector-length (list->bytevector nil)) 0))
|
||||
(deftest
|
||||
"bytevector->list from make-bytevector"
|
||||
(let
|
||||
((lst (bytevector->list (make-bytevector 3 5))))
|
||||
(assert= lst (list 5 5 5)))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; utf8 roundtrip
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"bv:utf8"
|
||||
(deftest
|
||||
"string->utf8 returns bytevector"
|
||||
(assert (bytevector? (string->utf8 "hello"))))
|
||||
(deftest
|
||||
"string->utf8 length"
|
||||
(assert= (bytevector-length (string->utf8 "abc")) 3))
|
||||
(deftest
|
||||
"utf8->string roundtrip"
|
||||
(assert= (utf8->string (string->utf8 "hello")) "hello"))
|
||||
(deftest
|
||||
"utf8->string with slice"
|
||||
(let
|
||||
((bv (string->utf8 "hello")))
|
||||
(assert= (utf8->string bv 1 4) "ell")))
|
||||
(deftest
|
||||
"string->utf8 with start"
|
||||
(assert= (utf8->string (string->utf8 "hello" 2)) "llo"))
|
||||
(deftest
|
||||
"string->utf8 with start and end"
|
||||
(assert=
|
||||
(utf8->string (string->utf8 "hello" 1 4))
|
||||
"ell"))
|
||||
(deftest
|
||||
"empty string round-trips"
|
||||
(assert= (utf8->string (string->utf8 "")) "")))
|
||||
185
spec/tests/test-chars.sx
Normal file
185
spec/tests/test-chars.sx
Normal file
@@ -0,0 +1,185 @@
|
||||
;; Tests for character type (Phase 13)
|
||||
;; Uses (make-char n) and (char-code "x") instead of #\x literals
|
||||
;; (char literal parser syntax tested via sx-parse call)
|
||||
|
||||
(deftest
|
||||
"make-char produces a char"
|
||||
(assert= true (char? (make-char 97))))
|
||||
|
||||
(deftest "char? false for string" (assert= false (char? "a")))
|
||||
|
||||
(deftest "char? false for number" (assert= false (char? 65)))
|
||||
|
||||
(deftest "char? false for nil" (assert= false (char? nil)))
|
||||
|
||||
(deftest
|
||||
"char->integer extracts codepoint"
|
||||
(assert= 97 (char->integer (make-char 97))))
|
||||
|
||||
(deftest
|
||||
"integer->char alias for make-char"
|
||||
(assert= 65 (char->integer (integer->char 65))))
|
||||
|
||||
(deftest
|
||||
"char->integer round-trip"
|
||||
(assert= 122 (char->integer (make-char 122))))
|
||||
|
||||
(deftest
|
||||
"char=? equal"
|
||||
(assert= true (char=? (make-char 97) (make-char 97))))
|
||||
|
||||
(deftest
|
||||
"char=? unequal"
|
||||
(assert= false (char=? (make-char 97) (make-char 98))))
|
||||
|
||||
(deftest
|
||||
"char<? ordering"
|
||||
(assert= true (char<? (make-char 97) (make-char 98))))
|
||||
|
||||
(deftest
|
||||
"char>? ordering"
|
||||
(assert= true (char>? (make-char 98) (make-char 97))))
|
||||
|
||||
(deftest
|
||||
"char<=? equal"
|
||||
(assert= true (char<=? (make-char 65) (make-char 65))))
|
||||
|
||||
(deftest
|
||||
"char>=? greater"
|
||||
(assert= true (char>=? (make-char 90) (make-char 65))))
|
||||
|
||||
(deftest
|
||||
"char-ci=? ignores case (a vs A)"
|
||||
(assert= true (char-ci=? (make-char 97) (make-char 65))))
|
||||
|
||||
(deftest
|
||||
"char-ci<? a < b case-insensitive"
|
||||
(assert= true (char-ci<? (make-char 97) (make-char 98))))
|
||||
|
||||
(deftest
|
||||
"char-ci>? b > a case-insensitive"
|
||||
(assert= true (char-ci>? (make-char 66) (make-char 65))))
|
||||
|
||||
(deftest
|
||||
"char-alphabetic? true for a"
|
||||
(assert= true (char-alphabetic? (make-char 97))))
|
||||
|
||||
(deftest
|
||||
"char-alphabetic? true for Z"
|
||||
(assert= true (char-alphabetic? (make-char 90))))
|
||||
|
||||
(deftest
|
||||
"char-alphabetic? false for digit"
|
||||
(assert= false (char-alphabetic? (make-char 48))))
|
||||
|
||||
(deftest
|
||||
"char-numeric? true for 0"
|
||||
(assert= true (char-numeric? (make-char 48))))
|
||||
|
||||
(deftest
|
||||
"char-numeric? true for 9"
|
||||
(assert= true (char-numeric? (make-char 57))))
|
||||
|
||||
(deftest
|
||||
"char-numeric? false for letter"
|
||||
(assert= false (char-numeric? (make-char 65))))
|
||||
|
||||
(deftest
|
||||
"char-whitespace? true for space"
|
||||
(assert= true (char-whitespace? (make-char 32))))
|
||||
|
||||
(deftest
|
||||
"char-whitespace? true for newline"
|
||||
(assert= true (char-whitespace? (make-char 10))))
|
||||
|
||||
(deftest
|
||||
"char-whitespace? false for letter"
|
||||
(assert= false (char-whitespace? (make-char 65))))
|
||||
|
||||
(deftest
|
||||
"char-upper-case? true for A"
|
||||
(assert= true (char-upper-case? (make-char 65))))
|
||||
|
||||
(deftest
|
||||
"char-upper-case? false for a"
|
||||
(assert= false (char-upper-case? (make-char 97))))
|
||||
|
||||
(deftest
|
||||
"char-lower-case? true for a"
|
||||
(assert= true (char-lower-case? (make-char 97))))
|
||||
|
||||
(deftest
|
||||
"char-lower-case? false for A"
|
||||
(assert= false (char-lower-case? (make-char 65))))
|
||||
|
||||
(deftest
|
||||
"char-upcase converts a to A"
|
||||
(assert= 65 (char->integer (char-upcase (make-char 97)))))
|
||||
|
||||
(deftest
|
||||
"char-downcase converts A to a"
|
||||
(assert=
|
||||
97
|
||||
(char->integer (char-downcase (make-char 65)))))
|
||||
|
||||
(deftest
|
||||
"char-upcase idempotent on uppercase"
|
||||
(assert= 65 (char->integer (char-upcase (make-char 65)))))
|
||||
|
||||
(deftest
|
||||
"string->list returns list of chars"
|
||||
(assert= 3 (len (string->list "abc"))))
|
||||
|
||||
(deftest
|
||||
"string->list element 0 is char"
|
||||
(assert= true (char? (get (string->list "abc") 0))))
|
||||
|
||||
(deftest
|
||||
"string->list codepoints correct"
|
||||
(assert= 97 (char->integer (get (string->list "abc") 0))))
|
||||
|
||||
(deftest
|
||||
"list->string from chars produces string"
|
||||
(assert=
|
||||
"abc"
|
||||
(list->string
|
||||
(list
|
||||
(make-char 97)
|
||||
(make-char 98)
|
||||
(make-char 99)))))
|
||||
|
||||
(deftest
|
||||
"string->list list->string round-trip"
|
||||
(let ((s "hello")) (assert= s (list->string (string->list s)))))
|
||||
|
||||
(deftest
|
||||
"char literal parsed via sx-parse"
|
||||
(let
|
||||
((ast (sx-parse "#\\a")))
|
||||
(assert= true (char? (get ast 0)))))
|
||||
|
||||
(deftest
|
||||
"char literal codepoint via sx-parse"
|
||||
(let
|
||||
((ast (sx-parse "#\\a")))
|
||||
(assert= 97 (char->integer (get ast 0)))))
|
||||
|
||||
(deftest
|
||||
"named char space via sx-parse"
|
||||
(let
|
||||
((ast (sx-parse "#\\space")))
|
||||
(assert= 32 (char->integer (get ast 0)))))
|
||||
|
||||
(deftest
|
||||
"named char newline via sx-parse"
|
||||
(let
|
||||
((ast (sx-parse "#\\newline")))
|
||||
(assert= 10 (char->integer (get ast 0)))))
|
||||
|
||||
(deftest
|
||||
"char-ci<=? equal case-insensitive"
|
||||
(assert= true (char-ci<=? (make-char 65) (make-char 97))))
|
||||
|
||||
(deftest
|
||||
"char-ci>=? equal case-insensitive"
|
||||
(assert= true (char-ci>=? (make-char 97) (make-char 65))))
|
||||
305
spec/tests/test-coroutines.sx
Normal file
305
spec/tests/test-coroutines.sx
Normal file
@@ -0,0 +1,305 @@
|
||||
(import (sx coroutines))
|
||||
|
||||
(defsuite
|
||||
"coroutine"
|
||||
(deftest
|
||||
"coroutine? recognizes coroutine objects"
|
||||
(let
|
||||
((co (make-coroutine (fn () nil))))
|
||||
(assert (coroutine? co))
|
||||
(assert= false (coroutine? 42))
|
||||
(assert= false (coroutine? "hello"))
|
||||
(assert= false (coroutine? nil))
|
||||
(assert= false (coroutine? (list)))))
|
||||
(deftest
|
||||
"coroutine-alive? true for ready coroutine"
|
||||
(let
|
||||
((co (make-coroutine (fn () nil))))
|
||||
(assert (coroutine-alive? co))))
|
||||
(deftest
|
||||
"coroutine-alive? false for non-coroutine"
|
||||
(assert= false (coroutine-alive? 42)))
|
||||
(deftest
|
||||
"immediate return — done true, value is body result"
|
||||
(let
|
||||
((co (make-coroutine (fn () 42))))
|
||||
(let
|
||||
((r (coroutine-resume co nil)))
|
||||
(assert= true (get r "done"))
|
||||
(assert= 42 (get r "value")))))
|
||||
(deftest
|
||||
"immediate nil return"
|
||||
(let
|
||||
((co (make-coroutine (fn () nil))))
|
||||
(let
|
||||
((r (coroutine-resume co nil)))
|
||||
(assert= true (get r "done"))
|
||||
(assert= nil (get r "value")))))
|
||||
(deftest
|
||||
"coroutine-alive? false after completion"
|
||||
(let
|
||||
((co (make-coroutine (fn () nil))))
|
||||
(coroutine-resume co nil)
|
||||
(assert= false (coroutine-alive? co))))
|
||||
(deftest
|
||||
"single yield — done false on yield, done true on finish"
|
||||
(let
|
||||
((co (make-coroutine (fn () (coroutine-yield 10) 20))))
|
||||
(let
|
||||
((r1 (coroutine-resume co nil)))
|
||||
(let
|
||||
((r2 (coroutine-resume co nil)))
|
||||
(assert= false (get r1 "done"))
|
||||
(assert= 10 (get r1 "value"))
|
||||
(assert= true (get r2 "done"))
|
||||
(assert= 20 (get r2 "value"))))))
|
||||
(deftest
|
||||
"coroutine-alive? true between yield and next resume"
|
||||
(let
|
||||
((co (make-coroutine (fn () (coroutine-yield nil) nil))))
|
||||
(assert (coroutine-alive? co))
|
||||
(coroutine-resume co nil)
|
||||
(assert (coroutine-alive? co))
|
||||
(coroutine-resume co nil)
|
||||
(assert= false (coroutine-alive? co))))
|
||||
(deftest
|
||||
"three yields then return"
|
||||
(let
|
||||
((co (make-coroutine (fn () (coroutine-yield "a") (coroutine-yield "b") (coroutine-yield "c") "z"))))
|
||||
(let
|
||||
((r1 (coroutine-resume co nil)))
|
||||
(let
|
||||
((r2 (coroutine-resume co nil)))
|
||||
(let
|
||||
((r3 (coroutine-resume co nil)))
|
||||
(let
|
||||
((r4 (coroutine-resume co nil)))
|
||||
(assert= "a" (get r1 "value"))
|
||||
(assert= false (get r1 "done"))
|
||||
(assert= "b" (get r2 "value"))
|
||||
(assert= false (get r2 "done"))
|
||||
(assert= "c" (get r3 "value"))
|
||||
(assert= false (get r3 "done"))
|
||||
(assert= "z" (get r4 "value"))
|
||||
(assert= true (get r4 "done"))))))))
|
||||
(deftest
|
||||
"final return vs yield — done flag distinguishes them"
|
||||
(let
|
||||
((co (make-coroutine (fn () (coroutine-yield "yielded") "returned"))))
|
||||
(let
|
||||
((y (coroutine-resume co nil)))
|
||||
(let
|
||||
((r (coroutine-resume co nil)))
|
||||
(assert= false (get y "done"))
|
||||
(assert= "yielded" (get y "value"))
|
||||
(assert= true (get r "done"))
|
||||
(assert= "returned" (get r "value"))))))
|
||||
(deftest
|
||||
"resume val becomes yield return value"
|
||||
(let
|
||||
((co (make-coroutine (fn () (let ((received (coroutine-yield "first"))) received)))))
|
||||
(let
|
||||
((r1 (coroutine-resume co nil)))
|
||||
(let
|
||||
((r2 (coroutine-resume co 99)))
|
||||
(assert= "first" (get r1 "value"))
|
||||
(assert= false (get r1 "done"))
|
||||
(assert= 99 (get r2 "value"))
|
||||
(assert= true (get r2 "done"))))))
|
||||
(deftest
|
||||
"multiple resume values passed through yields"
|
||||
(let
|
||||
((co (make-coroutine (fn () (let ((a (coroutine-yield 1))) (let ((b (coroutine-yield 2))) (+ a b)))))))
|
||||
(let
|
||||
((r1 (coroutine-resume co nil)))
|
||||
(let
|
||||
((r2 (coroutine-resume co 10)))
|
||||
(let
|
||||
((r3 (coroutine-resume co 20)))
|
||||
(assert= 1 (get r1 "value"))
|
||||
(assert= 2 (get r2 "value"))
|
||||
(assert= true (get r3 "done"))
|
||||
(assert= 30 (get r3 "value")))))))
|
||||
(deftest
|
||||
"coroutine captures lexical environment"
|
||||
(let
|
||||
((x 10)
|
||||
(co
|
||||
(make-coroutine
|
||||
(fn () (coroutine-yield (* x 2)) (* x 3)))))
|
||||
(let
|
||||
((r1 (coroutine-resume co nil)))
|
||||
(let
|
||||
((r2 (coroutine-resume co nil)))
|
||||
(assert= 20 (get r1 "value"))
|
||||
(assert= 30 (get r2 "value"))))))
|
||||
(deftest
|
||||
"resuming dead coroutine raises error"
|
||||
(let
|
||||
((co (make-coroutine (fn () nil))))
|
||||
(coroutine-resume co nil)
|
||||
(assert-throws (fn () (coroutine-resume co nil)))))
|
||||
(deftest
|
||||
"coroutine drives iteration via recursive body"
|
||||
(let
|
||||
((co (make-coroutine (fn () (define loop (fn (i) (when (< i 4) (coroutine-yield i) (loop (+ i 1))))) (loop 0))))
|
||||
(results (list)))
|
||||
(let
|
||||
drive
|
||||
()
|
||||
(let
|
||||
((r (coroutine-resume co nil)))
|
||||
(when
|
||||
(not (get r "done"))
|
||||
(append! results (get r "value"))
|
||||
(drive))))
|
||||
(assert= 4 (len results))
|
||||
(assert= 0 (nth results 0))
|
||||
(assert= 1 (nth results 1))
|
||||
(assert= 2 (nth results 2))
|
||||
(assert= 3 (nth results 3))))
|
||||
(deftest
|
||||
"nested coroutine — inner resumed from outer body"
|
||||
(let
|
||||
((inner (make-coroutine (fn () (coroutine-yield "inner-a") "inner-done")))
|
||||
(outer
|
||||
(make-coroutine
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((i1 (coroutine-resume inner nil)))
|
||||
(coroutine-yield (get i1 "value")))
|
||||
(let ((i2 (coroutine-resume inner nil))) (get i2 "value"))))))
|
||||
(let
|
||||
((o1 (coroutine-resume outer nil)))
|
||||
(let
|
||||
((o2 (coroutine-resume outer nil)))
|
||||
(assert= false (get o1 "done"))
|
||||
(assert= "inner-a" (get o1 "value"))
|
||||
(assert= true (get o2 "done"))
|
||||
(assert= "inner-done" (get o2 "value"))))))
|
||||
(deftest
|
||||
"two independent coroutines interleave correctly"
|
||||
(let
|
||||
((co1 (make-coroutine (fn () (coroutine-yield 1) 5)))
|
||||
(co2
|
||||
(make-coroutine (fn () (coroutine-yield 2) 6))))
|
||||
(let
|
||||
((a (coroutine-resume co1 nil)))
|
||||
(let
|
||||
((b (coroutine-resume co2 nil)))
|
||||
(let
|
||||
((c (coroutine-resume co1 nil)))
|
||||
(let
|
||||
((d (coroutine-resume co2 nil)))
|
||||
(assert= false (get a "done"))
|
||||
(assert= 1 (get a "value"))
|
||||
(assert= false (get b "done"))
|
||||
(assert= 2 (get b "value"))
|
||||
(assert= true (get c "done"))
|
||||
(assert= 5 (get c "value"))
|
||||
(assert= true (get d "done"))
|
||||
(assert= 6 (get d "value"))))))))
|
||||
(deftest
|
||||
"coroutine state field is ready before first resume"
|
||||
(let
|
||||
((co (make-coroutine (fn () (coroutine-yield 1)))))
|
||||
(assert= "ready" (get co "state"))))
|
||||
(deftest
|
||||
"coroutine state field is suspended between yields"
|
||||
(let
|
||||
((co (make-coroutine (fn () (coroutine-yield 1) 2))))
|
||||
(coroutine-resume co nil)
|
||||
(assert= "suspended" (get co "state"))))
|
||||
(deftest
|
||||
"coroutine state field is dead after completion"
|
||||
(let
|
||||
((co (make-coroutine (fn () nil))))
|
||||
(coroutine-resume co nil)
|
||||
(assert= "dead" (get co "state"))))
|
||||
(deftest
|
||||
"yield works when called from nested helper function"
|
||||
(let
|
||||
((co (make-coroutine (fn () (define helper (fn (x) (coroutine-yield x))) (helper 10) (helper 20)))))
|
||||
(let
|
||||
((r1 (coroutine-resume co nil)))
|
||||
(let
|
||||
((r2 (coroutine-resume co nil)))
|
||||
(let
|
||||
((r3 (coroutine-resume co nil)))
|
||||
(assert= false (get r1 "done"))
|
||||
(assert= 10 (get r1 "value"))
|
||||
(assert= false (get r2 "done"))
|
||||
(assert= 20 (get r2 "value"))
|
||||
(assert= true (get r3 "done")))))))
|
||||
(deftest
|
||||
"initial resume argument is ignored by ready coroutine"
|
||||
(let
|
||||
((co (make-coroutine (fn () (coroutine-yield 42)))))
|
||||
(let
|
||||
((r (coroutine-resume co "ignored")))
|
||||
(assert= false (get r "done"))
|
||||
(assert= 42 (get r "value")))))
|
||||
(deftest
|
||||
"coroutine with mutable closure state"
|
||||
(let
|
||||
((counter {:value 0}))
|
||||
(let
|
||||
((co (make-coroutine (fn () (dict-set! counter "value" 1) (coroutine-yield "a") (dict-set! counter "value" 2) (coroutine-yield "b")))))
|
||||
(assert= 0 (get counter "value"))
|
||||
(coroutine-resume co nil)
|
||||
(assert= 1 (get counter "value"))
|
||||
(coroutine-resume co nil)
|
||||
(assert= 2 (get counter "value")))))
|
||||
(deftest
|
||||
"coroutine can yield complex values"
|
||||
(let
|
||||
((co (make-coroutine (fn () (coroutine-yield (list 1 2 3)) (coroutine-yield {:key "val"})))))
|
||||
(let
|
||||
((r1 (coroutine-resume co nil)))
|
||||
(let
|
||||
((r2 (coroutine-resume co nil)))
|
||||
(assert= false (get r1 "done"))
|
||||
(assert= 3 (len (get r1 "value")))
|
||||
(assert= false (get r2 "done"))
|
||||
(assert= "val" (get (get r2 "value") "key"))))))
|
||||
(deftest
|
||||
"round-robin scheduling of multiple coroutines"
|
||||
(let
|
||||
((results (list))
|
||||
(co1
|
||||
(make-coroutine
|
||||
(fn () (coroutine-yield "a") (coroutine-yield "b"))))
|
||||
(co2
|
||||
(make-coroutine
|
||||
(fn () (coroutine-yield "c") (coroutine-yield "d")))))
|
||||
(append! results (get (coroutine-resume co1 nil) "value"))
|
||||
(append! results (get (coroutine-resume co2 nil) "value"))
|
||||
(append! results (get (coroutine-resume co1 nil) "value"))
|
||||
(append! results (get (coroutine-resume co2 nil) "value"))
|
||||
(assert= 4 (len results))
|
||||
(assert= "a" (nth results 0))
|
||||
(assert= "c" (nth results 1))
|
||||
(assert= "b" (nth results 2))
|
||||
(assert= "d" (nth results 3))))
|
||||
(deftest
|
||||
"coroutines created from same factory share no state"
|
||||
(let
|
||||
((make-counter (fn (start) (make-coroutine (fn () (define loop (fn (n) (coroutine-yield n) (loop (+ n 1)))) (loop start))))))
|
||||
(let
|
||||
((c1 (make-counter 0)) (c2 (make-counter 100)))
|
||||
(let
|
||||
((a (get (coroutine-resume c1 nil) "value")))
|
||||
(let
|
||||
((b (get (coroutine-resume c2 nil) "value")))
|
||||
(let
|
||||
((c (get (coroutine-resume c1 nil) "value")))
|
||||
(let
|
||||
((d (get (coroutine-resume c2 nil) "value")))
|
||||
(assert= 0 a)
|
||||
(assert= 100 b)
|
||||
(assert= 1 c)
|
||||
(assert= 101 d))))))))
|
||||
(deftest
|
||||
"resuming non-coroutine raises error"
|
||||
(assert-throws (fn () (coroutine-resume "not-a-coroutine" nil)))))
|
||||
113
spec/tests/test-dynamic-wind.sx
Normal file
113
spec/tests/test-dynamic-wind.sx
Normal file
@@ -0,0 +1,113 @@
|
||||
;; Tests for dynamic-wind: after-thunk fires on normal return,
|
||||
;; non-local exit via raise/guard, and call/cc escape.
|
||||
|
||||
(defsuite
|
||||
"dynamic-wind-basic"
|
||||
(deftest
|
||||
"after fires on normal return"
|
||||
(let
|
||||
((log (list)))
|
||||
(dynamic-wind
|
||||
(fn () (append! log "before"))
|
||||
(fn () (append! log "body"))
|
||||
(fn () (append! log "after")))
|
||||
(assert= 3 (len log))
|
||||
(assert= "before" (nth log 0))
|
||||
(assert= "body" (nth log 1))
|
||||
(assert= "after" (nth log 2))))
|
||||
(deftest
|
||||
"after fires on raise escape"
|
||||
(let
|
||||
((log (list)))
|
||||
(guard
|
||||
(e (true nil))
|
||||
(dynamic-wind
|
||||
(fn () (append! log "before"))
|
||||
(fn () (append! log "body") (error "boom"))
|
||||
(fn () (append! log "after"))))
|
||||
(assert= 3 (len log))
|
||||
(assert= "before" (nth log 0))
|
||||
(assert= "body" (nth log 1))
|
||||
(assert= "after" (nth log 2))))
|
||||
(deftest
|
||||
"after fires on call/cc escape"
|
||||
(let
|
||||
((log (list)))
|
||||
(call/cc
|
||||
(fn
|
||||
(k)
|
||||
(dynamic-wind
|
||||
(fn () (append! log "before"))
|
||||
(fn () (append! log "body") (k nil))
|
||||
(fn () (append! log "after")))))
|
||||
(assert= 3 (len log))
|
||||
(assert= "before" (nth log 0))
|
||||
(assert= "body" (nth log 1))
|
||||
(assert= "after" (nth log 2))))
|
||||
(deftest
|
||||
"nested dynamic-wind after-thunks fire LIFO on normal return"
|
||||
(let
|
||||
((log (list)))
|
||||
(dynamic-wind
|
||||
(fn () (append! log "outer-before"))
|
||||
(fn
|
||||
()
|
||||
(dynamic-wind
|
||||
(fn () (append! log "inner-before"))
|
||||
(fn () (append! log "inner-body"))
|
||||
(fn () (append! log "inner-after"))))
|
||||
(fn () (append! log "outer-after")))
|
||||
(assert= 5 (len log))
|
||||
(assert= "outer-before" (nth log 0))
|
||||
(assert= "inner-before" (nth log 1))
|
||||
(assert= "inner-body" (nth log 2))
|
||||
(assert= "inner-after" (nth log 3))
|
||||
(assert= "outer-after" (nth log 4))))
|
||||
(deftest
|
||||
"nested dynamic-wind after-thunks fire LIFO on raise"
|
||||
(let
|
||||
((log (list)))
|
||||
(guard
|
||||
(e (true nil))
|
||||
(dynamic-wind
|
||||
(fn () (append! log "outer-before"))
|
||||
(fn
|
||||
()
|
||||
(dynamic-wind
|
||||
(fn () (append! log "inner-before"))
|
||||
(fn () (append! log "inner-body") (error "boom"))
|
||||
(fn () (append! log "inner-after"))))
|
||||
(fn () (append! log "outer-after"))))
|
||||
(assert= 5 (len log))
|
||||
(assert= "outer-before" (nth log 0))
|
||||
(assert= "inner-before" (nth log 1))
|
||||
(assert= "inner-body" (nth log 2))
|
||||
(assert= "inner-after" (nth log 3))
|
||||
(assert= "outer-after" (nth log 4))))
|
||||
(deftest
|
||||
"before and after are called"
|
||||
(let
|
||||
((count 0))
|
||||
(dynamic-wind
|
||||
(fn () (set! count (+ count 1)))
|
||||
(fn () nil)
|
||||
(fn () (set! count (+ count 10))))
|
||||
(assert= 11 count)))
|
||||
(deftest
|
||||
"dynamic-wind return value is body result"
|
||||
(let
|
||||
((result (dynamic-wind (fn () nil) (fn () 42) (fn () nil))))
|
||||
(assert= 42 result)))
|
||||
(deftest
|
||||
"after fires before guard handler"
|
||||
(let
|
||||
((log (list)))
|
||||
(guard
|
||||
(e (true (append! log "guard-handler")))
|
||||
(dynamic-wind
|
||||
(fn () nil)
|
||||
(fn () (error "boom"))
|
||||
(fn () (append! log "after"))))
|
||||
(assert= 2 (len log))
|
||||
(assert= "after" (nth log 0))
|
||||
(assert= "guard-handler" (nth log 1)))))
|
||||
@@ -10,57 +10,56 @@
|
||||
;; Literals and types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "literals"
|
||||
(deftest "numbers are numbers"
|
||||
(defsuite
|
||||
"literals"
|
||||
(deftest
|
||||
"numbers are numbers"
|
||||
(assert-type "number" 42)
|
||||
(assert-type "number" 3.14)
|
||||
(assert-type "number" -1))
|
||||
|
||||
(deftest "strings are strings"
|
||||
(deftest
|
||||
"strings are strings"
|
||||
(assert-type "string" "hello")
|
||||
(assert-type "string" ""))
|
||||
|
||||
(deftest "booleans are booleans"
|
||||
(deftest
|
||||
"booleans are booleans"
|
||||
(assert-type "boolean" true)
|
||||
(assert-type "boolean" false))
|
||||
|
||||
(deftest "nil is nil"
|
||||
(assert-type "nil" nil)
|
||||
(assert-nil nil))
|
||||
|
||||
(deftest "lists are lists"
|
||||
(deftest "nil is nil" (assert-type "nil" nil) (assert-nil nil))
|
||||
(deftest
|
||||
"lists are lists"
|
||||
(assert-type "list" (list 1 2 3))
|
||||
(assert-type "list" (list)))
|
||||
|
||||
(deftest "dicts are dicts"
|
||||
(assert-type "dict" {:a 1 :b 2})))
|
||||
(deftest "dicts are dicts" (assert-type "dict" {:b 2 :a 1})))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Arithmetic
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "arithmetic"
|
||||
(deftest "addition"
|
||||
(defsuite
|
||||
"arithmetic"
|
||||
(deftest
|
||||
"addition"
|
||||
(assert-equal 3 (+ 1 2))
|
||||
(assert-equal 0 (+ 0 0))
|
||||
(assert-equal -1 (+ 1 -2))
|
||||
(assert-equal 10 (+ 1 2 3 4)))
|
||||
|
||||
(deftest "subtraction"
|
||||
(deftest
|
||||
"subtraction"
|
||||
(assert-equal 1 (- 3 2))
|
||||
(assert-equal -1 (- 2 3)))
|
||||
|
||||
(deftest "multiplication"
|
||||
(deftest
|
||||
"multiplication"
|
||||
(assert-equal 6 (* 2 3))
|
||||
(assert-equal 0 (* 0 100))
|
||||
(assert-equal 24 (* 1 2 3 4)))
|
||||
|
||||
(deftest "division"
|
||||
(deftest
|
||||
"division"
|
||||
(assert-equal 2 (/ 6 3))
|
||||
(assert-equal 2.5 (/ 5 2)))
|
||||
|
||||
(deftest "modulo"
|
||||
(deftest
|
||||
"modulo"
|
||||
(assert-equal 1 (mod 7 3))
|
||||
(assert-equal 0 (mod 6 3))))
|
||||
|
||||
@@ -69,20 +68,26 @@
|
||||
;; Comparison
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "comparison"
|
||||
(deftest "equality"
|
||||
(defsuite
|
||||
"comparison"
|
||||
(deftest
|
||||
"equality"
|
||||
(assert-true (= 1 1))
|
||||
(assert-false (= 1 2))
|
||||
(assert-true (= "a" "a"))
|
||||
(assert-false (= "a" "b")))
|
||||
|
||||
(deftest "deep equality"
|
||||
(assert-true (equal? (list 1 2 3) (list 1 2 3)))
|
||||
(assert-false (equal? (list 1 2) (list 1 3)))
|
||||
(deftest
|
||||
"deep equality"
|
||||
(assert-true
|
||||
(equal?
|
||||
(list 1 2 3)
|
||||
(list 1 2 3)))
|
||||
(assert-false
|
||||
(equal? (list 1 2) (list 1 3)))
|
||||
(assert-true (equal? {:a 1} {:a 1}))
|
||||
(assert-false (equal? {:a 1} {:a 2})))
|
||||
|
||||
(deftest "ordering"
|
||||
(deftest
|
||||
"ordering"
|
||||
(assert-true (< 1 2))
|
||||
(assert-false (< 2 1))
|
||||
(assert-true (> 2 1))
|
||||
@@ -96,34 +101,36 @@
|
||||
;; String operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "strings"
|
||||
(deftest "str concatenation"
|
||||
(defsuite
|
||||
"strings"
|
||||
(deftest
|
||||
"str concatenation"
|
||||
(assert-equal "abc" (str "a" "b" "c"))
|
||||
(assert-equal "hello world" (str "hello" " " "world"))
|
||||
(assert-equal "42" (str 42))
|
||||
(assert-equal "" (str)))
|
||||
|
||||
(deftest "string-length"
|
||||
(deftest
|
||||
"string-length"
|
||||
(assert-equal 5 (string-length "hello"))
|
||||
(assert-equal 0 (string-length "")))
|
||||
|
||||
(deftest "substring"
|
||||
(deftest
|
||||
"substring"
|
||||
(assert-equal "ell" (substring "hello" 1 4))
|
||||
(assert-equal "hello" (substring "hello" 0 5)))
|
||||
|
||||
(deftest "string-contains?"
|
||||
(deftest
|
||||
"string-contains?"
|
||||
(assert-true (string-contains? "hello world" "world"))
|
||||
(assert-false (string-contains? "hello" "xyz")))
|
||||
|
||||
(deftest "upcase and downcase"
|
||||
(deftest
|
||||
"upcase and downcase"
|
||||
(assert-equal "HELLO" (upcase "hello"))
|
||||
(assert-equal "hello" (downcase "HELLO")))
|
||||
|
||||
(deftest "trim"
|
||||
(deftest
|
||||
"trim"
|
||||
(assert-equal "hello" (trim " hello "))
|
||||
(assert-equal "hello" (trim "hello")))
|
||||
|
||||
(deftest "split and join"
|
||||
(deftest
|
||||
"split and join"
|
||||
(assert-equal (list "a" "b" "c") (split "a,b,c" ","))
|
||||
(assert-equal "a-b-c" (join "-" (list "a" "b" "c")))))
|
||||
|
||||
@@ -132,121 +139,145 @@
|
||||
;; List operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "lists"
|
||||
(deftest "constructors"
|
||||
(assert-equal (list 1 2 3) (list 1 2 3))
|
||||
(defsuite
|
||||
"lists"
|
||||
(deftest
|
||||
"constructors"
|
||||
(assert-equal
|
||||
(list 1 2 3)
|
||||
(list 1 2 3))
|
||||
(assert-equal (list) (list))
|
||||
(assert-length 3 (list 1 2 3)))
|
||||
|
||||
(deftest "first and rest"
|
||||
(deftest
|
||||
"first and rest"
|
||||
(assert-equal 1 (first (list 1 2 3)))
|
||||
(assert-equal (list 2 3) (rest (list 1 2 3)))
|
||||
(assert-equal
|
||||
(list 2 3)
|
||||
(rest (list 1 2 3)))
|
||||
(assert-nil (first (list)))
|
||||
(assert-equal (list) (rest (list))))
|
||||
|
||||
(deftest "nth"
|
||||
(assert-equal 1 (nth (list 1 2 3) 0))
|
||||
(assert-equal 2 (nth (list 1 2 3) 1))
|
||||
(assert-equal 3 (nth (list 1 2 3) 2)))
|
||||
|
||||
(deftest "last"
|
||||
(deftest
|
||||
"nth"
|
||||
(assert-equal
|
||||
1
|
||||
(nth (list 1 2 3) 0))
|
||||
(assert-equal
|
||||
2
|
||||
(nth (list 1 2 3) 1))
|
||||
(assert-equal
|
||||
3
|
||||
(nth (list 1 2 3) 2)))
|
||||
(deftest
|
||||
"last"
|
||||
(assert-equal 3 (last (list 1 2 3)))
|
||||
(assert-nil (last (list))))
|
||||
|
||||
(deftest "cons and append"
|
||||
(assert-equal (list 0 1 2) (cons 0 (list 1 2)))
|
||||
(assert-equal (list 1 2 3 4) (append (list 1 2) (list 3 4))))
|
||||
|
||||
(deftest "reverse"
|
||||
(assert-equal (list 3 2 1) (reverse (list 1 2 3)))
|
||||
(deftest
|
||||
"cons and append"
|
||||
(assert-equal
|
||||
(list 0 1 2)
|
||||
(cons 0 (list 1 2)))
|
||||
(assert-equal
|
||||
(list 1 2 3 4)
|
||||
(append (list 1 2) (list 3 4))))
|
||||
(deftest
|
||||
"reverse"
|
||||
(assert-equal
|
||||
(list 3 2 1)
|
||||
(reverse (list 1 2 3)))
|
||||
(assert-equal (list) (reverse (list))))
|
||||
|
||||
(deftest "empty?"
|
||||
(deftest
|
||||
"empty?"
|
||||
(assert-true (empty? (list)))
|
||||
(assert-false (empty? (list 1))))
|
||||
|
||||
(deftest "len"
|
||||
(deftest
|
||||
"len"
|
||||
(assert-equal 0 (len (list)))
|
||||
(assert-equal 3 (len (list 1 2 3))))
|
||||
|
||||
(deftest "contains?"
|
||||
(assert-true (contains? (list 1 2 3) 2))
|
||||
(assert-false (contains? (list 1 2 3) 4)))
|
||||
|
||||
(deftest "flatten"
|
||||
(assert-equal (list 1 2 3 4) (flatten (list (list 1 2) (list 3 4))))))
|
||||
(deftest
|
||||
"contains?"
|
||||
(assert-true
|
||||
(contains? (list 1 2 3) 2))
|
||||
(assert-false
|
||||
(contains? (list 1 2 3) 4)))
|
||||
(deftest
|
||||
"flatten"
|
||||
(assert-equal
|
||||
(list 1 2 3 4)
|
||||
(flatten
|
||||
(list (list 1 2) (list 3 4))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Dict operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "dicts"
|
||||
(deftest "dict literal"
|
||||
(assert-type "dict" {:a 1 :b 2})
|
||||
(defsuite
|
||||
"dicts"
|
||||
(deftest
|
||||
"dict literal"
|
||||
(assert-type "dict" {:b 2 :a 1})
|
||||
(assert-equal 1 (get {:a 1} "a"))
|
||||
(assert-equal 2 (get {:a 1 :b 2} "b")))
|
||||
|
||||
(deftest "assoc"
|
||||
(assert-equal {:a 1 :b 2} (assoc {:a 1} "b" 2))
|
||||
(assert-equal 2 (get {:b 2 :a 1} "b")))
|
||||
(deftest
|
||||
"assoc"
|
||||
(assert-equal {:b 2 :a 1} (assoc {:a 1} "b" 2))
|
||||
(assert-equal {:a 99} (assoc {:a 1} "a" 99)))
|
||||
|
||||
(deftest "dissoc"
|
||||
(assert-equal {:b 2} (dissoc {:a 1 :b 2} "a")))
|
||||
|
||||
(deftest "keys and vals"
|
||||
(let ((d {:a 1 :b 2}))
|
||||
(deftest "dissoc" (assert-equal {:b 2} (dissoc {:b 2 :a 1} "a")))
|
||||
(deftest
|
||||
"keys and vals"
|
||||
(let
|
||||
((d {:b 2 :a 1}))
|
||||
(assert-length 2 (keys d))
|
||||
(assert-length 2 (vals d))
|
||||
(assert-contains "a" (keys d))
|
||||
(assert-contains "b" (keys d))))
|
||||
|
||||
(deftest "has-key?"
|
||||
(deftest
|
||||
"has-key?"
|
||||
(assert-true (has-key? {:a 1} "a"))
|
||||
(assert-false (has-key? {:a 1} "b")))
|
||||
|
||||
(deftest "merge"
|
||||
(assert-equal {:a 1 :b 2 :c 3}
|
||||
(merge {:a 1 :b 2} {:c 3}))
|
||||
(assert-equal {:a 99 :b 2}
|
||||
(merge {:a 1 :b 2} {:a 99}))))
|
||||
(deftest
|
||||
"merge"
|
||||
(assert-equal {:c 3 :b 2 :a 1} (merge {:b 2 :a 1} {:c 3}))
|
||||
(assert-equal {:b 2 :a 99} (merge {:b 2 :a 1} {:a 99}))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Predicates
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "predicates"
|
||||
(deftest "nil?"
|
||||
(defsuite
|
||||
"predicates"
|
||||
(deftest
|
||||
"nil?"
|
||||
(assert-true (nil? nil))
|
||||
(assert-false (nil? 0))
|
||||
(assert-false (nil? false))
|
||||
(assert-false (nil? "")))
|
||||
|
||||
(deftest "number?"
|
||||
(deftest
|
||||
"number?"
|
||||
(assert-true (number? 42))
|
||||
(assert-true (number? 3.14))
|
||||
(assert-false (number? "42")))
|
||||
|
||||
(deftest "string?"
|
||||
(deftest
|
||||
"string?"
|
||||
(assert-true (string? "hello"))
|
||||
(assert-false (string? 42)))
|
||||
|
||||
(deftest "list?"
|
||||
(deftest
|
||||
"list?"
|
||||
(assert-true (list? (list 1 2)))
|
||||
(assert-false (list? "not a list")))
|
||||
|
||||
(deftest "dict?"
|
||||
(deftest
|
||||
"dict?"
|
||||
(assert-true (dict? {:a 1}))
|
||||
(assert-false (dict? (list 1))))
|
||||
|
||||
(deftest "boolean?"
|
||||
(deftest
|
||||
"boolean?"
|
||||
(assert-true (boolean? true))
|
||||
(assert-true (boolean? false))
|
||||
(assert-false (boolean? nil))
|
||||
(assert-false (boolean? 0)))
|
||||
|
||||
(deftest "not"
|
||||
(deftest
|
||||
"not"
|
||||
(assert-true (not false))
|
||||
(assert-true (not nil))
|
||||
(assert-false (not true))
|
||||
@@ -258,77 +289,67 @@
|
||||
;; Special forms
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "special-forms"
|
||||
(deftest "if"
|
||||
(defsuite
|
||||
"special-forms"
|
||||
(deftest
|
||||
"if"
|
||||
(assert-equal "yes" (if true "yes" "no"))
|
||||
(assert-equal "no" (if false "yes" "no"))
|
||||
(assert-equal "no" (if nil "yes" "no"))
|
||||
(assert-nil (if false "yes")))
|
||||
|
||||
(deftest "when"
|
||||
(deftest
|
||||
"when"
|
||||
(assert-equal "yes" (when true "yes"))
|
||||
(assert-nil (when false "yes")))
|
||||
|
||||
(deftest "cond"
|
||||
(deftest
|
||||
"cond"
|
||||
(assert-equal "a" (cond true "a" :else "b"))
|
||||
(assert-equal "b" (cond false "a" :else "b"))
|
||||
(assert-equal "c" (cond
|
||||
false "a"
|
||||
false "b"
|
||||
:else "c")))
|
||||
|
||||
(deftest "cond with 2-element predicate as first test"
|
||||
;; Regression: cond misclassifies Clojure-style as scheme-style when
|
||||
;; the first test is a 2-element list like (nil? x) or (empty? x).
|
||||
;; The evaluator checks: is first arg a 2-element list? If yes, treats
|
||||
;; as scheme-style ((test body) ...) — returning the arg instead of
|
||||
;; evaluating the predicate call.
|
||||
(assert-equal "c" (cond false "a" false "b" :else "c")))
|
||||
(deftest
|
||||
"cond with 2-element predicate as first test"
|
||||
(assert-equal 0 (cond (nil? nil) 0 :else 1))
|
||||
(assert-equal 1 (cond (nil? "x") 0 :else 1))
|
||||
(assert-equal "empty" (cond (empty? (list)) "empty" :else "not-empty"))
|
||||
(assert-equal "not-empty" (cond (empty? (list 1)) "empty" :else "not-empty"))
|
||||
(assert-equal
|
||||
"not-empty"
|
||||
(cond (empty? (list 1)) "empty" :else "not-empty"))
|
||||
(assert-equal "yes" (cond (not false) "yes" :else "no"))
|
||||
(assert-equal "no" (cond (not true) "yes" :else "no")))
|
||||
|
||||
(deftest "cond with 2-element predicate and no :else"
|
||||
;; Same bug, but without :else — this is the worst case because the
|
||||
;; bootstrapper heuristic also breaks (all clauses are 2-element lists).
|
||||
(assert-equal "found"
|
||||
(cond (nil? nil) "found"
|
||||
(nil? "x") "other"))
|
||||
(assert-equal "b"
|
||||
(cond (nil? "x") "a"
|
||||
(not false) "b")))
|
||||
|
||||
(deftest "and"
|
||||
(deftest
|
||||
"cond with 2-element predicate and no :else"
|
||||
(assert-equal "found" (cond (nil? nil) "found" (nil? "x") "other"))
|
||||
(assert-equal "b" (cond (nil? "x") "a" (not false) "b")))
|
||||
(deftest
|
||||
"and"
|
||||
(assert-true (and true true))
|
||||
(assert-false (and true false))
|
||||
(assert-false (and false true))
|
||||
(assert-equal 3 (and 1 2 3)))
|
||||
|
||||
(deftest "or"
|
||||
(deftest
|
||||
"or"
|
||||
(assert-equal 1 (or 1 2))
|
||||
(assert-equal 2 (or false 2))
|
||||
(assert-equal "fallback" (or nil false "fallback"))
|
||||
(assert-false (or false false)))
|
||||
|
||||
(deftest "let"
|
||||
(assert-equal 3 (let ((x 1) (y 2)) (+ x y)))
|
||||
(assert-equal "hello world"
|
||||
(deftest
|
||||
"let"
|
||||
(assert-equal
|
||||
3
|
||||
(let ((x 1) (y 2)) (+ x y)))
|
||||
(assert-equal
|
||||
"hello world"
|
||||
(let ((a "hello") (b " world")) (str a b))))
|
||||
|
||||
(deftest "let clojure-style"
|
||||
(deftest
|
||||
"let clojure-style"
|
||||
(assert-equal 3 (let (x 1 y 2) (+ x y))))
|
||||
|
||||
(deftest "do / begin"
|
||||
(deftest
|
||||
"do / begin"
|
||||
(assert-equal 3 (do 1 2 3))
|
||||
(assert-equal "last" (begin "first" "middle" "last")))
|
||||
|
||||
(deftest "define"
|
||||
(define x 42)
|
||||
(assert-equal 42 x))
|
||||
|
||||
(deftest "set!"
|
||||
(deftest "define" (define x 42) (assert-equal 42 x))
|
||||
(deftest
|
||||
"set!"
|
||||
(define x 1)
|
||||
(set! x 2)
|
||||
(assert-equal 2 x)))
|
||||
@@ -338,86 +359,126 @@
|
||||
;; Lambda and closures
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "lambdas"
|
||||
(deftest "basic lambda"
|
||||
(let ((add (fn (a b) (+ a b))))
|
||||
(defsuite
|
||||
"lambdas"
|
||||
(deftest
|
||||
"basic lambda"
|
||||
(let
|
||||
((add (fn (a b) (+ a b))))
|
||||
(assert-equal 3 (add 1 2))))
|
||||
|
||||
(deftest "closure captures env"
|
||||
(let ((x 10))
|
||||
(let ((add-x (fn (y) (+ x y))))
|
||||
(deftest
|
||||
"closure captures env"
|
||||
(let
|
||||
((x 10))
|
||||
(let
|
||||
((add-x (fn (y) (+ x y))))
|
||||
(assert-equal 15 (add-x 5)))))
|
||||
|
||||
(deftest "lambda as argument"
|
||||
(assert-equal (list 2 4 6)
|
||||
(map (fn (x) (* x 2)) (list 1 2 3))))
|
||||
|
||||
(deftest "recursive lambda via define"
|
||||
(define factorial
|
||||
(fn (n) (if (<= n 1) 1 (* n (factorial (- n 1))))))
|
||||
(deftest
|
||||
"lambda as argument"
|
||||
(assert-equal
|
||||
(list 2 4 6)
|
||||
(map
|
||||
(fn (x) (* x 2))
|
||||
(list 1 2 3))))
|
||||
(deftest
|
||||
"recursive lambda via define"
|
||||
(define
|
||||
factorial
|
||||
(fn
|
||||
(n)
|
||||
(if
|
||||
(<= n 1)
|
||||
1
|
||||
(* n (factorial (- n 1))))))
|
||||
(assert-equal 120 (factorial 5)))
|
||||
|
||||
(deftest "higher-order returns lambda"
|
||||
(let ((make-adder (fn (n) (fn (x) (+ n x)))))
|
||||
(let ((add5 (make-adder 5)))
|
||||
(deftest
|
||||
"higher-order returns lambda"
|
||||
(let
|
||||
((make-adder (fn (n) (fn (x) (+ n x)))))
|
||||
(let
|
||||
((add5 (make-adder 5)))
|
||||
(assert-equal 8 (add5 3)))))
|
||||
|
||||
(deftest "multi-body lambda returns last value"
|
||||
;; All body expressions must execute. Return value is the last.
|
||||
;; Catches: sf-lambda using nth(args,1) instead of rest(args).
|
||||
(let ((f (fn (x) (+ x 1) (+ x 2) (+ x 3))))
|
||||
(deftest
|
||||
"multi-body lambda returns last value"
|
||||
(let
|
||||
((f (fn (x) (+ x 1) (+ x 2) (+ x 3))))
|
||||
(assert-equal 13 (f 10))))
|
||||
|
||||
(deftest "multi-body lambda side effects via dict mutation"
|
||||
;; Verify all body expressions run by mutating a shared dict.
|
||||
(let ((state (dict "a" 0 "b" 0)))
|
||||
(let ((f (fn ()
|
||||
(dict-set! state "a" 1)
|
||||
(dict-set! state "b" 2)
|
||||
"done")))
|
||||
(deftest
|
||||
"multi-body lambda side effects via dict mutation"
|
||||
(let
|
||||
((state (dict "a" 0 "b" 0)))
|
||||
(let
|
||||
((f (fn () (dict-set! state "a" 1) (dict-set! state "b" 2) "done")))
|
||||
(assert-equal "done" (f))
|
||||
(assert-equal 1 (get state "a"))
|
||||
(assert-equal 2 (get state "b")))))
|
||||
|
||||
(deftest "multi-body lambda two expressions"
|
||||
;; Simplest case: two body expressions, return value is second.
|
||||
(assert-equal 20
|
||||
(deftest
|
||||
"multi-body lambda two expressions"
|
||||
(assert-equal
|
||||
20
|
||||
((fn (x) (+ x 1) (* x 2)) 10))
|
||||
;; And with zero-arg lambda
|
||||
(assert-equal 42
|
||||
((fn () (+ 1 2) 42)))))
|
||||
(assert-equal 42 ((fn () (+ 1 2) 42)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Higher-order forms
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "higher-order"
|
||||
(deftest "map"
|
||||
(assert-equal (list 2 4 6)
|
||||
(map (fn (x) (* x 2)) (list 1 2 3)))
|
||||
(defsuite
|
||||
"higher-order"
|
||||
(deftest
|
||||
"map"
|
||||
(assert-equal
|
||||
(list 2 4 6)
|
||||
(map
|
||||
(fn (x) (* x 2))
|
||||
(list 1 2 3)))
|
||||
(assert-equal (list) (map (fn (x) x) (list))))
|
||||
|
||||
(deftest "filter"
|
||||
(assert-equal (list 2 4)
|
||||
(filter (fn (x) (= (mod x 2) 0)) (list 1 2 3 4)))
|
||||
(assert-equal (list)
|
||||
(deftest
|
||||
"filter"
|
||||
(assert-equal
|
||||
(list 2 4)
|
||||
(filter
|
||||
(fn (x) (= (mod x 2) 0))
|
||||
(list 1 2 3 4)))
|
||||
(assert-equal
|
||||
(list)
|
||||
(filter (fn (x) false) (list 1 2 3))))
|
||||
|
||||
(deftest "reduce"
|
||||
(assert-equal 10 (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4)))
|
||||
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list))))
|
||||
|
||||
(deftest "some"
|
||||
(assert-true (some (fn (x) (> x 3)) (list 1 2 3 4 5)))
|
||||
(assert-false (some (fn (x) (> x 10)) (list 1 2 3))))
|
||||
|
||||
(deftest "every?"
|
||||
(assert-true (every? (fn (x) (> x 0)) (list 1 2 3)))
|
||||
(assert-false (every? (fn (x) (> x 2)) (list 1 2 3))))
|
||||
|
||||
(deftest "map-indexed"
|
||||
(assert-equal (list "0:a" "1:b" "2:c")
|
||||
(deftest
|
||||
"reduce"
|
||||
(assert-equal
|
||||
10
|
||||
(reduce
|
||||
(fn (acc x) (+ acc x))
|
||||
0
|
||||
(list 1 2 3 4)))
|
||||
(assert-equal
|
||||
0
|
||||
(reduce (fn (acc x) (+ acc x)) 0 (list))))
|
||||
(deftest
|
||||
"some"
|
||||
(assert-true
|
||||
(some
|
||||
(fn (x) (> x 3))
|
||||
(list 1 2 3 4 5)))
|
||||
(assert-false
|
||||
(some
|
||||
(fn (x) (> x 10))
|
||||
(list 1 2 3))))
|
||||
(deftest
|
||||
"every?"
|
||||
(assert-true
|
||||
(every?
|
||||
(fn (x) (> x 0))
|
||||
(list 1 2 3)))
|
||||
(assert-false
|
||||
(every?
|
||||
(fn (x) (> x 2))
|
||||
(list 1 2 3))))
|
||||
(deftest
|
||||
"map-indexed"
|
||||
(assert-equal
|
||||
(list "0:a" "1:b" "2:c")
|
||||
(map-indexed (fn (i x) (str i ":" x)) (list "a" "b" "c")))))
|
||||
|
||||
|
||||
@@ -425,49 +486,39 @@
|
||||
;; Components
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "components"
|
||||
(deftest "defcomp creates component"
|
||||
(defcomp ~test-comp (&key title)
|
||||
(div title))
|
||||
(defsuite
|
||||
"components"
|
||||
(deftest
|
||||
"defcomp creates component"
|
||||
(defcomp ~test-comp (&key title) (div title))
|
||||
(assert-true (not (nil? ~test-comp))))
|
||||
|
||||
(deftest "component renders with keyword args"
|
||||
(defcomp ~greeting (&key name)
|
||||
(span (str "Hello, " name "!")))
|
||||
(deftest
|
||||
"component renders with keyword args"
|
||||
(defcomp ~greeting (&key name) (span (str "Hello, " name "!")))
|
||||
(assert-true (not (nil? ~greeting))))
|
||||
|
||||
(deftest "component with children"
|
||||
(defcomp ~box (&key &rest children)
|
||||
(div :class "box" children))
|
||||
(deftest
|
||||
"component with children"
|
||||
(defcomp ~box (&key &rest children) (div :class "box" children))
|
||||
(assert-true (not (nil? ~box))))
|
||||
|
||||
(deftest "component with default via or"
|
||||
(defcomp ~label (&key text)
|
||||
(span (or text "default")))
|
||||
(deftest
|
||||
"component with default via or"
|
||||
(defcomp ~label (&key text) (span (or text "default")))
|
||||
(assert-true (not (nil? ~label))))
|
||||
|
||||
(deftest "defcomp default affinity is auto"
|
||||
(defcomp ~aff-default (&key x)
|
||||
(div x))
|
||||
(deftest
|
||||
"defcomp default affinity is auto"
|
||||
(defcomp ~aff-default (&key x) (div x))
|
||||
(assert-equal "auto" (component-affinity ~aff-default)))
|
||||
|
||||
(deftest "defcomp affinity client"
|
||||
(defcomp ~aff-client (&key x)
|
||||
:affinity :client
|
||||
(div x))
|
||||
(deftest
|
||||
"defcomp affinity client"
|
||||
(defcomp ~aff-client (&key x) :affinity :client (div x))
|
||||
(assert-equal "client" (component-affinity ~aff-client)))
|
||||
|
||||
(deftest "defcomp affinity server"
|
||||
(defcomp ~aff-server (&key x)
|
||||
:affinity :server
|
||||
(div x))
|
||||
(deftest
|
||||
"defcomp affinity server"
|
||||
(defcomp ~aff-server (&key x) :affinity :server (div x))
|
||||
(assert-equal "server" (component-affinity ~aff-server)))
|
||||
|
||||
(deftest "defcomp affinity preserves body"
|
||||
(defcomp ~aff-body (&key val)
|
||||
:affinity :client
|
||||
(span val))
|
||||
;; Component should still render correctly
|
||||
(deftest
|
||||
"defcomp affinity preserves body"
|
||||
(defcomp ~aff-body (&key val) :affinity :client (span val))
|
||||
(assert-equal "client" (component-affinity ~aff-body))
|
||||
(assert-true (not (nil? ~aff-body)))))
|
||||
|
||||
@@ -476,93 +527,98 @@
|
||||
;; Macros
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "macros"
|
||||
(deftest "defmacro creates macro"
|
||||
(defmacro unless (cond &rest body)
|
||||
`(if (not ,cond) (do ,@body)))
|
||||
(defsuite
|
||||
"macros"
|
||||
(deftest
|
||||
"defmacro creates macro"
|
||||
(defmacro
|
||||
unless
|
||||
(cond &rest body)
|
||||
(quasiquote (if (not (unquote cond)) (do (splice-unquote body)))))
|
||||
(assert-equal "yes" (unless false "yes"))
|
||||
(assert-nil (unless true "no")))
|
||||
|
||||
(deftest "quasiquote and unquote"
|
||||
(let ((x 42))
|
||||
(assert-equal (list 1 42 3) `(1 ,x 3))))
|
||||
|
||||
(deftest "splice-unquote"
|
||||
(let ((xs (list 2 3 4)))
|
||||
(assert-equal (list 1 2 3 4 5) `(1 ,@xs 5)))))
|
||||
(deftest
|
||||
"quasiquote and unquote"
|
||||
(let
|
||||
((x 42))
|
||||
(assert-equal
|
||||
(list 1 42 3)
|
||||
(quasiquote (1 (unquote x) 3)))))
|
||||
(deftest
|
||||
"splice-unquote"
|
||||
(let
|
||||
((xs (list 2 3 4)))
|
||||
(assert-equal
|
||||
(list 1 2 3 4 5)
|
||||
(quasiquote (1 (splice-unquote xs) 5))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Threading macro
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "threading"
|
||||
(deftest "thread-first"
|
||||
(defsuite
|
||||
"threading"
|
||||
(deftest
|
||||
"thread-first"
|
||||
(assert-equal 8 (-> 5 (+ 1) (+ 2)))
|
||||
(assert-equal "HELLO" (-> "hello" upcase))
|
||||
(assert-equal "HELLO WORLD"
|
||||
(-> "hello"
|
||||
(str " world")
|
||||
upcase))))
|
||||
(assert-equal "HELLO WORLD" (-> "hello" (str " world") upcase))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Truthiness
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "truthiness"
|
||||
(deftest "truthy values"
|
||||
(defsuite
|
||||
"truthiness"
|
||||
(deftest
|
||||
"truthy values"
|
||||
(assert-true (if 1 true false))
|
||||
(assert-true (if "x" true false))
|
||||
(assert-true (if (list 1) true false))
|
||||
(assert-true (if true true false)))
|
||||
|
||||
(deftest "falsy values"
|
||||
(deftest
|
||||
"falsy values"
|
||||
(assert-false (if false true false))
|
||||
(assert-false (if nil true false)))
|
||||
|
||||
;; NOTE: empty list, zero, and empty string truthiness is
|
||||
;; platform-dependent. Python treats all three as falsy.
|
||||
;; JavaScript treats [] as truthy but 0 and "" as falsy.
|
||||
;; These tests are omitted — each bootstrapper should emit
|
||||
;; platform-specific truthiness tests instead.
|
||||
)
|
||||
(assert-false (if nil true false))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Edge cases and regression tests
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "edge-cases"
|
||||
(deftest "nested let scoping"
|
||||
(let ((x 1))
|
||||
(let ((x 2))
|
||||
(assert-equal 2 x))
|
||||
;; outer x should be unchanged by inner let
|
||||
;; (this tests that let creates a new scope)
|
||||
))
|
||||
|
||||
(deftest "recursive map"
|
||||
(assert-equal (list (list 2 4) (list 6 8))
|
||||
(map (fn (sub) (map (fn (x) (* x 2)) sub))
|
||||
(list (list 1 2) (list 3 4)))))
|
||||
|
||||
(deftest "keyword as value"
|
||||
(defsuite
|
||||
"edge-cases"
|
||||
(deftest
|
||||
"nested let scoping"
|
||||
(let
|
||||
((x 1))
|
||||
(let ((x 2)) (assert-equal 2 x))))
|
||||
(deftest
|
||||
"recursive map"
|
||||
(assert-equal
|
||||
(list (list 2 4) (list 6 8))
|
||||
(map
|
||||
(fn (sub) (map (fn (x) (* x 2)) sub))
|
||||
(list (list 1 2) (list 3 4)))))
|
||||
(deftest
|
||||
"keyword as value"
|
||||
(assert-equal "class" :class)
|
||||
(assert-equal "id" :id))
|
||||
|
||||
(deftest "dict with evaluated values"
|
||||
(let ((x 42))
|
||||
(assert-equal 42 (get {:val x} "val"))))
|
||||
|
||||
(deftest "nil propagation"
|
||||
(deftest
|
||||
"dict with evaluated values"
|
||||
(let ((x 42)) (assert-equal 42 (get {:val x} "val"))))
|
||||
(deftest
|
||||
"nil propagation"
|
||||
(assert-nil (get {:a 1} "missing"))
|
||||
(assert-equal "default" (or (get {:a 1} "missing") "default")))
|
||||
|
||||
(deftest "empty operations"
|
||||
(deftest
|
||||
"empty operations"
|
||||
(assert-equal (list) (map (fn (x) x) (list)))
|
||||
(assert-equal (list) (filter (fn (x) true) (list)))
|
||||
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list)))
|
||||
(assert-equal
|
||||
0
|
||||
(reduce (fn (acc x) (+ acc x)) 0 (list)))
|
||||
(assert-equal 0 (len (list)))
|
||||
(assert-equal "" (str))))
|
||||
|
||||
|
||||
90
spec/tests/test-format.sx
Normal file
90
spec/tests/test-format.sx
Normal file
@@ -0,0 +1,90 @@
|
||||
;; ==========================================================================
|
||||
;; test-format.sx — Tests for CL-style format function
|
||||
;; ==========================================================================
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; basic directives
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"format:basic"
|
||||
(deftest "format returns string" (assert (string? (format "hello"))))
|
||||
(deftest
|
||||
"format no directives"
|
||||
(assert= (format "hello world") "hello world"))
|
||||
(deftest "format empty template" (assert= (format "") ""))
|
||||
(deftest "~a display string" (assert= (format "~a" "hello") "hello"))
|
||||
(deftest "~a display number" (assert= (format "~a" 42) "42"))
|
||||
(deftest "~a display nil" (assert= (format "~a" nil) "()"))
|
||||
(deftest
|
||||
"~s write string (with quotes)"
|
||||
(assert= (format "~s" "hi") "\"hi\""))
|
||||
(deftest "~s write number" (assert= (format "~s" 42) "42"))
|
||||
(deftest
|
||||
"multiple args"
|
||||
(assert= (format "~a and ~a" "foo" "bar") "foo and bar")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; numeric directives
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"format:numeric"
|
||||
(deftest "~d decimal" (assert= (format "~d" 255) "255"))
|
||||
(deftest "~x hex" (assert= (format "~x" 255) "ff"))
|
||||
(deftest "~o octal" (assert= (format "~o" 8) "10"))
|
||||
(deftest "~b binary" (assert= (format "~b" 10) "1010"))
|
||||
(deftest "~d zero" (assert= (format "~d" 0) "0"))
|
||||
(deftest
|
||||
"~x uppercase digits"
|
||||
(assert= (format "value: ~x" 16) "value: 10")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; float directives
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"format:float"
|
||||
(deftest "~f fixed point" (assert= (format "~f" 3.14) "3.140000"))
|
||||
(deftest "~f zero" (assert= (format "~f" 0) "0.000000")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; control directives
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"format:control"
|
||||
(deftest "~% newline" (assert= (format "a~%b") "a\nb"))
|
||||
(deftest "~~ literal tilde" (assert= (format "100~~") "100~"))
|
||||
(deftest "~t tab" (assert= (format "a~tb") "a\tb"))
|
||||
(deftest "~& fresh line at start" (assert= (format "~&hello") "\nhello"))
|
||||
(deftest
|
||||
"~& no newline if already at newline"
|
||||
(assert= (format "line~%~&next") "line\nnext")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; mixed / compound
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"format:compound"
|
||||
(deftest
|
||||
"name and age"
|
||||
(assert=
|
||||
(format "Hello ~a, age ~d" "Alice" 30)
|
||||
"Hello Alice, age 30"))
|
||||
(deftest
|
||||
"hex dump style"
|
||||
(assert=
|
||||
(format "~d = 0x~x = 0b~b" 10 10 10)
|
||||
"10 = 0xa = 0b1010"))
|
||||
(deftest "multiple newlines" (assert= (format "~%~%") "\n\n"))
|
||||
(deftest "text with no args" (assert= (format "status: ok") "status: ok"))
|
||||
(deftest
|
||||
"tilde at end (unknown directive)"
|
||||
(assert (string? (format "test~"))))
|
||||
(deftest
|
||||
"nested strings in ~a"
|
||||
(assert=
|
||||
(format "got: ~a" (list 1 2 3))
|
||||
"got: (1 2 3)")))
|
||||
78
spec/tests/test-gensym.sx
Normal file
78
spec/tests/test-gensym.sx
Normal file
@@ -0,0 +1,78 @@
|
||||
(defsuite
|
||||
"gensym"
|
||||
(deftest "gensym returns a symbol" (assert= true (symbol? (gensym))))
|
||||
(deftest
|
||||
"gensym default prefix is g"
|
||||
(let
|
||||
((s (symbol-name (gensym))))
|
||||
(assert= true (string-contains? s "g"))))
|
||||
(deftest
|
||||
"gensym with prefix uses that prefix"
|
||||
(let
|
||||
((s (symbol-name (gensym "var"))))
|
||||
(assert= "var" (substring s 0 3))))
|
||||
(deftest
|
||||
"gensym produces unique symbols"
|
||||
(let
|
||||
((a (gensym)) (b (gensym)))
|
||||
(assert= false (= (symbol-name a) (symbol-name b)))))
|
||||
(deftest
|
||||
"gensym same prefix produces unique symbols"
|
||||
(let
|
||||
((a (gensym "x")) (b (gensym "x")) (c (gensym "x")))
|
||||
(assert= false (= (symbol-name a) (symbol-name b)))
|
||||
(assert= false (= (symbol-name b) (symbol-name c)))))
|
||||
(deftest
|
||||
"gensym counter increases: names differ"
|
||||
(let
|
||||
((a (gensym "k")) (b (gensym "k")))
|
||||
(assert= false (= (symbol-name a) (symbol-name b)))))
|
||||
(deftest
|
||||
"gensym no-arg and prefix-arg both unique"
|
||||
(let
|
||||
((a (gensym)) (b (gensym "g")))
|
||||
(assert= false (= (symbol-name a) (symbol-name b)))))
|
||||
(deftest
|
||||
"string->symbol returns a symbol"
|
||||
(assert= true (symbol? (string->symbol "hello"))))
|
||||
(deftest
|
||||
"string->symbol symbol has correct name"
|
||||
(assert= "hello" (symbol-name (string->symbol "hello"))))
|
||||
(deftest
|
||||
"string->symbol empty string"
|
||||
(assert= true (symbol? (string->symbol ""))))
|
||||
(deftest
|
||||
"symbol->string returns a string"
|
||||
(assert= true (string? (symbol->string (quote foo)))))
|
||||
(deftest
|
||||
"symbol->string round-trips with string->symbol"
|
||||
(assert= "hello" (symbol->string (string->symbol "hello"))))
|
||||
(deftest
|
||||
"string->symbol/symbol->string round-trip"
|
||||
(let
|
||||
((sym (string->symbol "my-var")))
|
||||
(assert= "my-var" (symbol->string sym))))
|
||||
(deftest
|
||||
"intern returns a symbol"
|
||||
(assert= true (symbol? (intern "foo"))))
|
||||
(deftest
|
||||
"intern same as string->symbol"
|
||||
(assert= "bar" (symbol-name (intern "bar"))))
|
||||
(deftest
|
||||
"symbol-interned? true for literal symbols"
|
||||
(assert= true (symbol-interned? (quote hello))))
|
||||
(deftest
|
||||
"symbol-interned? true for gensym'd symbol"
|
||||
(assert= true (symbol-interned? (gensym "g"))))
|
||||
(deftest
|
||||
"symbol-interned? true for string->symbol"
|
||||
(assert= true (symbol-interned? (string->symbol "test"))))
|
||||
(deftest
|
||||
"multiple gensym calls all unique"
|
||||
(let
|
||||
((syms (map (fn (i) (gensym "t")) (in-range 5))))
|
||||
(let
|
||||
((names (map symbol-name syms)))
|
||||
(let
|
||||
((unique-names (reduce (fn (acc n) (if (some (fn (x) (= x n)) acc) acc (cons n acc))) (list) names)))
|
||||
(assert-equal 5 (len unique-names)))))))
|
||||
166
spec/tests/test-hash-table.sx
Normal file
166
spec/tests/test-hash-table.sx
Normal file
@@ -0,0 +1,166 @@
|
||||
;; Tests for mutable hash tables (Phase 10)
|
||||
|
||||
(defsuite
|
||||
"hash-table"
|
||||
(deftest
|
||||
"make-hash-table returns a hash table"
|
||||
(assert (hash-table? (make-hash-table))))
|
||||
(deftest
|
||||
"hash-table? false for dict"
|
||||
(assert= false (hash-table? {:a 1})))
|
||||
(deftest "hash-table? false for nil" (assert= false (hash-table? nil)))
|
||||
(deftest
|
||||
"hash-table? false for list"
|
||||
(assert= false (hash-table? (list 1 2))))
|
||||
(deftest
|
||||
"empty table has size 0"
|
||||
(assert= 0 (hash-table-size (make-hash-table))))
|
||||
(deftest
|
||||
"size after one set"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht "a" 1)
|
||||
(assert= 1 (hash-table-size ht))))
|
||||
(deftest
|
||||
"size after multiple sets"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht "a" 1)
|
||||
(hash-table-set! ht "b" 2)
|
||||
(hash-table-set! ht "c" 3)
|
||||
(assert= 3 (hash-table-size ht))))
|
||||
(deftest
|
||||
"set same key does not grow size"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht "a" 1)
|
||||
(hash-table-set! ht "a" 2)
|
||||
(assert= 1 (hash-table-size ht))))
|
||||
(deftest
|
||||
"ref returns set value"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht "k" 42)
|
||||
(assert= 42 (hash-table-ref ht "k"))))
|
||||
(deftest
|
||||
"ref returns updated value after overwrite"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht "k" 1)
|
||||
(hash-table-set! ht "k" 99)
|
||||
(assert= 99 (hash-table-ref ht "k"))))
|
||||
(deftest
|
||||
"ref with default returns default for missing key"
|
||||
(assert=
|
||||
"fallback"
|
||||
(hash-table-ref (make-hash-table) "missing" "fallback")))
|
||||
(deftest
|
||||
"ref with default returns value when key exists"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht "x" 7)
|
||||
(assert= 7 (hash-table-ref ht "x" 0))))
|
||||
(deftest
|
||||
"keyword keys work"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht :foo "bar")
|
||||
(assert= "bar" (hash-table-ref ht :foo))))
|
||||
(deftest
|
||||
"number keys work"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht 0 "zero")
|
||||
(assert= "zero" (hash-table-ref ht 0))))
|
||||
(deftest
|
||||
"delete removes key"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht "x" 1)
|
||||
(hash-table-delete! ht "x")
|
||||
(assert= "gone" (hash-table-ref ht "x" "gone"))))
|
||||
(deftest
|
||||
"delete reduces size"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht "a" 1)
|
||||
(hash-table-set! ht "b" 2)
|
||||
(hash-table-delete! ht "a")
|
||||
(assert= 1 (hash-table-size ht))))
|
||||
(deftest
|
||||
"delete missing key is no-op"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-delete! ht "absent")
|
||||
(assert= 0 (hash-table-size ht))))
|
||||
(deftest
|
||||
"keys of empty table is empty"
|
||||
(assert (empty? (hash-table-keys (make-hash-table)))))
|
||||
(deftest
|
||||
"keys has correct count"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht "a" 1)
|
||||
(hash-table-set! ht "b" 2)
|
||||
(assert= 2 (len (hash-table-keys ht)))))
|
||||
(deftest
|
||||
"values has correct count"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht "a" 10)
|
||||
(hash-table-set! ht "b" 20)
|
||||
(assert= 2 (len (hash-table-values ht)))))
|
||||
(deftest
|
||||
"alist of empty table is empty"
|
||||
(assert (empty? (hash-table->alist (make-hash-table)))))
|
||||
(deftest
|
||||
"alist has correct length"
|
||||
(let
|
||||
((ht (make-hash-table)))
|
||||
(hash-table-set! ht "x" 1)
|
||||
(hash-table-set! ht "y" 2)
|
||||
(assert= 2 (len (hash-table->alist ht)))))
|
||||
(deftest
|
||||
"for-each visits all entries"
|
||||
(let
|
||||
((ht (make-hash-table)) (count 0))
|
||||
(hash-table-set! ht "a" 1)
|
||||
(hash-table-set! ht "b" 2)
|
||||
(hash-table-set! ht "c" 3)
|
||||
(hash-table-for-each ht (fn (k v) (set! count (+ count 1))))
|
||||
(assert= 3 count)))
|
||||
(deftest
|
||||
"for-each sums values"
|
||||
(let
|
||||
((ht (make-hash-table)) (total 0))
|
||||
(hash-table-set! ht "a" 10)
|
||||
(hash-table-set! ht "b" 20)
|
||||
(hash-table-set! ht "c" 30)
|
||||
(hash-table-for-each ht (fn (k v) (set! total (+ total v))))
|
||||
(assert= 60 total)))
|
||||
(deftest
|
||||
"merge copies entries from src to dst"
|
||||
(let
|
||||
((dst (make-hash-table)) (src (make-hash-table)))
|
||||
(hash-table-set! src "x" 1)
|
||||
(hash-table-set! src "y" 2)
|
||||
(hash-table-merge! dst src)
|
||||
(assert= 2 (hash-table-size dst))))
|
||||
(deftest
|
||||
"merge overwrites existing keys in dst"
|
||||
(let
|
||||
((dst (make-hash-table)) (src (make-hash-table)))
|
||||
(hash-table-set! dst "k" "old")
|
||||
(hash-table-set! src "k" "new")
|
||||
(hash-table-merge! dst src)
|
||||
(assert= "new" (hash-table-ref dst "k"))))
|
||||
(deftest
|
||||
"merge does not modify src"
|
||||
(let
|
||||
((dst (make-hash-table)) (src (make-hash-table)))
|
||||
(hash-table-set! src "a" 1)
|
||||
(hash-table-merge! dst src)
|
||||
(assert= 1 (hash-table-size src))))
|
||||
(deftest
|
||||
"type-of returns hash-table"
|
||||
(assert= "hash-table" (type-of (make-hash-table)))))
|
||||
131
spec/tests/test-math.sx
Normal file
131
spec/tests/test-math.sx
Normal file
@@ -0,0 +1,131 @@
|
||||
|
||||
(deftest
|
||||
"math completeness"
|
||||
(deftest
|
||||
"trigonometry"
|
||||
(deftest
|
||||
"sin"
|
||||
(assert= 0 (round (sin 0)) "sin 0 = 0")
|
||||
(assert=
|
||||
1
|
||||
(round (sin (/ 3.14159 2)))
|
||||
"sin pi/2 = 1")
|
||||
(assert= 0 (round (sin 3.14159)) "sin pi = 0"))
|
||||
(deftest
|
||||
"cos"
|
||||
(assert= 1 (round (cos 0)) "cos 0 = 1")
|
||||
(assert=
|
||||
0
|
||||
(round (cos (/ 3.14159 2)))
|
||||
"cos pi/2 = 0")
|
||||
(assert= -1 (round (cos 3.14159)) "cos pi = -1"))
|
||||
(deftest
|
||||
"tan"
|
||||
(assert= 0 (round (tan 0)) "tan 0 = 0")
|
||||
(assert= 1 (round (tan 0.785398)) "tan pi/4 = 1"))
|
||||
(deftest
|
||||
"asin"
|
||||
(assert= 0 (round (asin 0)) "asin 0 = 0")
|
||||
(let
|
||||
(r (asin 1))
|
||||
(assert= true (and (> r 1.5) (< r 1.6)) "asin 1 ≈ pi/2")))
|
||||
(deftest
|
||||
"acos"
|
||||
(assert= 0 (round (acos 1)) "acos 1 = 0")
|
||||
(let
|
||||
(r (acos 0))
|
||||
(assert= true (and (> r 1.5) (< r 1.6)) "acos 0 ≈ pi/2")))
|
||||
(deftest
|
||||
"atan"
|
||||
(assert= 0 (round (atan 0)) "atan 0 = 0")
|
||||
(let
|
||||
(r (atan 1))
|
||||
(assert= true (and (> r 0.78) (< r 0.8)) "atan 1 ≈ pi/4"))
|
||||
(let
|
||||
(r (atan 1 1))
|
||||
(assert=
|
||||
true
|
||||
(and (> r 0.78) (< r 0.8))
|
||||
"atan 1 1 = atan2(1,1) ≈ pi/4"))
|
||||
(let
|
||||
(r (atan 1 0))
|
||||
(assert= true (and (> r 1.5) (< r 1.6)) "atan 1 0 ≈ pi/2")))
|
||||
(deftest
|
||||
"exp"
|
||||
(assert= 1 (round (exp 0)) "exp 0 = 1")
|
||||
(let
|
||||
(r (exp 1))
|
||||
(assert= true (and (> r 2.71) (< r 2.72)) "exp 1 ≈ e")))
|
||||
(deftest
|
||||
"log"
|
||||
(assert= 0 (round (log 1)) "log 1 = 0")
|
||||
(let
|
||||
(r (log 2.71828))
|
||||
(assert= true (and (> r 0.99) (< r 1.01)) "log e ≈ 1"))))
|
||||
(deftest
|
||||
"expt"
|
||||
(assert= 8 (expt 2 3) "2^3 = 8")
|
||||
(assert= 1 (expt 5 0) "5^0 = 1")
|
||||
(assert= 1000 (expt 10 3) "10^3 = 1000")
|
||||
(let
|
||||
(r (expt 2 0.5))
|
||||
(assert= true (and (> r 1.41) (< r 1.43)) "2^0.5 ≈ sqrt(2)")))
|
||||
(deftest
|
||||
"quotient"
|
||||
(assert= 3 (quotient 13 4) "13/4 = 3")
|
||||
(assert=
|
||||
-3
|
||||
(quotient -13 4)
|
||||
"-13/4 = -3 (truncate toward zero)")
|
||||
(assert=
|
||||
-3
|
||||
(quotient 13 -4)
|
||||
"13/-4 = -3 (truncate toward zero)")
|
||||
(assert= 3 (quotient -13 -4) "-13/-4 = 3")
|
||||
(assert= 0 (quotient 0 5) "0/5 = 0"))
|
||||
(deftest
|
||||
"gcd"
|
||||
(assert= 6 (gcd 12 18) "gcd 12 18 = 6")
|
||||
(assert= 1 (gcd 7 13) "gcd 7 13 = 1 (coprime)")
|
||||
(assert= 4 (gcd 8 12) "gcd 8 12 = 4")
|
||||
(assert= 5 (gcd 0 5) "gcd 0 5 = 5")
|
||||
(assert= 6 (gcd -12 18) "gcd handles negatives"))
|
||||
(deftest
|
||||
"lcm"
|
||||
(assert= 12 (lcm 4 6) "lcm 4 6 = 12")
|
||||
(assert= 36 (lcm 12 18) "lcm 12 18 = 36")
|
||||
(assert= 0 (lcm 0 5) "lcm 0 5 = 0")
|
||||
(assert= 15 (lcm 3 5) "lcm 3 5 = 15"))
|
||||
(deftest
|
||||
"number->string"
|
||||
(assert= "42" (number->string 42) "integer to string")
|
||||
(assert= "0" (number->string 0) "zero to string")
|
||||
(assert= "-7" (number->string -7) "negative to string")
|
||||
(assert= "ff" (number->string 255 16) "255 in hex")
|
||||
(assert= "1111" (number->string 15 2) "15 in binary")
|
||||
(assert= "377" (number->string 255 8) "255 in octal")
|
||||
(assert= "z" (number->string 35 36) "35 in base 36"))
|
||||
(deftest
|
||||
"string->number"
|
||||
(assert= 42 (string->number "42") "string to integer")
|
||||
(assert= -7 (string->number "-7") "negative string to integer")
|
||||
(assert= 255 (string->number "ff" 16) "hex string")
|
||||
(assert= 15 (string->number "1111" 2) "binary string")
|
||||
(assert= 255 (string->number "377" 8) "octal string")
|
||||
(assert= nil (string->number "not-a-number") "invalid returns nil")
|
||||
(assert= nil (string->number "fg" 16) "invalid hex returns nil"))
|
||||
(deftest
|
||||
"numeric tower integration"
|
||||
(assert=
|
||||
true
|
||||
(< (abs (- (sin (asin 0.5)) 0.5)) 0.0001)
|
||||
"sin(asin(x)) = x")
|
||||
(assert=
|
||||
true
|
||||
(< (abs (- (cos (acos 0.5)) 0.5)) 0.0001)
|
||||
"cos(acos(x)) = x")
|
||||
(assert= true (< (abs (- (exp (log 2)) 2)) 0.0001) "exp(log(x)) = x")
|
||||
(assert=
|
||||
(* 12 18)
|
||||
(* (gcd 12 18) (lcm 12 18))
|
||||
"gcd * lcm = a * b")))
|
||||
230
spec/tests/test-numeric-tower.sx
Normal file
230
spec/tests/test-numeric-tower.sx
Normal file
@@ -0,0 +1,230 @@
|
||||
;; ==========================================================================
|
||||
;; test-numeric-tower.sx — Numeric tower: Integer vs Float distinction
|
||||
;;
|
||||
;; Tests for float contagion, integer arithmetic, predicates,
|
||||
;; coercions, parsing, and rendering.
|
||||
;;
|
||||
;; Note: Use fractional floats (1.5, 3.14) or exact->inexact for round floats,
|
||||
;; since the SX serializer renders Number 1.0 as "1" (int form).
|
||||
;; ==========================================================================
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Integer arithmetic — result stays Integer when all args are Integer
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"numeric-tower:int-arithmetic"
|
||||
(deftest "int + int = int" (assert (integer? (+ 1 2))))
|
||||
(deftest "int + int value" (assert= (+ 1 2) 3))
|
||||
(deftest "int - int = int" (assert (integer? (- 10 3))))
|
||||
(deftest "int - int value" (assert= (- 10 3) 7))
|
||||
(deftest "int * int = int" (assert (integer? (* 4 5))))
|
||||
(deftest "int * int value" (assert= (* 4 5) 20))
|
||||
(deftest "zero identity" (assert= (+ 0 0) 0))
|
||||
(deftest "negative int" (assert= (- 0 5) -5))
|
||||
(deftest
|
||||
"int negation is int"
|
||||
(assert (integer? (- 0 7))))
|
||||
(deftest
|
||||
"large int product"
|
||||
(assert= (* 100 100) 10000)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Float contagion — any float arg promotes result to float
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"numeric-tower:float-contagion"
|
||||
(deftest "int + float = float" (assert (float? (+ 1 1.5))))
|
||||
(deftest "int + float value" (assert= (+ 1 1.5) 2.5))
|
||||
(deftest "float + int = float" (assert (float? (+ 1.5 2))))
|
||||
(deftest "float + float = float" (assert (float? (+ 1.5 2.5))))
|
||||
(deftest "int * float = float" (assert (float? (* 2 1.5))))
|
||||
(deftest "int * float value" (assert= (* 2 1.5) 3))
|
||||
(deftest "int - float = float" (assert (float? (- 5 2.5))))
|
||||
(deftest "float - int = float" (assert (float? (- 5.5 2))))
|
||||
(deftest
|
||||
"three args with float"
|
||||
(assert (float? (+ 1 2 3.5))))
|
||||
(deftest
|
||||
"exact->inexact promotes to float"
|
||||
(assert (float? (exact->inexact 5)))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Division
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"numeric-tower:division"
|
||||
(deftest
|
||||
"exact division value"
|
||||
(assert= (/ 6 2) 3))
|
||||
(deftest "inexact division value" (assert= (/ 1 4) 0.25))
|
||||
(deftest "float / float = float" (assert (float? (/ 3.5 2.5))))
|
||||
(deftest
|
||||
"rational / int = rational"
|
||||
(assert (rational? (/ 1/2 2))))
|
||||
(deftest "rational division value" (assert= (/ 1/2 2) 1/4)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Type predicates
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"numeric-tower:predicates"
|
||||
(deftest "integer? on int" (assert (integer? 42)))
|
||||
(deftest "integer? on negative" (assert (integer? -7)))
|
||||
(deftest "integer? on zero" (assert (integer? 0)))
|
||||
(deftest
|
||||
"integer? on float-int"
|
||||
(assert (integer? (exact->inexact 2))))
|
||||
(deftest "integer? on fractional float" (assert (not (integer? 1.5))))
|
||||
(deftest "float? on 1.5" (assert (float? 1.5)))
|
||||
(deftest
|
||||
"float? on exact->inexact"
|
||||
(assert (float? (exact->inexact 2))))
|
||||
(deftest "float? on int" (assert (not (float? 42))))
|
||||
(deftest "number? on int" (assert (number? 42)))
|
||||
(deftest "number? on float" (assert (number? 3.14)))
|
||||
(deftest "number? on rational" (assert (number? 1/3)))
|
||||
(deftest "number? on string" (assert (not (number? "42"))))
|
||||
(deftest "exact? on int" (assert (exact? 1)))
|
||||
(deftest "exact? on rational" (assert (exact? 1/3)))
|
||||
(deftest
|
||||
"exact? on exact->inexact"
|
||||
(assert (not (exact? (exact->inexact 1)))))
|
||||
(deftest "inexact? on 1.5" (assert (inexact? 1.5)))
|
||||
(deftest "inexact? on int" (assert (not (inexact? 3)))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Coercions
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"numeric-tower:coercions"
|
||||
(deftest
|
||||
"exact->inexact int"
|
||||
(assert= (exact->inexact 3) 3))
|
||||
(deftest
|
||||
"exact->inexact produces float"
|
||||
(assert (float? (exact->inexact 5))))
|
||||
(deftest
|
||||
"exact->inexact float passthrough"
|
||||
(assert= (exact->inexact 1.5) 1.5))
|
||||
(deftest "exact->inexact rational" (assert= (exact->inexact 1/4) 0.25))
|
||||
(deftest "inexact->exact 1.5" (assert= (inexact->exact 1.5) 2))
|
||||
(deftest
|
||||
"inexact->exact produces int"
|
||||
(assert (integer? (inexact->exact (exact->inexact 4)))))
|
||||
(deftest "inexact->exact 2.7" (assert= (inexact->exact 2.7) 3))
|
||||
(deftest
|
||||
"inexact->exact int passthrough"
|
||||
(assert= (inexact->exact 5) 5)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; floor / ceiling / truncate / round — return Integer for floats
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"numeric-tower:rounding"
|
||||
(deftest "floor 3.7" (assert= (floor 3.7) 3))
|
||||
(deftest "floor produces int" (assert (integer? (floor 3.7))))
|
||||
(deftest "floor negative" (assert= (floor -2.3) -3))
|
||||
(deftest "truncate 3.9" (assert= (truncate 3.9) 3))
|
||||
(deftest "truncate negative" (assert= (truncate -3.9) -3))
|
||||
(deftest "truncate produces int" (assert (integer? (truncate 3.9))))
|
||||
(deftest "round 2.3 down" (assert= (round 2.3) 2))
|
||||
(deftest "round produces int" (assert (integer? (round 2.3))))
|
||||
(deftest
|
||||
"floor of int passthrough"
|
||||
(assert= (floor 5) 5))
|
||||
(deftest "floor of int stays int" (assert (integer? (floor 5)))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; parse-number distinguishes int vs float strings
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"numeric-tower:parse-number"
|
||||
(deftest
|
||||
"parse-number int string"
|
||||
(assert= (parse-number "42") 42))
|
||||
(deftest
|
||||
"parse-number int is integer?"
|
||||
(assert (integer? (parse-number "42"))))
|
||||
(deftest "parse-number 3.14" (assert= (parse-number "3.14") 3.14))
|
||||
(deftest
|
||||
"parse-number float is float?"
|
||||
(assert (float? (parse-number "3.14"))))
|
||||
(deftest
|
||||
"parse-number 1.5 is float?"
|
||||
(assert (float? (parse-number "1.5"))))
|
||||
(deftest
|
||||
"parse-number negative int"
|
||||
(assert= (parse-number "-5") -5))
|
||||
(deftest
|
||||
"parse-number negative int is integer?"
|
||||
(assert (integer? (parse-number "-5"))))
|
||||
(deftest "parse-int returns integer" (assert (integer? (parse-int "7"))))
|
||||
(deftest "parse-int value" (assert= (parse-int "7") 7)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Equality across numeric types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"numeric-tower:equality"
|
||||
(deftest "int = same int" (assert= 5 5))
|
||||
(deftest
|
||||
"int = float eq"
|
||||
(assert (= 1 (exact->inexact 1))))
|
||||
(deftest
|
||||
"float = int eq"
|
||||
(assert (= (exact->inexact 1) 1)))
|
||||
(deftest "int != different int" (assert (!= 1 2)))
|
||||
(deftest "int < float" (assert (< 1 1.5)))
|
||||
(deftest "float > int" (assert (> 2.5 2)))
|
||||
(deftest "int <= float" (assert (<= 2 2.5)))
|
||||
(deftest "int >= int" (assert (>= 3 3))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; mod / remainder / modulo with integers
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"numeric-tower:modulo"
|
||||
(deftest
|
||||
"mod int int = int"
|
||||
(assert (integer? (mod 10 3))))
|
||||
(deftest "mod value" (assert= (mod 10 3) 1))
|
||||
(deftest
|
||||
"remainder int int = int"
|
||||
(assert (integer? (remainder 10 3))))
|
||||
(deftest
|
||||
"remainder value"
|
||||
(assert= (remainder 10 3) 1)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; min / max with mixed types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"numeric-tower:min-max"
|
||||
(deftest "min two ints" (assert= (min 3 7) 3))
|
||||
(deftest
|
||||
"min int result type"
|
||||
(assert (integer? (min 3 7))))
|
||||
(deftest "max two ints" (assert= (max 3 7) 7))
|
||||
(deftest "min with float" (assert= (min 3 2.5) 2.5))
|
||||
(deftest "max with float" (assert= (max 3 3.5) 3.5)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; str rendering of int vs float
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"numeric-tower:stringify"
|
||||
(deftest "str of int" (assert= (str 42) "42"))
|
||||
(deftest "str of negative int" (assert= (str -5) "-5"))
|
||||
(deftest "str of 3.14" (assert= (str 3.14) "3.14"))
|
||||
(deftest "str of 1.5" (assert= (str 1.5) "1.5")))
|
||||
232
spec/tests/test-ports.sx
Normal file
232
spec/tests/test-ports.sx
Normal file
@@ -0,0 +1,232 @@
|
||||
;; Phase 14 — String ports + eof-object
|
||||
|
||||
(deftest
|
||||
"eof-object"
|
||||
(deftest
|
||||
"eof-object is eof"
|
||||
(assert=
|
||||
true
|
||||
(eof-object? (eof-object))
|
||||
"eof-object? returns true for eof-object"))
|
||||
(deftest
|
||||
"non-eof values are not eof"
|
||||
(assert= false (eof-object? nil) "nil is not eof")
|
||||
(assert= false (eof-object? "") "string is not eof")
|
||||
(assert= false (eof-object? 0) "zero is not eof")
|
||||
(assert= false (eof-object? false) "false is not eof"))
|
||||
(deftest
|
||||
"type-of eof-object"
|
||||
(assert=
|
||||
"eof-object"
|
||||
(type-of (eof-object))
|
||||
"type-of eof-object is eof-object")))
|
||||
|
||||
(deftest
|
||||
"open-input-string"
|
||||
(deftest
|
||||
"creates input port"
|
||||
(let
|
||||
(p (open-input-string "hello"))
|
||||
(assert= true (port? p) "is a port")
|
||||
(assert= true (input-port? p) "is an input port")
|
||||
(assert= false (output-port? p) "is not an output port")))
|
||||
(deftest
|
||||
"type-of input port"
|
||||
(let
|
||||
(p (open-input-string "x"))
|
||||
(assert= "input-port" (type-of p) "type-of is input-port"))))
|
||||
|
||||
(deftest
|
||||
"open-output-string"
|
||||
(deftest
|
||||
"creates output port"
|
||||
(let
|
||||
(p (open-output-string))
|
||||
(assert= true (port? p) "is a port")
|
||||
(assert= true (output-port? p) "is an output port")
|
||||
(assert= false (input-port? p) "is not an input port")))
|
||||
(deftest
|
||||
"type-of output port"
|
||||
(let
|
||||
(p (open-output-string))
|
||||
(assert= "output-port" (type-of p) "type-of is output-port"))))
|
||||
|
||||
(deftest
|
||||
"read-char"
|
||||
(deftest
|
||||
"reads chars sequentially"
|
||||
(let
|
||||
(p (open-input-string "ab"))
|
||||
(let
|
||||
(c1 (read-char p))
|
||||
(assert= true (char? c1) "first result is char")
|
||||
(assert= 97 (char->integer c1) "first char is a"))))
|
||||
(deftest
|
||||
"reads second char"
|
||||
(let
|
||||
(p (open-input-string "ab"))
|
||||
(read-char p)
|
||||
(let
|
||||
(c2 (read-char p))
|
||||
(assert= true (char? c2) "second result is char")
|
||||
(assert= 98 (char->integer c2) "second char is b"))))
|
||||
(deftest
|
||||
"returns eof at end"
|
||||
(let
|
||||
(p (open-input-string "x"))
|
||||
(read-char p)
|
||||
(assert= true (eof-object? (read-char p)) "eof after last char")))
|
||||
(deftest
|
||||
"empty string yields eof immediately"
|
||||
(let
|
||||
(p (open-input-string ""))
|
||||
(assert= true (eof-object? (read-char p)) "eof from empty string"))))
|
||||
|
||||
(deftest
|
||||
"peek-char"
|
||||
(deftest
|
||||
"peeks without consuming"
|
||||
(let
|
||||
(p (open-input-string "x"))
|
||||
(let
|
||||
(c1 (peek-char p))
|
||||
(let
|
||||
(c2 (peek-char p))
|
||||
(assert=
|
||||
(char->integer c1)
|
||||
(char->integer c2)
|
||||
"peek twice gives same char")))))
|
||||
(deftest
|
||||
"peek then read"
|
||||
(let
|
||||
(p (open-input-string "z"))
|
||||
(let
|
||||
(peeked (peek-char p))
|
||||
(let
|
||||
(read (read-char p))
|
||||
(assert=
|
||||
(char->integer peeked)
|
||||
(char->integer read)
|
||||
"peek and read agree")))))
|
||||
(deftest
|
||||
"peek at end returns eof"
|
||||
(let
|
||||
(p (open-input-string ""))
|
||||
(assert= true (eof-object? (peek-char p)) "eof on empty peek"))))
|
||||
|
||||
(deftest
|
||||
"read-line"
|
||||
(deftest
|
||||
"reads a single line"
|
||||
(let
|
||||
(p (open-input-string "hello"))
|
||||
(assert= "hello" (read-line p) "reads whole string as line")))
|
||||
(deftest
|
||||
"reads line up to newline"
|
||||
(let
|
||||
(p (open-input-string "foo\nbar"))
|
||||
(assert= "foo" (read-line p) "first line is foo")))
|
||||
(deftest
|
||||
"reads second line"
|
||||
(let
|
||||
(p (open-input-string "foo\nbar"))
|
||||
(read-line p)
|
||||
(assert= "bar" (read-line p) "second line is bar")))
|
||||
(deftest
|
||||
"returns eof on empty port"
|
||||
(let
|
||||
(p (open-input-string ""))
|
||||
(assert= true (eof-object? (read-line p)) "eof on empty")))
|
||||
(deftest
|
||||
"returns eof after last line"
|
||||
(let
|
||||
(p (open-input-string "hi"))
|
||||
(read-line p)
|
||||
(assert= true (eof-object? (read-line p)) "eof after reading"))))
|
||||
|
||||
(deftest
|
||||
"write-char and get-output-string"
|
||||
(deftest
|
||||
"write single char"
|
||||
(let
|
||||
(p (open-output-string))
|
||||
(write-char (make-char 65) p)
|
||||
(assert= "A" (get-output-string p) "write char A")))
|
||||
(deftest
|
||||
"write multiple chars"
|
||||
(let
|
||||
(p (open-output-string))
|
||||
(write-char (make-char 72) p)
|
||||
(write-char (make-char 105) p)
|
||||
(assert= "Hi" (get-output-string p) "write Hi"))))
|
||||
|
||||
(deftest
|
||||
"write-string"
|
||||
(deftest
|
||||
"write a string to port"
|
||||
(let
|
||||
(p (open-output-string))
|
||||
(write-string "hello" p)
|
||||
(assert= "hello" (get-output-string p) "write-string result")))
|
||||
(deftest
|
||||
"multiple writes concatenate"
|
||||
(let
|
||||
(p (open-output-string))
|
||||
(write-string "foo" p)
|
||||
(write-string "bar" p)
|
||||
(assert= "foobar" (get-output-string p) "concatenated writes"))))
|
||||
|
||||
(deftest
|
||||
"get-output-string idempotent"
|
||||
(let
|
||||
(p (open-output-string))
|
||||
(write-string "test" p)
|
||||
(assert= "test" (get-output-string p) "first call")
|
||||
(assert= "test" (get-output-string p) "second call same result")))
|
||||
|
||||
(deftest
|
||||
"char-ready?"
|
||||
(deftest
|
||||
"ready when chars available"
|
||||
(let
|
||||
(p (open-input-string "x"))
|
||||
(assert= true (char-ready? p) "ready with content")))
|
||||
(deftest
|
||||
"not ready when empty"
|
||||
(let
|
||||
(p (open-input-string ""))
|
||||
(assert= false (char-ready? p) "not ready when empty"))))
|
||||
|
||||
(deftest
|
||||
"close-port"
|
||||
(deftest
|
||||
"close input port"
|
||||
(let
|
||||
(p (open-input-string "hello"))
|
||||
(close-port p)
|
||||
(assert= true (eof-object? (read-char p)) "read after close gives eof")))
|
||||
(deftest
|
||||
"close output port"
|
||||
(let
|
||||
(p (open-output-string))
|
||||
(write-string "ok" p)
|
||||
(close-port p)
|
||||
(assert= "ok" (get-output-string p) "output preserved after close"))))
|
||||
|
||||
(deftest
|
||||
"roundtrip string via ports"
|
||||
(let
|
||||
(in (open-input-string "abc"))
|
||||
(let
|
||||
(out (open-output-string))
|
||||
(do
|
||||
(let
|
||||
(c1 (read-char in))
|
||||
(when (not (eof-object? c1)) (write-char c1 out)))
|
||||
(let
|
||||
(c2 (read-char in))
|
||||
(when (not (eof-object? c2)) (write-char c2 out)))
|
||||
(let
|
||||
(c3 (read-char in))
|
||||
(when (not (eof-object? c3)) (write-char c3 out)))
|
||||
(assert= "abc" (get-output-string out) "roundtrip via ports")))))
|
||||
@@ -6,20 +6,36 @@
|
||||
;; Arithmetic
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "arithmetic"
|
||||
(defsuite
|
||||
"arithmetic"
|
||||
(deftest "add" (assert-equal 3 (+ 1 2)))
|
||||
(deftest "add multiple" (assert-equal 10 (+ 1 2 3 4)))
|
||||
(deftest
|
||||
"add multiple"
|
||||
(assert-equal 10 (+ 1 2 3 4)))
|
||||
(deftest "add zero" (assert-equal 5 (+ 5 0)))
|
||||
(deftest "add negative" (assert-equal -1 (+ 1 -2)))
|
||||
(deftest
|
||||
"add negative"
|
||||
(assert-equal -1 (+ 1 -2)))
|
||||
(deftest "subtract" (assert-equal 3 (- 5 2)))
|
||||
(deftest "subtract negative" (assert-equal 7 (- 5 -2)))
|
||||
(deftest
|
||||
"subtract negative"
|
||||
(assert-equal 7 (- 5 -2)))
|
||||
(deftest "multiply" (assert-equal 12 (* 3 4)))
|
||||
(deftest "multiply zero" (assert-equal 0 (* 5 0)))
|
||||
(deftest "multiply negative" (assert-equal -6 (* 2 -3)))
|
||||
(deftest
|
||||
"multiply zero"
|
||||
(assert-equal 0 (* 5 0)))
|
||||
(deftest
|
||||
"multiply negative"
|
||||
(assert-equal -6 (* 2 -3)))
|
||||
(deftest "divide" (assert-equal 3 (/ 9 3)))
|
||||
(deftest "divide float" (assert-equal 2.5 (/ 5 2)))
|
||||
(deftest "mod" (assert-equal 1 (mod 7 3)))
|
||||
(deftest "mod negative" (assert-true (or (= (mod -1 3) 2) (= (mod -1 3) -1))))
|
||||
(deftest
|
||||
"mod negative"
|
||||
(assert-true
|
||||
(or
|
||||
(= (mod -1 3) 2)
|
||||
(= (mod -1 3) -1))))
|
||||
(deftest "inc" (assert-equal 6 (inc 5)))
|
||||
(deftest "dec" (assert-equal 4 (dec 5)))
|
||||
(deftest "abs positive" (assert-equal 5 (abs 5)))
|
||||
@@ -32,7 +48,8 @@
|
||||
;; Comparison
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "comparison"
|
||||
(defsuite
|
||||
"comparison"
|
||||
(deftest "equal numbers" (assert-true (= 1 1)))
|
||||
(deftest "not equal numbers" (assert-false (= 1 2)))
|
||||
(deftest "equal strings" (assert-true (= "a" "a")))
|
||||
@@ -52,7 +69,8 @@
|
||||
;; Predicates
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "predicates"
|
||||
(defsuite
|
||||
"predicates"
|
||||
(deftest "nil? nil" (assert-true (nil? nil)))
|
||||
(deftest "nil? number" (assert-false (nil? 0)))
|
||||
(deftest "nil? string" (assert-false (nil? "")))
|
||||
@@ -76,15 +94,22 @@
|
||||
;; String operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "strings"
|
||||
(deftest "str concat" (assert-equal "hello world" (str "hello" " " "world")))
|
||||
(defsuite
|
||||
"strings"
|
||||
(deftest
|
||||
"str concat"
|
||||
(assert-equal "hello world" (str "hello" " " "world")))
|
||||
(deftest "str number" (assert-equal "42" (str 42)))
|
||||
(deftest "str empty" (assert-equal "" (str)))
|
||||
(deftest "len string" (assert-equal 5 (len "hello")))
|
||||
(deftest "len empty" (assert-equal 0 (len "")))
|
||||
(deftest "slice" (assert-equal "ell" (slice "hello" 1 4)))
|
||||
(deftest
|
||||
"slice"
|
||||
(assert-equal "ell" (slice "hello" 1 4)))
|
||||
(deftest "slice from" (assert-equal "llo" (slice "hello" 2)))
|
||||
(deftest "slice empty" (assert-equal "" (slice "hello" 2 2)))
|
||||
(deftest
|
||||
"slice empty"
|
||||
(assert-equal "" (slice "hello" 2 2)))
|
||||
(deftest "join" (assert-equal "a,b,c" (join "," (list "a" "b" "c"))))
|
||||
(deftest "join empty" (assert-equal "" (join "," (list))))
|
||||
(deftest "join single" (assert-equal "a" (join "," (list "a"))))
|
||||
@@ -101,88 +126,238 @@
|
||||
(deftest "replace" (assert-equal "hXllo" (replace "hello" "e" "X")))
|
||||
(deftest "string-length" (assert-equal 5 (string-length "hello")))
|
||||
(deftest "index-of found" (assert-equal 2 (index-of "hello" "l")))
|
||||
(deftest "index-of not found" (assert-equal -1 (index-of "hello" "z"))))
|
||||
(deftest
|
||||
"index-of not found"
|
||||
(assert-equal -1 (index-of "hello" "z"))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; List operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "lists"
|
||||
(deftest "list create" (assert-equal (list 1 2 3) (list 1 2 3)))
|
||||
(deftest "first" (assert-equal 1 (first (list 1 2 3))))
|
||||
(defsuite
|
||||
"lists"
|
||||
(deftest
|
||||
"list create"
|
||||
(assert-equal
|
||||
(list 1 2 3)
|
||||
(list 1 2 3)))
|
||||
(deftest
|
||||
"first"
|
||||
(assert-equal 1 (first (list 1 2 3))))
|
||||
(deftest "first empty" (assert-nil (first (list))))
|
||||
(deftest "rest" (assert-equal (list 2 3) (rest (list 1 2 3))))
|
||||
(deftest
|
||||
"rest"
|
||||
(assert-equal
|
||||
(list 2 3)
|
||||
(rest (list 1 2 3))))
|
||||
(deftest "rest single" (assert-equal (list) (rest (list 1))))
|
||||
(deftest "rest empty" (assert-equal (list) (rest (list))))
|
||||
(deftest "nth" (assert-equal 2 (nth (list 1 2 3) 1)))
|
||||
(deftest "nth out of bounds" (assert-nil (nth (list 1 2) 5)))
|
||||
(deftest "last" (assert-equal 3 (last (list 1 2 3))))
|
||||
(deftest
|
||||
"nth"
|
||||
(assert-equal
|
||||
2
|
||||
(nth (list 1 2 3) 1)))
|
||||
(deftest
|
||||
"nth out of bounds"
|
||||
(assert-nil (nth (list 1 2) 5)))
|
||||
(deftest
|
||||
"last"
|
||||
(assert-equal 3 (last (list 1 2 3))))
|
||||
(deftest "last single" (assert-equal 1 (last (list 1))))
|
||||
(deftest "len list" (assert-equal 3 (len (list 1 2 3))))
|
||||
(deftest
|
||||
"len list"
|
||||
(assert-equal 3 (len (list 1 2 3))))
|
||||
(deftest "len empty" (assert-equal 0 (len (list))))
|
||||
(deftest "cons" (assert-equal (list 0 1 2) (cons 0 (list 1 2))))
|
||||
(deftest "append" (assert-equal (list 1 2 3 4) (append (list 1 2) (list 3 4))))
|
||||
(deftest "append element" (assert-equal (list 1 2 3) (append (list 1 2) (list 3))))
|
||||
(deftest "slice list" (assert-equal (list 2 3) (slice (list 1 2 3 4) 1 3)))
|
||||
(deftest "concat" (assert-equal (list 1 2 3 4) (concat (list 1 2) (list 3 4))))
|
||||
(deftest "reverse" (assert-equal (list 3 2 1) (reverse (list 1 2 3))))
|
||||
(deftest
|
||||
"cons"
|
||||
(assert-equal
|
||||
(list 0 1 2)
|
||||
(cons 0 (list 1 2))))
|
||||
(deftest
|
||||
"append"
|
||||
(assert-equal
|
||||
(list 1 2 3 4)
|
||||
(append (list 1 2) (list 3 4))))
|
||||
(deftest
|
||||
"append element"
|
||||
(assert-equal
|
||||
(list 1 2 3)
|
||||
(append (list 1 2) (list 3))))
|
||||
(deftest
|
||||
"slice list"
|
||||
(assert-equal
|
||||
(list 2 3)
|
||||
(slice
|
||||
(list 1 2 3 4)
|
||||
1
|
||||
3)))
|
||||
(deftest
|
||||
"concat"
|
||||
(assert-equal
|
||||
(list 1 2 3 4)
|
||||
(concat (list 1 2) (list 3 4))))
|
||||
(deftest
|
||||
"reverse"
|
||||
(assert-equal
|
||||
(list 3 2 1)
|
||||
(reverse (list 1 2 3))))
|
||||
(deftest "reverse empty" (assert-equal (list) (reverse (list))))
|
||||
(deftest "contains? list" (assert-true (contains? (list 1 2 3) 2)))
|
||||
(deftest "contains? list false" (assert-false (contains? (list 1 2 3) 5)))
|
||||
(deftest "range" (assert-equal (list 0 1 2) (range 0 3)))
|
||||
(deftest "range step" (assert-equal (list 0 2 4) (range 0 6 2)))
|
||||
(deftest "flatten" (assert-equal (list 1 2 3 4) (flatten (list (list 1 2) (list 3 4))))))
|
||||
(deftest
|
||||
"contains? list"
|
||||
(assert-true
|
||||
(contains? (list 1 2 3) 2)))
|
||||
(deftest
|
||||
"contains? list false"
|
||||
(assert-false
|
||||
(contains? (list 1 2 3) 5)))
|
||||
(deftest
|
||||
"range"
|
||||
(assert-equal
|
||||
(list 0 1 2)
|
||||
(range 0 3)))
|
||||
(deftest
|
||||
"range step"
|
||||
(assert-equal
|
||||
(list 0 2 4)
|
||||
(range 0 6 2)))
|
||||
(deftest
|
||||
"flatten"
|
||||
(assert-equal
|
||||
(list 1 2 3 4)
|
||||
(flatten
|
||||
(list (list 1 2) (list 3 4))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Dict operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "dicts"
|
||||
(deftest "dict create" (assert-equal 1 (get (dict "a" 1 "b" 2) "a")))
|
||||
(defsuite
|
||||
"dicts"
|
||||
(deftest
|
||||
"dict create"
|
||||
(assert-equal 1 (get (dict "a" 1 "b" 2) "a")))
|
||||
(deftest "get missing" (assert-nil (get (dict "a" 1) "z")))
|
||||
(deftest "get default" (assert-equal 99 (get (dict "a" 1) "z" 99)))
|
||||
(deftest "keys" (assert-true (contains? (keys (dict "a" 1 "b" 2)) "a")))
|
||||
(deftest
|
||||
"get default"
|
||||
(assert-equal 99 (get (dict "a" 1) "z" 99)))
|
||||
(deftest
|
||||
"keys"
|
||||
(assert-true
|
||||
(contains? (keys (dict "a" 1 "b" 2)) "a")))
|
||||
(deftest "has-key?" (assert-true (has-key? (dict "a" 1) "a")))
|
||||
(deftest "has-key? false" (assert-false (has-key? (dict "a" 1) "z")))
|
||||
(deftest "assoc" (assert-equal 2 (get (assoc (dict "a" 1) "b" 2) "b")))
|
||||
(deftest "dissoc" (assert-false (has-key? (dissoc (dict "a" 1 "b" 2) "a") "a")))
|
||||
(deftest "len dict" (assert-equal 2 (len (dict "a" 1 "b" 2))))
|
||||
(deftest
|
||||
"has-key? false"
|
||||
(assert-false (has-key? (dict "a" 1) "z")))
|
||||
(deftest
|
||||
"assoc"
|
||||
(assert-equal
|
||||
2
|
||||
(get (assoc (dict "a" 1) "b" 2) "b")))
|
||||
(deftest
|
||||
"dissoc"
|
||||
(assert-false
|
||||
(has-key? (dissoc (dict "a" 1 "b" 2) "a") "a")))
|
||||
(deftest
|
||||
"len dict"
|
||||
(assert-equal 2 (len (dict "a" 1 "b" 2))))
|
||||
(deftest "len empty dict" (assert-equal 0 (len (dict))))
|
||||
(deftest "empty? dict" (assert-true (empty? (dict))))
|
||||
(deftest "empty? nonempty dict" (assert-false (empty? (dict "a" 1)))))
|
||||
(deftest
|
||||
"empty? nonempty dict"
|
||||
(assert-false (empty? (dict "a" 1)))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Higher-order functions
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "higher-order"
|
||||
(deftest "map" (assert-equal (list 2 4 6) (map (fn (x) (* x 2)) (list 1 2 3))))
|
||||
(defsuite
|
||||
"higher-order"
|
||||
(deftest
|
||||
"map"
|
||||
(assert-equal
|
||||
(list 2 4 6)
|
||||
(map
|
||||
(fn (x) (* x 2))
|
||||
(list 1 2 3))))
|
||||
(deftest "map empty" (assert-equal (list) (map (fn (x) x) (list))))
|
||||
(deftest "filter" (assert-equal (list 2 4) (filter (fn (x) (= (mod x 2) 0)) (list 1 2 3 4 5))))
|
||||
(deftest "filter none" (assert-equal (list) (filter (fn (x) false) (list 1 2 3))))
|
||||
(deftest "reduce" (assert-equal 10 (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4))))
|
||||
(deftest "reduce empty" (assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list))))
|
||||
(deftest "some true" (assert-true (some (fn (x) (> x 3)) (list 1 2 3 4 5))))
|
||||
(deftest "some false" (assert-false (some (fn (x) (> x 10)) (list 1 2 3))))
|
||||
(deftest
|
||||
"filter"
|
||||
(assert-equal
|
||||
(list 2 4)
|
||||
(filter
|
||||
(fn (x) (= (mod x 2) 0))
|
||||
(list 1 2 3 4 5))))
|
||||
(deftest
|
||||
"filter none"
|
||||
(assert-equal
|
||||
(list)
|
||||
(filter (fn (x) false) (list 1 2 3))))
|
||||
(deftest
|
||||
"reduce"
|
||||
(assert-equal
|
||||
10
|
||||
(reduce
|
||||
(fn (acc x) (+ acc x))
|
||||
0
|
||||
(list 1 2 3 4))))
|
||||
(deftest
|
||||
"reduce empty"
|
||||
(assert-equal
|
||||
0
|
||||
(reduce (fn (acc x) (+ acc x)) 0 (list))))
|
||||
(deftest
|
||||
"some true"
|
||||
(assert-true
|
||||
(some
|
||||
(fn (x) (> x 3))
|
||||
(list 1 2 3 4 5))))
|
||||
(deftest
|
||||
"some false"
|
||||
(assert-false
|
||||
(some
|
||||
(fn (x) (> x 10))
|
||||
(list 1 2 3))))
|
||||
(deftest "some empty" (assert-false (some (fn (x) true) (list))))
|
||||
(deftest "every? true" (assert-true (every? (fn (x) (> x 0)) (list 1 2 3))))
|
||||
(deftest "every? false" (assert-false (every? (fn (x) (> x 2)) (list 1 2 3))))
|
||||
(deftest
|
||||
"every? true"
|
||||
(assert-true
|
||||
(every?
|
||||
(fn (x) (> x 0))
|
||||
(list 1 2 3))))
|
||||
(deftest
|
||||
"every? false"
|
||||
(assert-false
|
||||
(every?
|
||||
(fn (x) (> x 2))
|
||||
(list 1 2 3))))
|
||||
(deftest "every? empty" (assert-true (every? (fn (x) false) (list))))
|
||||
(deftest "for-each returns nil"
|
||||
(let ((log (list)))
|
||||
(for-each (fn (x) (append! log x)) (list 1 2 3))
|
||||
(deftest
|
||||
"for-each returns nil"
|
||||
(let
|
||||
((log (list)))
|
||||
(for-each
|
||||
(fn (x) (append! log x))
|
||||
(list 1 2 3))
|
||||
(assert-equal (list 1 2 3) log)))
|
||||
(deftest "map-indexed"
|
||||
(assert-equal (list (list 0 "a") (list 1 "b"))
|
||||
(deftest
|
||||
"map-indexed"
|
||||
(assert-equal
|
||||
(list (list 0 "a") (list 1 "b"))
|
||||
(map-indexed (fn (i x) (list i x)) (list "a" "b")))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Type coercion
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "type-coercion"
|
||||
(deftest "str bool" (assert-true (or (= (str true) "true") (= (str true) "True"))))
|
||||
(defsuite
|
||||
"type-coercion"
|
||||
(deftest
|
||||
"str bool"
|
||||
(assert-true (or (= (str true) "true") (= (str true) "True"))))
|
||||
(deftest "str nil" (assert-equal "" (str nil)))
|
||||
(deftest "str list" (assert-true (not (empty? (str (list 1 2 3))))))
|
||||
(deftest
|
||||
"str list"
|
||||
(assert-true
|
||||
(not (empty? (str (list 1 2 3))))))
|
||||
(deftest "parse-int" (assert-equal 42 (parse-int "42")))
|
||||
(deftest "parse-float skipped" (assert-true true)))
|
||||
|
||||
150
spec/tests/test-promises.sx
Normal file
150
spec/tests/test-promises.sx
Normal file
@@ -0,0 +1,150 @@
|
||||
(defsuite
|
||||
"promises"
|
||||
(deftest
|
||||
"delay creates a promise"
|
||||
(do (assert (promise? (delay 42)))))
|
||||
(deftest
|
||||
"delay does not evaluate immediately"
|
||||
(do
|
||||
(let
|
||||
((count 0))
|
||||
(let
|
||||
((p (delay (do (set! count (+ count 1)) count))))
|
||||
(assert= 0 count)))))
|
||||
(deftest
|
||||
"force evaluates the expression"
|
||||
(do (assert= 42 (force (delay 42)))))
|
||||
(deftest
|
||||
"force with arithmetic"
|
||||
(do (assert= 10 (force (delay (+ 3 7))))))
|
||||
(deftest
|
||||
"force memoises result"
|
||||
(do
|
||||
(let
|
||||
((count 0))
|
||||
(let
|
||||
((p (delay (do (set! count (+ count 1)) count))))
|
||||
(force p)
|
||||
(force p)
|
||||
(assert= 1 count)))))
|
||||
(deftest
|
||||
"force returns same value on repeated calls"
|
||||
(do
|
||||
(let
|
||||
((p (delay (+ 1 2))))
|
||||
(assert= 3 (force p))
|
||||
(assert= 3 (force p)))))
|
||||
(deftest
|
||||
"make-promise creates an already-forced promise"
|
||||
(do
|
||||
(let
|
||||
((p (make-promise 99)))
|
||||
(assert (promise? p))
|
||||
(assert= 99 (force p)))))
|
||||
(deftest
|
||||
"make-promise memoises without evaluating"
|
||||
(do
|
||||
(let
|
||||
((count 0))
|
||||
(let
|
||||
((p (make-promise 42)))
|
||||
(force p)
|
||||
(force p)
|
||||
(assert= 0 count)))))
|
||||
(deftest
|
||||
"promise? returns true for delay"
|
||||
(do (assert (promise? (delay 1)))))
|
||||
(deftest
|
||||
"promise? returns true for make-promise"
|
||||
(do (assert (promise? (make-promise 1)))))
|
||||
(deftest
|
||||
"promise? returns false for non-promise"
|
||||
(do
|
||||
(assert= false (promise? 42))
|
||||
(assert= false (promise? "hello"))
|
||||
(assert= false (promise? nil))
|
||||
(assert= false (promise? (list 1 2)))))
|
||||
(deftest
|
||||
"force non-promise returns value unchanged"
|
||||
(do
|
||||
(assert= 42 (force 42))
|
||||
(assert= "hi" (force "hi"))
|
||||
(assert= nil (force nil))))
|
||||
(deftest
|
||||
"delay captures environment"
|
||||
(do
|
||||
(let
|
||||
((x 10))
|
||||
(let
|
||||
((p (delay (+ x 5))))
|
||||
(assert= 15 (force p))))))
|
||||
(deftest
|
||||
"delay-force basic"
|
||||
(do (assert= 42 (force (delay-force (delay 42))))))
|
||||
(deftest
|
||||
"delay-force chains"
|
||||
(do
|
||||
(assert=
|
||||
5
|
||||
(force (delay-force (delay-force (delay 5)))))))
|
||||
(deftest
|
||||
"delay with string"
|
||||
(do (assert= "hello" (force (delay "hello")))))
|
||||
(deftest
|
||||
"delay with list"
|
||||
(do
|
||||
(assert-equal
|
||||
(list 1 2 3)
|
||||
(force (delay (list 1 2 3))))))
|
||||
(deftest
|
||||
"delay with function call"
|
||||
(do (assert= 6 (force (delay (* 2 3))))))
|
||||
(deftest
|
||||
"nested delay"
|
||||
(do
|
||||
(let
|
||||
((p (delay (delay 99))))
|
||||
(assert (promise? (force p))))))
|
||||
(deftest
|
||||
"force already forced promise"
|
||||
(do
|
||||
(let
|
||||
((p (make-promise 7)))
|
||||
(assert= 7 (force p))
|
||||
(assert= 7 (force p)))))
|
||||
(deftest
|
||||
"lazy stream first element"
|
||||
(do
|
||||
(define (stream-cons x s) (delay (list x s)))
|
||||
(define (stream-car s) (first (force s)))
|
||||
(define (stream-cdr s) (nth (force s) 1))
|
||||
(let
|
||||
((s (stream-cons 1 (stream-cons 2 (stream-cons 3 nil)))))
|
||||
(assert= 1 (stream-car s))
|
||||
(assert= 2 (stream-car (stream-cdr s))))))
|
||||
(deftest
|
||||
"delay-force is a promise"
|
||||
(do (assert (promise? (delay-force (delay 1))))))
|
||||
(deftest
|
||||
"force with side effects runs once"
|
||||
(do
|
||||
(let
|
||||
((log (list)))
|
||||
(let
|
||||
((p (delay (do (set! log (cons 42 log)) 42))))
|
||||
(force p)
|
||||
(force p)
|
||||
(assert= 1 (len log))))))
|
||||
(deftest
|
||||
"make-promise with nil"
|
||||
(do
|
||||
(let
|
||||
((p (make-promise nil)))
|
||||
(assert (promise? p))
|
||||
(assert= nil (force p)))))
|
||||
(deftest
|
||||
"delay in let binding"
|
||||
(do
|
||||
(let
|
||||
((p (delay (+ 10 20))))
|
||||
(assert= 30 (force p))))))
|
||||
135
spec/tests/test-rationals.sx
Normal file
135
spec/tests/test-rationals.sx
Normal file
@@ -0,0 +1,135 @@
|
||||
;; ==========================================================================
|
||||
;; test-rationals.sx — Rational number type: literals, arithmetic, tower
|
||||
;;
|
||||
;; Note: in the JS host, (/ int int) returns float (backward-compatible).
|
||||
;; Use rational literals (1/3, 3/4) or make-rational for exact rationals.
|
||||
;; ==========================================================================
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Literals and type
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"rationals:literals"
|
||||
(deftest "1/3 is rational" (assert (rational? 1/3)))
|
||||
(deftest "1/2 is rational" (assert (rational? 1/2)))
|
||||
(deftest "2/3 is rational" (assert (rational? 2/3)))
|
||||
(deftest "literal numerator 1/3" (assert= (numerator 1/3) 1))
|
||||
(deftest "literal denominator 1/3" (assert= (denominator 1/3) 3))
|
||||
(deftest "literal numerator 2/3" (assert= (numerator 2/3) 2))
|
||||
(deftest "auto-reduce 2/4 = 1/2" (assert= 2/4 1/2))
|
||||
(deftest "auto-reduce 6/9 = 2/3" (assert= 6/9 2/3))
|
||||
(deftest "negative literal" (assert= (numerator -1/3) -1)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Constructor and predicates
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"rationals:constructor"
|
||||
(deftest
|
||||
"make-rational basic"
|
||||
(assert (rational? (make-rational 1 3))))
|
||||
(deftest
|
||||
"make-rational reduces"
|
||||
(assert= (make-rational 2 4) 1/2))
|
||||
(deftest
|
||||
"make-rational exact int"
|
||||
(assert (integer? (make-rational 6 3))))
|
||||
(deftest
|
||||
"make-rational 6/3 = 2"
|
||||
(assert= (make-rational 6 3) 2))
|
||||
(deftest
|
||||
"make-rational negative"
|
||||
(assert= (numerator (make-rational -1 3)) -1))
|
||||
(deftest
|
||||
"make-rational neg denom"
|
||||
(assert= (numerator (make-rational 1 -3)) -1))
|
||||
(deftest "rational? on int" (assert (not (rational? 5))))
|
||||
(deftest "rational? on float" (assert (not (rational? 1.5))))
|
||||
(deftest "rational? on string" (assert (not (rational? "1/2"))))
|
||||
(deftest "number? on rational" (assert (number? 1/3)))
|
||||
(deftest "exact? on rational" (assert (exact? 1/3)))
|
||||
(deftest "inexact? on rational" (assert (not (inexact? 1/3))))
|
||||
(deftest "integer? on rational" (assert (not (integer? 1/3))))
|
||||
(deftest "dict? on rational" (assert (not (dict? 1/3)))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Accessors
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"rationals:accessors"
|
||||
(deftest "numerator 1/3" (assert= (numerator 1/3) 1))
|
||||
(deftest "denominator 1/3" (assert= (denominator 1/3) 3))
|
||||
(deftest "numerator 3/4" (assert= (numerator 3/4) 3))
|
||||
(deftest "denominator 3/4" (assert= (denominator 3/4) 4))
|
||||
(deftest "numerator of int" (assert= (numerator 5) 5))
|
||||
(deftest
|
||||
"denominator of int"
|
||||
(assert= (denominator 5) 1)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Arithmetic
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"rationals:arithmetic"
|
||||
(deftest "add two rationals" (assert= (+ 1/3 1/3) 2/3))
|
||||
(deftest "add to integer" (assert= (+ 1 1/2) 3/2))
|
||||
(deftest "add integer to rational" (assert= (+ 1/2 1) 3/2))
|
||||
(deftest "add reduces" (assert= (+ 1/6 1/6) 1/3))
|
||||
(deftest "add to whole number" (assert (integer? (+ 1/2 1/2))))
|
||||
(deftest "add whole = 1" (assert= (+ 1/2 1/2) 1))
|
||||
(deftest "subtract rationals" (assert= (- 3/4 1/4) 1/2))
|
||||
(deftest "subtract int from rational" (assert= (- 3/2 1) 1/2))
|
||||
(deftest "negate rational" (assert= (- 1/3) -1/3))
|
||||
(deftest "multiply rationals" (assert= (* 2/3 3/4) 1/2))
|
||||
(deftest "multiply int and rational" (assert= (* 2 1/3) 2/3))
|
||||
(deftest "multiply reduces to int" (assert (integer? (* 3 1/3))))
|
||||
(deftest "divide rational by int" (assert= (/ 2/3 2) 1/3))
|
||||
(deftest "divide rational by rational" (assert= (/ 1/2 1/4) 2))
|
||||
(deftest
|
||||
"divide rational gives int when exact"
|
||||
(assert (integer? (/ 1/2 1/2)))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Float contagion
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"rationals:float-contagion"
|
||||
(deftest "rational + float = float" (assert (float? (+ 1/3 0.5))))
|
||||
(deftest "float + rational = float" (assert (float? (+ 0.5 1/3))))
|
||||
(deftest "rational * float = float" (assert (float? (* 1/2 2))))
|
||||
(deftest "rational - float = float" (assert (float? (- 1/2 0.1)))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Comparison
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"rationals:comparison"
|
||||
(deftest "equal rationals" (assert (= 1/2 1/2)))
|
||||
(deftest "equal reduced" (assert (= 2/4 1/2)))
|
||||
(deftest "not equal" (assert (not (= 1/3 1/2))))
|
||||
(deftest "less than" (assert (< 1/3 1/2)))
|
||||
(deftest "less than int" (assert (< 1/3 1)))
|
||||
(deftest "greater than" (assert (> 2/3 1/2)))
|
||||
(deftest "less equal" (assert (<= 1/3 1/3)))
|
||||
(deftest "greater equal" (assert (>= 2/3 2/3)))
|
||||
(deftest "rational less than float" (assert (< 1/3 0.5))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Coercion
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"rationals:coercion"
|
||||
(deftest "exact->inexact 1/2" (assert= (exact->inexact 1/2) 0.5))
|
||||
(deftest "exact->inexact 1/4" (assert= (exact->inexact 1/4) 0.25))
|
||||
(deftest
|
||||
"exact->inexact 1/3 is float"
|
||||
(assert (float? (exact->inexact 1/3))))
|
||||
(deftest "number->string 1/2" (assert= (number->string 1/2) "1/2"))
|
||||
(deftest "number->string 3/4" (assert= (number->string 3/4) "3/4")))
|
||||
212
spec/tests/test-read-write.sx
Normal file
212
spec/tests/test-read-write.sx
Normal file
@@ -0,0 +1,212 @@
|
||||
;; ==========================================================================
|
||||
;; test-read-write.sx — Tests for read / write / display / newline
|
||||
;; ==========================================================================
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; read — parse one datum from an input port
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"read:basics"
|
||||
(deftest
|
||||
"read integer"
|
||||
(let ((p (open-input-string "42"))) (assert= (read p) 42)))
|
||||
(deftest
|
||||
"read float"
|
||||
(let ((p (open-input-string "3.14"))) (assert= (read p) 3.14)))
|
||||
(deftest
|
||||
"read string"
|
||||
(let ((p (open-input-string "\"hello\""))) (assert= (read p) "hello")))
|
||||
(deftest
|
||||
"read boolean true"
|
||||
(let ((p (open-input-string "#t"))) (assert (read p))))
|
||||
(deftest
|
||||
"read boolean false"
|
||||
(let ((p (open-input-string "#f"))) (assert (not (read p)))))
|
||||
(deftest
|
||||
"read nil"
|
||||
(let ((p (open-input-string "()"))) (assert-nil (read p))))
|
||||
(deftest
|
||||
"read list"
|
||||
(let
|
||||
((p (open-input-string "(1 2 3)")))
|
||||
(assert= (read p) (list 1 2 3))))
|
||||
(deftest
|
||||
"read nested list"
|
||||
(let
|
||||
((p (open-input-string "(+ 1 (* 2 3))")))
|
||||
(assert=
|
||||
(read p)
|
||||
(list (quote +) 1 (list (quote *) 2 3))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; read — eof and multi-read
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"read:eof"
|
||||
(deftest
|
||||
"read eof returns eof-object"
|
||||
(let ((p (open-input-string ""))) (assert (eof-object? (read p)))))
|
||||
(deftest
|
||||
"read whitespace-only returns eof"
|
||||
(let ((p (open-input-string " "))) (assert (eof-object? (read p)))))
|
||||
(deftest
|
||||
"read two forms"
|
||||
(let
|
||||
((p (open-input-string "1 2")))
|
||||
(let
|
||||
((a (read p)) (b (read p)))
|
||||
(assert (and (= a 1) (= b 2))))))
|
||||
(deftest
|
||||
"read returns eof after last form"
|
||||
(let
|
||||
((p (open-input-string "42")))
|
||||
(read p)
|
||||
(assert (eof-object? (read p))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; write — serialize with quoting
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"write:basics"
|
||||
(deftest "write integer" (assert= (write-to-string 42) "42"))
|
||||
(deftest
|
||||
"write negative integer"
|
||||
(assert= (write-to-string -5) "-5"))
|
||||
(deftest "write float" (assert= (write-to-string 3.14) "3.14"))
|
||||
(deftest "write true" (assert= (write-to-string true) "#t"))
|
||||
(deftest "write false" (assert= (write-to-string false) "#f"))
|
||||
(deftest "write nil" (assert= (write-to-string nil) "()"))
|
||||
(deftest
|
||||
"write string quotes"
|
||||
(assert= (write-to-string "hello") "\"hello\""))
|
||||
(deftest
|
||||
"write string with escapes"
|
||||
(assert= (write-to-string "a\"b") "\"a\\\"b\""))
|
||||
(deftest
|
||||
"write list"
|
||||
(assert=
|
||||
(write-to-string (list 1 2 3))
|
||||
"(1 2 3)"))
|
||||
(deftest
|
||||
"write nested list"
|
||||
(assert=
|
||||
(write-to-string (list 1 (list 2 3)))
|
||||
"(1 (2 3))"))
|
||||
(deftest "write symbol" (assert= (write-to-string (quote foo)) "foo"))
|
||||
(deftest "write rational" (assert= (write-to-string 1/3) "1/3")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; display — serialize without quoting
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"display:basics"
|
||||
(deftest "display integer" (assert= (display-to-string 42) "42"))
|
||||
(deftest
|
||||
"display string no quotes"
|
||||
(assert= (display-to-string "hello") "hello"))
|
||||
(deftest "display true" (assert= (display-to-string true) "#t"))
|
||||
(deftest "display nil" (assert= (display-to-string nil) "()"))
|
||||
(deftest
|
||||
"display list"
|
||||
(assert=
|
||||
(display-to-string (list 1 2 3))
|
||||
"(1 2 3)")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; write vs display distinction
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"write-vs-display"
|
||||
(deftest
|
||||
"write quotes string, display does not"
|
||||
(let
|
||||
((s "hello"))
|
||||
(assert
|
||||
(and
|
||||
(= (write-to-string s) "\"hello\"")
|
||||
(= (display-to-string s) "hello")))))
|
||||
(deftest
|
||||
"write and display same for numbers"
|
||||
(assert= (write-to-string 42) (display-to-string 42)))
|
||||
(deftest
|
||||
"write and display same for lists"
|
||||
(assert=
|
||||
(write-to-string (list 1 2))
|
||||
(display-to-string (list 1 2)))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; write/display/newline to port
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"write-to-port"
|
||||
(deftest
|
||||
"write to output port"
|
||||
(let
|
||||
((p (open-output-string)))
|
||||
(write 42 p)
|
||||
(assert= (get-output-string p) "42")))
|
||||
(deftest
|
||||
"display to output port"
|
||||
(let
|
||||
((p (open-output-string)))
|
||||
(display "hi" p)
|
||||
(assert= (get-output-string p) "hi")))
|
||||
(deftest
|
||||
"newline to output port"
|
||||
(let
|
||||
((p (open-output-string)))
|
||||
(newline p)
|
||||
(assert= (get-output-string p) "\n")))
|
||||
(deftest
|
||||
"write then newline"
|
||||
(let
|
||||
((p (open-output-string)))
|
||||
(write "hello" p)
|
||||
(newline p)
|
||||
(assert= (get-output-string p) "\"hello\"\n")))
|
||||
(deftest
|
||||
"display multiple values"
|
||||
(let
|
||||
((p (open-output-string)))
|
||||
(display 1 p)
|
||||
(display " " p)
|
||||
(display 2 p)
|
||||
(assert= (get-output-string p) "1 2"))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; write round-trip
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"write:round-trip"
|
||||
(deftest
|
||||
"integer round-trips"
|
||||
(let
|
||||
((p (open-input-string (write-to-string 42))))
|
||||
(assert= (read p) 42)))
|
||||
(deftest
|
||||
"string round-trips"
|
||||
(let
|
||||
((p (open-input-string (write-to-string "hello world"))))
|
||||
(assert= (read p) "hello world")))
|
||||
(deftest
|
||||
"list round-trips"
|
||||
(let
|
||||
((p (open-input-string (write-to-string (list 1 2 3)))))
|
||||
(assert= (read p) (list 1 2 3))))
|
||||
(deftest
|
||||
"boolean true round-trips"
|
||||
(let
|
||||
((p (open-input-string (write-to-string true))))
|
||||
(assert (read p))))
|
||||
(deftest
|
||||
"boolean false round-trips"
|
||||
(let
|
||||
((p (open-input-string (write-to-string false))))
|
||||
(assert (not (read p))))))
|
||||
191
spec/tests/test-regexp.sx
Normal file
191
spec/tests/test-regexp.sx
Normal file
@@ -0,0 +1,191 @@
|
||||
;; ==========================================================================
|
||||
;; test-regexp.sx — Tests for regexp primitives
|
||||
;; ==========================================================================
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; make-regexp / regexp?
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"regexp:create"
|
||||
(deftest "make-regexp returns regexp" (assert (regexp? (make-regexp "abc"))))
|
||||
(deftest
|
||||
"make-regexp with flags"
|
||||
(assert (regexp? (make-regexp "[a-z]+" "i"))))
|
||||
(deftest "regexp? true for regexp" (assert (regexp? (make-regexp "x"))))
|
||||
(deftest "regexp? false for string" (assert (not (regexp? "abc"))))
|
||||
(deftest "regexp? false for nil" (assert (not (regexp? nil))))
|
||||
(deftest
|
||||
"regexp-source"
|
||||
(assert= (regexp-source (make-regexp "hello")) "hello"))
|
||||
(deftest
|
||||
"regexp-flags"
|
||||
(assert= (regexp-flags (make-regexp "x" "im")) "im"))
|
||||
(deftest
|
||||
"regexp-flags empty string"
|
||||
(assert= (regexp-flags (make-regexp "x")) "")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; regexp-match — basic
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"regexp:match"
|
||||
(deftest
|
||||
"match returns dict"
|
||||
(let
|
||||
((m (regexp-match (make-regexp "hel+o") "hello world")))
|
||||
(assert (dict? m))))
|
||||
(deftest
|
||||
"match :match key"
|
||||
(let
|
||||
((m (regexp-match (make-regexp "hel+o") "say hello")))
|
||||
(assert= (get m "match") "hello")))
|
||||
(deftest
|
||||
"match :start key"
|
||||
(let
|
||||
((m (regexp-match (make-regexp "lo") "hello")))
|
||||
(assert= (get m "start") 3)))
|
||||
(deftest
|
||||
"match :end key"
|
||||
(let
|
||||
((m (regexp-match (make-regexp "lo") "hello")))
|
||||
(assert= (get m "end") 5)))
|
||||
(deftest
|
||||
"no match returns nil"
|
||||
(assert-nil (regexp-match (make-regexp "xyz") "hello")))
|
||||
(deftest
|
||||
"match at start"
|
||||
(let
|
||||
((m (regexp-match (make-regexp "^hel") "hello")))
|
||||
(assert= (get m "start") 0)))
|
||||
(deftest
|
||||
"match digit pattern"
|
||||
(let
|
||||
((m (regexp-match (make-regexp "[0-9]+") "abc 123 def")))
|
||||
(assert= (get m "match") "123"))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; regexp-match — groups
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"regexp:groups"
|
||||
(deftest
|
||||
"no capture groups → empty list"
|
||||
(let
|
||||
((m (regexp-match (make-regexp "hello") "hello world")))
|
||||
(assert= (length (get m "groups")) 0)))
|
||||
(deftest
|
||||
"one capture group"
|
||||
(let
|
||||
((m (regexp-match (make-regexp "([0-9]+)") "price: 42")))
|
||||
(assert= (first (get m "groups")) "42")))
|
||||
(deftest
|
||||
"two capture groups"
|
||||
(let
|
||||
((m (regexp-match (make-regexp "([a-z]+)=([0-9]+)") "x=10")))
|
||||
(let
|
||||
((gs (get m "groups")))
|
||||
(assert
|
||||
(and (= (first gs) "x") (= (first (rest gs)) "10")))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; regexp-match-all
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"regexp:match-all"
|
||||
(deftest
|
||||
"match-all returns list"
|
||||
(let
|
||||
((ms (regexp-match-all (make-regexp "[0-9]+") "1 and 2 and 3")))
|
||||
(assert (list? ms))))
|
||||
(deftest
|
||||
"match-all count"
|
||||
(assert=
|
||||
(length (regexp-match-all (make-regexp "[0-9]+") "1 and 2 and 3"))
|
||||
3))
|
||||
(deftest
|
||||
"match-all first match"
|
||||
(let
|
||||
((ms (regexp-match-all (make-regexp "[0-9]+") "10 20 30")))
|
||||
(assert= (get (first ms) "match") "10")))
|
||||
(deftest
|
||||
"match-all empty when no match"
|
||||
(assert=
|
||||
(length (regexp-match-all (make-regexp "xyz") "hello"))
|
||||
0)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; regexp-replace / regexp-replace-all
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"regexp:replace"
|
||||
(deftest
|
||||
"replace first match"
|
||||
(assert= (regexp-replace (make-regexp "o+") "foobar boo" "0") "f0bar boo"))
|
||||
(deftest
|
||||
"replace no match returns original"
|
||||
(assert= (regexp-replace (make-regexp "xyz") "hello" "X") "hello"))
|
||||
(deftest
|
||||
"replace-all all matches"
|
||||
(assert= (regexp-replace-all (make-regexp "o") "foo boo" "0") "f00 b00"))
|
||||
(deftest
|
||||
"replace with $& (whole match)"
|
||||
(assert=
|
||||
(regexp-replace (make-regexp "[0-9]+") "price 42" "[$&]")
|
||||
"price [42]"))
|
||||
(deftest
|
||||
"replace-all removes digits"
|
||||
(assert=
|
||||
(regexp-replace-all (make-regexp "[0-9]") "a1b2c3" "")
|
||||
"abc")))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; regexp-split
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"regexp:split"
|
||||
(deftest
|
||||
"split on whitespace"
|
||||
(let
|
||||
((parts (regexp-split (make-regexp " +") "hello world foo")))
|
||||
(assert= (length parts) 3)))
|
||||
(deftest
|
||||
"split first part"
|
||||
(let
|
||||
((parts (regexp-split (make-regexp ",") "a,b,c")))
|
||||
(assert= (first parts) "a")))
|
||||
(deftest
|
||||
"split last part"
|
||||
(let
|
||||
((parts (regexp-split (make-regexp ",") "a,b,c")))
|
||||
(assert= (first (rest (rest parts))) "c")))
|
||||
(deftest
|
||||
"split no match → single element"
|
||||
(let
|
||||
((parts (regexp-split (make-regexp ",") "hello")))
|
||||
(assert= (length parts) 1))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; flags
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"regexp:flags"
|
||||
(deftest
|
||||
"case-insensitive flag"
|
||||
(let
|
||||
((m (regexp-match (make-regexp "HELLO" "i") "hello world")))
|
||||
(assert (not (nil? m)))))
|
||||
(deftest
|
||||
"case-sensitive without flag"
|
||||
(assert-nil (regexp-match (make-regexp "HELLO") "hello world")))
|
||||
(deftest
|
||||
"multiline ^ matches line starts"
|
||||
(let
|
||||
((ms (regexp-match-all (make-regexp "^[a-z]" "m") "a\nb\nc")))
|
||||
(assert= (length ms) 3))))
|
||||
202
spec/tests/test-sequences.sx
Normal file
202
spec/tests/test-sequences.sx
Normal file
@@ -0,0 +1,202 @@
|
||||
;; test-sequences.sx — Phase 11: sequence protocol tests
|
||||
|
||||
(defsuite
|
||||
"sequences"
|
||||
(deftest
|
||||
"seq-to-list nil is empty list"
|
||||
(assert-equal (list) (seq-to-list nil)))
|
||||
(deftest
|
||||
"seq-to-list list is identity"
|
||||
(assert-equal
|
||||
(list 1 2 3)
|
||||
(seq-to-list (list 1 2 3))))
|
||||
(deftest
|
||||
"seq-to-list vector to list"
|
||||
(assert-equal
|
||||
(list 10 20 30)
|
||||
(seq-to-list (vector 10 20 30))))
|
||||
(deftest
|
||||
"seq-to-list string to char list"
|
||||
(assert-equal (list "a" "b" "c") (seq-to-list "abc")))
|
||||
(deftest
|
||||
"seq-to-list empty string to empty list"
|
||||
(assert-equal (list) (seq-to-list "")))
|
||||
(deftest
|
||||
"sequence-to-list nil is empty list"
|
||||
(assert-equal (list) (sequence-to-list nil)))
|
||||
(deftest
|
||||
"sequence-to-list list is identity"
|
||||
(assert-equal
|
||||
(list 1 2 3)
|
||||
(sequence-to-list (list 1 2 3))))
|
||||
(deftest
|
||||
"sequence-to-list vector to list"
|
||||
(assert-equal (list "x" "y") (sequence-to-list (vector "x" "y"))))
|
||||
(deftest
|
||||
"sequence-to-list string to char list"
|
||||
(assert-equal (list "h" "i") (sequence-to-list "hi")))
|
||||
(deftest
|
||||
"sequence-to-vector nil is empty vector"
|
||||
(let
|
||||
((v (sequence-to-vector nil)))
|
||||
(do (assert (vector? v)) (assert= 0 (vector-length v)))))
|
||||
(deftest
|
||||
"sequence-to-vector list to vector"
|
||||
(let
|
||||
((v (sequence-to-vector (list 1 2 3))))
|
||||
(do
|
||||
(assert (vector? v))
|
||||
(assert= 3 (vector-length v))
|
||||
(assert= 1 (vector-ref v 0))
|
||||
(assert= 3 (vector-ref v 2)))))
|
||||
(deftest
|
||||
"sequence-to-vector string to vector of chars"
|
||||
(let
|
||||
((v (sequence-to-vector "abc")))
|
||||
(do
|
||||
(assert (vector? v))
|
||||
(assert= 3 (vector-length v))
|
||||
(assert= "a" (vector-ref v 0))
|
||||
(assert= "c" (vector-ref v 2)))))
|
||||
(deftest
|
||||
"sequence-length nil is 0"
|
||||
(assert= 0 (sequence-length nil)))
|
||||
(deftest
|
||||
"sequence-length empty list is 0"
|
||||
(assert= 0 (sequence-length (list))))
|
||||
(deftest
|
||||
"sequence-length list of 3"
|
||||
(assert=
|
||||
3
|
||||
(sequence-length (list 1 2 3))))
|
||||
(deftest
|
||||
"sequence-length empty vector is 0"
|
||||
(assert= 0 (sequence-length (vector))))
|
||||
(deftest
|
||||
"sequence-length vector of 4"
|
||||
(assert=
|
||||
4
|
||||
(sequence-length (vector 10 20 30 40))))
|
||||
(deftest
|
||||
"sequence-length empty string is 0"
|
||||
(assert= 0 (sequence-length "")))
|
||||
(deftest
|
||||
"sequence-length string hello"
|
||||
(assert= 5 (sequence-length "hello")))
|
||||
(deftest
|
||||
"sequence-ref list first"
|
||||
(assert=
|
||||
10
|
||||
(sequence-ref (list 10 20 30) 0)))
|
||||
(deftest
|
||||
"sequence-ref list last"
|
||||
(assert=
|
||||
30
|
||||
(sequence-ref (list 10 20 30) 2)))
|
||||
(deftest
|
||||
"sequence-ref vector middle"
|
||||
(assert=
|
||||
20
|
||||
(sequence-ref (vector 10 20 30) 1)))
|
||||
(deftest
|
||||
"sequence-ref string first char"
|
||||
(assert= "h" (sequence-ref "hello" 0)))
|
||||
(deftest
|
||||
"sequence-ref string last char"
|
||||
(assert= "o" (sequence-ref "hello" 4)))
|
||||
(deftest
|
||||
"sequence-append two lists"
|
||||
(assert-equal
|
||||
(list 1 2 3 4)
|
||||
(sequence-append
|
||||
(list 1 2)
|
||||
(list 3 4))))
|
||||
(deftest
|
||||
"sequence-append list with empty"
|
||||
(assert-equal
|
||||
(list 1 2)
|
||||
(sequence-append (list 1 2) (list))))
|
||||
(deftest
|
||||
"sequence-append two strings"
|
||||
(assert= "hello world" (sequence-append "hello " "world")))
|
||||
(deftest
|
||||
"sequence-append empty strings"
|
||||
(assert= "abc" (sequence-append "" "abc")))
|
||||
(deftest
|
||||
"in-range 1-arg gives 0..n-1"
|
||||
(assert-equal
|
||||
(list 0 1 2 3 4)
|
||||
(in-range 5)))
|
||||
(deftest
|
||||
"in-range 1-arg zero is empty"
|
||||
(assert-equal (list) (in-range 0)))
|
||||
(deftest
|
||||
"in-range 2-arg start and end"
|
||||
(assert-equal
|
||||
(list 1 2 3)
|
||||
(in-range 1 4)))
|
||||
(deftest
|
||||
"in-range 2-arg same start end is empty"
|
||||
(assert-equal (list) (in-range 3 3)))
|
||||
(deftest
|
||||
"in-range 3-arg with step 2"
|
||||
(assert-equal
|
||||
(list 0 2 4)
|
||||
(in-range 0 6 2)))
|
||||
(deftest
|
||||
"in-range result is a list"
|
||||
(assert (list? (in-range 5))))
|
||||
(deftest
|
||||
"in-range length is correct"
|
||||
(assert= 10 (len (in-range 10))))
|
||||
(deftest
|
||||
"map over vector"
|
||||
(assert-equal
|
||||
(list 2 4 6)
|
||||
(map
|
||||
(fn (x) (* x 2))
|
||||
(vector 1 2 3))))
|
||||
(deftest
|
||||
"filter over vector keeps odds"
|
||||
(assert-equal
|
||||
(list 1 3 5)
|
||||
(filter
|
||||
odd?
|
||||
(vector 1 2 3 4 5))))
|
||||
(deftest
|
||||
"reduce over vector sums"
|
||||
(assert=
|
||||
10
|
||||
(reduce
|
||||
+
|
||||
0
|
||||
(vector 1 2 3 4))))
|
||||
(deftest
|
||||
"some over vector finds odd"
|
||||
(assert (some odd? (vector 2 4 3 6))))
|
||||
(deftest
|
||||
"every? over vector all even"
|
||||
(assert
|
||||
(every? even? (vector 2 4 6 8))))
|
||||
(deftest
|
||||
"every? over vector fails with odd"
|
||||
(assert= false (every? even? (vector 2 3 6))))
|
||||
(deftest
|
||||
"map over in-range squares"
|
||||
(assert-equal
|
||||
(list 0 1 4 9 16)
|
||||
(map (fn (x) (* x x)) (in-range 5))))
|
||||
(deftest
|
||||
"filter over in-range keeps evens"
|
||||
(assert-equal
|
||||
(list 0 2 4 6)
|
||||
(filter even? (in-range 7))))
|
||||
(deftest
|
||||
"reduce over in-range sums"
|
||||
(assert= 15 (reduce + 0 (in-range 6))))
|
||||
(deftest
|
||||
"map over string returns char list"
|
||||
(assert-equal (list "a" "b" "c") (map (fn (c) c) "abc")))
|
||||
(deftest
|
||||
"filter over string keeps matching chars"
|
||||
(assert-equal (list "p" "p") (filter (fn (c) (= c "p")) "apple"))))
|
||||
200
spec/tests/test-sets.sx
Normal file
200
spec/tests/test-sets.sx
Normal file
@@ -0,0 +1,200 @@
|
||||
;; ==========================================================================
|
||||
;; test-sets.sx — Tests for set primitives
|
||||
;; ==========================================================================
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; make-set / set?
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"sets:create"
|
||||
(deftest "make-set returns a set" (assert (set? (make-set))))
|
||||
(deftest "empty set has size 0" (assert= (set-size (make-set)) 0))
|
||||
(deftest
|
||||
"make-set from list"
|
||||
(let ((s (make-set (list 1 2 3)))) (assert= (set-size s) 3)))
|
||||
(deftest
|
||||
"make-set deduplicates"
|
||||
(let ((s (make-set (list 1 2 2 3 3)))) (assert= (set-size s) 3)))
|
||||
(deftest "set? true for sets" (assert (set? (make-set))))
|
||||
(deftest "set? false for list" (assert (not (set? (list 1 2 3)))))
|
||||
(deftest "set? false for nil" (assert (not (set? nil))))
|
||||
(deftest "set? false for number" (assert (not (set? 42)))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; set-add! / set-member? / set-remove!
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"sets:mutation"
|
||||
(deftest
|
||||
"set-add! increases size"
|
||||
(let
|
||||
((s (make-set)))
|
||||
(set-add! s 1)
|
||||
(assert= (set-size s) 1)))
|
||||
(deftest
|
||||
"set-add! idempotent"
|
||||
(let
|
||||
((s (make-set)))
|
||||
(set-add! s 1)
|
||||
(set-add! s 1)
|
||||
(assert= (set-size s) 1)))
|
||||
(deftest
|
||||
"set-member? true after add"
|
||||
(let
|
||||
((s (make-set)))
|
||||
(set-add! s "hello")
|
||||
(assert (set-member? s "hello"))))
|
||||
(deftest
|
||||
"set-member? false for absent"
|
||||
(let
|
||||
((s (make-set (list 1 2 3))))
|
||||
(assert (not (set-member? s 99)))))
|
||||
(deftest
|
||||
"set-remove! reduces size"
|
||||
(let
|
||||
((s (make-set (list 1 2 3))))
|
||||
(set-remove! s 2)
|
||||
(assert= (set-size s) 2)))
|
||||
(deftest
|
||||
"set-remove! removes element"
|
||||
(let
|
||||
((s (make-set (list 1 2 3))))
|
||||
(set-remove! s 2)
|
||||
(assert (not (set-member? s 2)))))
|
||||
(deftest
|
||||
"set-remove! no-op for absent"
|
||||
(let
|
||||
((s (make-set (list 1 2 3))))
|
||||
(set-remove! s 99)
|
||||
(assert= (set-size s) 3)))
|
||||
(deftest
|
||||
"set handles strings"
|
||||
(let
|
||||
((s (make-set)))
|
||||
(set-add! s "a")
|
||||
(set-add! s "b")
|
||||
(assert (and (set-member? s "a") (set-member? s "b")))))
|
||||
(deftest
|
||||
"set handles symbols"
|
||||
(let
|
||||
((s (make-set)))
|
||||
(set-add! s (quote foo))
|
||||
(assert (set-member? s (quote foo))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; set->list / list->set
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"sets:conversion"
|
||||
(deftest
|
||||
"list->set creates set"
|
||||
(let ((s (list->set (list 1 2 3)))) (assert (set? s))))
|
||||
(deftest
|
||||
"list->set size"
|
||||
(let ((s (list->set (list 1 2 3)))) (assert= (set-size s) 3)))
|
||||
(deftest
|
||||
"list->set deduplicates"
|
||||
(let ((s (list->set (list 1 1 2)))) (assert= (set-size s) 2)))
|
||||
(deftest
|
||||
"set->list has all elements"
|
||||
(let
|
||||
((s (make-set (list 1 2 3)))
|
||||
(lst (set->list s)))
|
||||
(assert= (length lst) 3)))
|
||||
(deftest
|
||||
"set->list round-trip membership"
|
||||
(let
|
||||
((s (make-set (list 10 20 30)))
|
||||
(lst (set->list s)))
|
||||
(assert
|
||||
(and
|
||||
(set-member? (list->set lst) 10)
|
||||
(set-member? (list->set lst) 20)
|
||||
(set-member? (list->set lst) 30))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; set-union / set-intersection / set-difference
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"sets:operations"
|
||||
(deftest
|
||||
"union size"
|
||||
(let
|
||||
((a (make-set (list 1 2 3)))
|
||||
(b (make-set (list 3 4 5))))
|
||||
(assert= (set-size (set-union a b)) 5)))
|
||||
(deftest
|
||||
"union contains all"
|
||||
(let
|
||||
((u (set-union (make-set (list 1 2)) (make-set (list 3 4)))))
|
||||
(assert
|
||||
(and
|
||||
(set-member? u 1)
|
||||
(set-member? u 3)
|
||||
(set-member? u 4)))))
|
||||
(deftest
|
||||
"intersection size"
|
||||
(let
|
||||
((a (make-set (list 1 2 3)))
|
||||
(b (make-set (list 2 3 4))))
|
||||
(assert= (set-size (set-intersection a b)) 2)))
|
||||
(deftest
|
||||
"intersection contains overlap"
|
||||
(let
|
||||
((i (set-intersection (make-set (list 1 2 3)) (make-set (list 2 3 4)))))
|
||||
(assert (and (set-member? i 2) (set-member? i 3) (not (set-member? i 1))))))
|
||||
(deftest
|
||||
"intersection empty when disjoint"
|
||||
(let
|
||||
((a (make-set (list 1 2)))
|
||||
(b (make-set (list 3 4))))
|
||||
(assert= (set-size (set-intersection a b)) 0)))
|
||||
(deftest
|
||||
"difference size"
|
||||
(let
|
||||
((a (make-set (list 1 2 3)))
|
||||
(b (make-set (list 2 3))))
|
||||
(assert= (set-size (set-difference a b)) 1)))
|
||||
(deftest
|
||||
"difference keeps only a-exclusive"
|
||||
(let
|
||||
((d (set-difference (make-set (list 1 2 3)) (make-set (list 2 3 4)))))
|
||||
(assert (and (set-member? d 1) (not (set-member? d 2)) (not (set-member? d 4))))))
|
||||
(deftest
|
||||
"union does not mutate inputs"
|
||||
(let
|
||||
((a (make-set (list 1 2)))
|
||||
(b (make-set (list 3 4))))
|
||||
(set-union a b)
|
||||
(assert= (set-size a) 2))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; set-for-each / set-map
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite
|
||||
"sets:higher-order"
|
||||
(deftest
|
||||
"set-for-each visits all"
|
||||
(let
|
||||
((s (make-set (list 1 2 3)))
|
||||
(acc (list)))
|
||||
(set-for-each s (fn (v) (set! acc (cons v acc))))
|
||||
(assert= (length acc) 3)))
|
||||
(deftest
|
||||
"set-map doubles values"
|
||||
(let
|
||||
((s (make-set (list 1 2 3)))
|
||||
(s2 (set-map s (fn (v) (* v 2)))))
|
||||
(assert
|
||||
(and
|
||||
(set-member? s2 2)
|
||||
(set-member? s2 4)
|
||||
(set-member? s2 6)))))
|
||||
(deftest
|
||||
"set-map result is a set"
|
||||
(assert (set? (set-map (make-set (list 1 2)) (fn (v) v))))))
|
||||
131
spec/tests/test-string-buffer.sx
Normal file
131
spec/tests/test-string-buffer.sx
Normal file
@@ -0,0 +1,131 @@
|
||||
(defsuite
|
||||
"string-buffer"
|
||||
(deftest
|
||||
"make-string-buffer creates a string-buffer"
|
||||
(let ((buf (make-string-buffer))) (assert (string-buffer? buf))))
|
||||
(deftest
|
||||
"string-buffer? is false for non-buffers"
|
||||
(assert= false (string-buffer? "hello"))
|
||||
(assert= false (string-buffer? 42))
|
||||
(assert= false (string-buffer? nil))
|
||||
(assert= false (string-buffer? (list)))
|
||||
(assert= false (string-buffer? {:key "val"})))
|
||||
(deftest
|
||||
"type-of returns string-buffer"
|
||||
(assert= "string-buffer" (type-of (make-string-buffer))))
|
||||
(deftest
|
||||
"empty buffer converts to empty string"
|
||||
(let
|
||||
((buf (make-string-buffer)))
|
||||
(assert= "" (string-buffer->string buf))))
|
||||
(deftest
|
||||
"empty buffer has length zero"
|
||||
(let
|
||||
((buf (make-string-buffer)))
|
||||
(assert= 0 (string-buffer-length buf))))
|
||||
(deftest
|
||||
"single append accumulates string"
|
||||
(let
|
||||
((buf (make-string-buffer)))
|
||||
(string-buffer-append! buf "hello")
|
||||
(assert= "hello" (string-buffer->string buf))))
|
||||
(deftest
|
||||
"multiple appends join in order"
|
||||
(let
|
||||
((buf (make-string-buffer)))
|
||||
(string-buffer-append! buf "foo")
|
||||
(string-buffer-append! buf "bar")
|
||||
(string-buffer-append! buf "baz")
|
||||
(assert= "foobarbaz" (string-buffer->string buf))))
|
||||
(deftest
|
||||
"length tracks total bytes appended"
|
||||
(let
|
||||
((buf (make-string-buffer)))
|
||||
(string-buffer-append! buf "abc")
|
||||
(string-buffer-append! buf "de")
|
||||
(assert= 5 (string-buffer-length buf))))
|
||||
(deftest
|
||||
"append returns nil"
|
||||
(let
|
||||
((buf (make-string-buffer)))
|
||||
(assert= nil (string-buffer-append! buf "x"))))
|
||||
(deftest
|
||||
"appending empty string is harmless"
|
||||
(let
|
||||
((buf (make-string-buffer)))
|
||||
(string-buffer-append! buf "start")
|
||||
(string-buffer-append! buf "")
|
||||
(string-buffer-append! buf "end")
|
||||
(assert= "startend" (string-buffer->string buf))
|
||||
(assert= 8 (string-buffer-length buf))))
|
||||
(deftest
|
||||
"buffer is still usable after string-buffer->string"
|
||||
(let
|
||||
((buf (make-string-buffer)))
|
||||
(string-buffer-append! buf "hello")
|
||||
(string-buffer->string buf)
|
||||
(string-buffer-append! buf " world")
|
||||
(assert= "hello world" (string-buffer->string buf))))
|
||||
(deftest
|
||||
"two buffers are independent"
|
||||
(let
|
||||
((b1 (make-string-buffer)) (b2 (make-string-buffer)))
|
||||
(string-buffer-append! b1 "one")
|
||||
(string-buffer-append! b2 "two")
|
||||
(string-buffer-append! b1 "ONE")
|
||||
(assert= "oneONE" (string-buffer->string b1))
|
||||
(assert= "two" (string-buffer->string b2))))
|
||||
(deftest
|
||||
"loop building — linear string concat"
|
||||
(let
|
||||
((buf (make-string-buffer)))
|
||||
(let
|
||||
loop
|
||||
((i 0))
|
||||
(when
|
||||
(< i 5)
|
||||
(string-buffer-append! buf (str i))
|
||||
(loop (+ i 1))))
|
||||
(assert= "01234" (string-buffer->string buf))
|
||||
(assert= 5 (string-buffer-length buf))))
|
||||
(deftest
|
||||
"building CSV row with separator"
|
||||
(let
|
||||
((buf (make-string-buffer)) (items (list "a" "b" "c" "d")))
|
||||
(let
|
||||
loop
|
||||
((remaining items) (is-first true))
|
||||
(when
|
||||
(not (empty? remaining))
|
||||
(when (not is-first) (string-buffer-append! buf ","))
|
||||
(string-buffer-append! buf (first remaining))
|
||||
(loop (rest remaining) false)))
|
||||
(assert= "a,b,c,d" (string-buffer->string buf))))
|
||||
(deftest
|
||||
"unicode characters accumulate correctly"
|
||||
(let
|
||||
((buf (make-string-buffer)))
|
||||
(string-buffer-append! buf "こんにちは")
|
||||
(string-buffer-append! buf " ")
|
||||
(string-buffer-append! buf "世界")
|
||||
(assert= "こんにちは 世界" (string-buffer->string buf))))
|
||||
(deftest
|
||||
"repeated to-string calls are consistent"
|
||||
(let
|
||||
((buf (make-string-buffer)))
|
||||
(string-buffer-append! buf "test")
|
||||
(assert= (string-buffer->string buf) (string-buffer->string buf))))
|
||||
(deftest
|
||||
"building with join pattern produces correct output"
|
||||
(let
|
||||
((buf (make-string-buffer))
|
||||
(words (list "the" "quick" "brown" "fox")))
|
||||
(let
|
||||
loop
|
||||
((remaining words) (sep ""))
|
||||
(when
|
||||
(not (empty? remaining))
|
||||
(string-buffer-append! buf sep)
|
||||
(string-buffer-append! buf (first remaining))
|
||||
(loop (rest remaining) " ")))
|
||||
(assert= "the quick brown fox" (string-buffer->string buf)))))
|
||||
172
spec/tests/test-values.sx
Normal file
172
spec/tests/test-values.sx
Normal file
@@ -0,0 +1,172 @@
|
||||
(defsuite
|
||||
"multiple-values"
|
||||
(deftest
|
||||
"values single returns value directly"
|
||||
(do
|
||||
(assert= 42 (values 42))
|
||||
(assert= "hi" (values "hi"))
|
||||
(assert= nil (values nil))))
|
||||
(deftest
|
||||
"values multiple returns marker dict"
|
||||
(do
|
||||
(let
|
||||
((v (values 1 2 3)))
|
||||
(assert (dict? v))
|
||||
(assert= true (get v :_values false))
|
||||
(assert-equal (list 1 2 3) (get v :_list)))))
|
||||
(deftest
|
||||
"call-with-values basic two values"
|
||||
(do
|
||||
(assert=
|
||||
3
|
||||
(call-with-values
|
||||
(fn () (values 1 2))
|
||||
(fn (a b) (+ a b))))))
|
||||
(deftest
|
||||
"call-with-values three values"
|
||||
(do
|
||||
(assert=
|
||||
6
|
||||
(call-with-values
|
||||
(fn () (values 1 2 3))
|
||||
(fn (a b c) (+ a b c))))))
|
||||
(deftest
|
||||
"call-with-values single value passthrough"
|
||||
(do
|
||||
(assert= 10 (call-with-values (fn () 10) (fn (x) x)))))
|
||||
(deftest
|
||||
"call-with-values passes non-values result as single arg"
|
||||
(do (assert= "hello" (call-with-values (fn () "hello") (fn (x) x)))))
|
||||
(deftest
|
||||
"call-with-values with string concat"
|
||||
(do
|
||||
(assert=
|
||||
"ab"
|
||||
(call-with-values (fn () (values "a" "b")) (fn (a b) (str a b))))))
|
||||
(deftest
|
||||
"let-values basic two bindings"
|
||||
(do
|
||||
(let-values
|
||||
(((a b) (values 10 20)))
|
||||
(assert= 10 a)
|
||||
(assert= 20 b))))
|
||||
(deftest
|
||||
"let-values computes with bindings"
|
||||
(do
|
||||
(let-values
|
||||
(((x y) (values 3 4)))
|
||||
(assert= 7 (+ x y)))))
|
||||
(deftest
|
||||
"let-values three values"
|
||||
(do
|
||||
(let-values
|
||||
(((a b c) (values 1 2 3)))
|
||||
(assert= 6 (+ a b c)))))
|
||||
(deftest
|
||||
"let-values single value binding"
|
||||
(do (let-values (((x) (values 42))) (assert= 42 x))))
|
||||
(deftest
|
||||
"let-values multiple binding clauses"
|
||||
(do
|
||||
(let-values
|
||||
(((a b) (values 1 2))
|
||||
((c d) (values 3 4)))
|
||||
(assert= 10 (+ a b c d)))))
|
||||
(deftest
|
||||
"let-values body is multiple expressions"
|
||||
(do
|
||||
(let-values
|
||||
(((a b) (values 5 6)))
|
||||
(define sum (+ a b))
|
||||
(assert= 11 sum))))
|
||||
(deftest
|
||||
"let-values with no bindings evals body"
|
||||
(do (let-values () (assert= 99 99))))
|
||||
(deftest
|
||||
"define-values binds multiple names"
|
||||
(do
|
||||
(define-values (x y) (values 7 8))
|
||||
(assert= 7 x)
|
||||
(assert= 8 y)))
|
||||
(deftest
|
||||
"define-values three names"
|
||||
(do
|
||||
(define-values (a b c) (values 10 20 30))
|
||||
(assert= 10 a)
|
||||
(assert= 20 b)
|
||||
(assert= 30 c)))
|
||||
(deftest
|
||||
"define-values single name"
|
||||
(do (define-values (n) (values 42)) (assert= 42 n)))
|
||||
(deftest
|
||||
"define-values used in computation"
|
||||
(do
|
||||
(define-values (w h) (values 6 7))
|
||||
(assert= 42 (* w h))))
|
||||
(deftest
|
||||
"values in let binding"
|
||||
(do
|
||||
(let
|
||||
((v (values 100 200)))
|
||||
(assert= true (get v :_values false))
|
||||
(assert= 100 (first (get v :_list))))))
|
||||
(deftest
|
||||
"call-with-values with swap"
|
||||
(do
|
||||
(define (swap a b) (values b a))
|
||||
(assert=
|
||||
5
|
||||
(call-with-values
|
||||
(fn () (swap 3 5))
|
||||
(fn (first-val second-val) first-val)))))
|
||||
(deftest
|
||||
"let-values from function returning values"
|
||||
(do
|
||||
(define (min-max a b) (values (min a b) (max a b)))
|
||||
(let-values
|
||||
(((lo hi) (min-max 7 3)))
|
||||
(assert= 3 lo)
|
||||
(assert= 7 hi))))
|
||||
(deftest
|
||||
"nested let-values"
|
||||
(do
|
||||
(let-values
|
||||
(((a b) (values 1 2)))
|
||||
(let-values
|
||||
(((c d) (values 3 4)))
|
||||
(assert= 10 (+ a b c d))))))
|
||||
(deftest
|
||||
"call-with-values chained"
|
||||
(do
|
||||
(define
|
||||
result
|
||||
(call-with-values
|
||||
(fn
|
||||
()
|
||||
(call-with-values
|
||||
(fn () (values 4 6))
|
||||
(fn (a b) (* a b))))
|
||||
(fn (x) x)))
|
||||
(assert= 24 result)))
|
||||
(deftest
|
||||
"values zero args produces dict"
|
||||
(do
|
||||
(let
|
||||
((v (values)))
|
||||
(assert (dict? v))
|
||||
(assert (get v :_values false))
|
||||
(assert-equal (list) (get v :_list)))))
|
||||
(deftest
|
||||
"let-values strings"
|
||||
(do
|
||||
(let-values
|
||||
(((first-name last-name) (values "Alice" "Smith")))
|
||||
(assert= "Alice Smith" (str first-name " " last-name)))))
|
||||
(deftest
|
||||
"define-values with list values"
|
||||
(do
|
||||
(define-values
|
||||
(head tail)
|
||||
(values 1 (list 2 3 4)))
|
||||
(assert= 1 head)
|
||||
(assert-equal (list 2 3 4) tail))))
|
||||
207
spec/tests/test-vectors.sx
Normal file
207
spec/tests/test-vectors.sx
Normal file
@@ -0,0 +1,207 @@
|
||||
;; test-vectors.sx — Tests for vector primitives
|
||||
|
||||
(defsuite
|
||||
"vectors"
|
||||
(deftest
|
||||
"make-vector default fill is nil"
|
||||
(let
|
||||
((v (make-vector 3)))
|
||||
(assert (vector? v))
|
||||
(assert-equal 3 (vector-length v))
|
||||
(assert-equal nil (vector-ref v 0))
|
||||
(assert-equal nil (vector-ref v 1))
|
||||
(assert-equal nil (vector-ref v 2))))
|
||||
(deftest
|
||||
"make-vector with fill value"
|
||||
(let
|
||||
((v (make-vector 4 99)))
|
||||
(assert-equal 4 (vector-length v))
|
||||
(assert-equal 99 (vector-ref v 0))
|
||||
(assert-equal 99 (vector-ref v 1))
|
||||
(assert-equal 99 (vector-ref v 2))
|
||||
(assert-equal 99 (vector-ref v 3))))
|
||||
(deftest
|
||||
"make-vector size zero"
|
||||
(let ((v (make-vector 0))) (assert-equal 0 (vector-length v))))
|
||||
(deftest
|
||||
"make-vector size one"
|
||||
(let
|
||||
((v (make-vector 1 "x")))
|
||||
(assert-equal 1 (vector-length v))
|
||||
(assert-equal "x" (vector-ref v 0))))
|
||||
(deftest
|
||||
"vector constructor no args"
|
||||
(let ((v (vector))) (assert-equal 0 (vector-length v))))
|
||||
(deftest
|
||||
"vector constructor with args"
|
||||
(let
|
||||
((v (vector 10 20 30)))
|
||||
(assert-equal 3 (vector-length v))
|
||||
(assert-equal 10 (vector-ref v 0))
|
||||
(assert-equal 20 (vector-ref v 1))
|
||||
(assert-equal 30 (vector-ref v 2))))
|
||||
(deftest
|
||||
"vector constructor strings"
|
||||
(let
|
||||
((v (vector "a" "b" "c")))
|
||||
(assert-equal "a" (vector-ref v 0))
|
||||
(assert-equal "b" (vector-ref v 1))
|
||||
(assert-equal "c" (vector-ref v 2))))
|
||||
(deftest "vector? true for vector" (assert (vector? (make-vector 3))))
|
||||
(deftest "vector? false for list" (assert (not (vector? (list 1 2 3)))))
|
||||
(deftest "vector? false for number" (assert (not (vector? 42))))
|
||||
(deftest "vector? false for nil" (assert (not (vector? nil))))
|
||||
(deftest "vector? false for string" (assert (not (vector? "hello"))))
|
||||
(deftest "vector-length zero" (assert-equal 0 (vector-length (vector))))
|
||||
(deftest
|
||||
"vector-length three"
|
||||
(assert-equal 3 (vector-length (vector 1 2 3))))
|
||||
(deftest
|
||||
"vector-length after make-vector"
|
||||
(assert-equal 7 (vector-length (make-vector 7 0))))
|
||||
(deftest
|
||||
"vector-ref first element"
|
||||
(assert-equal 1 (vector-ref (vector 1 2 3) 0)))
|
||||
(deftest
|
||||
"vector-ref last element"
|
||||
(assert-equal 3 (vector-ref (vector 1 2 3) 2)))
|
||||
(deftest
|
||||
"vector-ref middle element"
|
||||
(assert-equal 2 (vector-ref (vector 1 2 3) 1)))
|
||||
(deftest
|
||||
"vector-set! mutates in place"
|
||||
(let
|
||||
((v (vector 1 2 3)))
|
||||
(vector-set! v 1 99)
|
||||
(assert-equal 99 (vector-ref v 1))
|
||||
(assert-equal 1 (vector-ref v 0))
|
||||
(assert-equal 3 (vector-ref v 2))))
|
||||
(deftest
|
||||
"vector-set! first slot"
|
||||
(let
|
||||
((v (make-vector 3 0)))
|
||||
(vector-set! v 0 42)
|
||||
(assert-equal 42 (vector-ref v 0))))
|
||||
(deftest
|
||||
"vector-set! last slot"
|
||||
(let
|
||||
((v (make-vector 3 0)))
|
||||
(vector-set! v 2 77)
|
||||
(assert-equal 77 (vector-ref v 2))))
|
||||
(deftest
|
||||
"vector-set! returns nil"
|
||||
(let ((v (make-vector 3 0))) (assert-equal nil (vector-set! v 0 1))))
|
||||
(deftest
|
||||
"vector->list empty"
|
||||
(assert-equal (list) (vector->list (vector))))
|
||||
(deftest
|
||||
"vector->list numbers"
|
||||
(assert-equal (list 1 2 3) (vector->list (vector 1 2 3))))
|
||||
(deftest
|
||||
"vector->list strings"
|
||||
(assert-equal (list "a" "b") (vector->list (vector "a" "b"))))
|
||||
(deftest
|
||||
"list->vector empty"
|
||||
(let ((v (list->vector (list)))) (assert-equal 0 (vector-length v))))
|
||||
(deftest
|
||||
"list->vector numbers"
|
||||
(let
|
||||
((v (list->vector (list 10 20 30))))
|
||||
(assert-equal 3 (vector-length v))
|
||||
(assert-equal 10 (vector-ref v 0))
|
||||
(assert-equal 20 (vector-ref v 1))
|
||||
(assert-equal 30 (vector-ref v 2))))
|
||||
(deftest
|
||||
"vector-fill! sets all elements"
|
||||
(let
|
||||
((v (vector 1 2 3)))
|
||||
(vector-fill! v 0)
|
||||
(assert-equal 0 (vector-ref v 0))
|
||||
(assert-equal 0 (vector-ref v 1))
|
||||
(assert-equal 0 (vector-ref v 2))))
|
||||
(deftest
|
||||
"vector-fill! returns nil"
|
||||
(assert-equal nil (vector-fill! (make-vector 2 0) 7)))
|
||||
(deftest
|
||||
"vector-fill! string fill"
|
||||
(let
|
||||
((v (make-vector 3 "")))
|
||||
(vector-fill! v "x")
|
||||
(assert-equal "x" (vector-ref v 0))
|
||||
(assert-equal "x" (vector-ref v 2))))
|
||||
(deftest
|
||||
"vector-copy full copy"
|
||||
(let
|
||||
((v1 (vector 1 2 3)) (v2 (vector-copy (vector 1 2 3))))
|
||||
(assert-equal 3 (vector-length v2))
|
||||
(assert-equal 1 (vector-ref v2 0))
|
||||
(assert-equal 2 (vector-ref v2 1))
|
||||
(assert-equal 3 (vector-ref v2 2))))
|
||||
(deftest
|
||||
"vector-copy is independent"
|
||||
(let
|
||||
((v1 (vector 1 2 3)))
|
||||
(let
|
||||
((v2 (vector-copy v1)))
|
||||
(vector-set! v1 0 99)
|
||||
(assert-equal 1 (vector-ref v2 0)))))
|
||||
(deftest
|
||||
"vector-copy with start"
|
||||
(let
|
||||
((v (vector-copy (vector 10 20 30 40) 1)))
|
||||
(assert-equal 3 (vector-length v))
|
||||
(assert-equal 20 (vector-ref v 0))
|
||||
(assert-equal 30 (vector-ref v 1))
|
||||
(assert-equal 40 (vector-ref v 2))))
|
||||
(deftest
|
||||
"vector-copy with start and end"
|
||||
(let
|
||||
((v (vector-copy (vector 10 20 30 40) 1 3)))
|
||||
(assert-equal 2 (vector-length v))
|
||||
(assert-equal 20 (vector-ref v 0))
|
||||
(assert-equal 30 (vector-ref v 1))))
|
||||
(deftest
|
||||
"vector-copy empty slice"
|
||||
(let
|
||||
((v (vector-copy (vector 1 2 3) 1 1)))
|
||||
(assert-equal 0 (vector-length v))))
|
||||
(deftest
|
||||
"vector-ref out of bounds raises"
|
||||
(let
|
||||
((ok false))
|
||||
(guard (exn (else (set! ok true))) (vector-ref (vector 1 2 3) 5))
|
||||
(assert ok)))
|
||||
(deftest
|
||||
"vector-ref negative index raises"
|
||||
(let
|
||||
((ok false))
|
||||
(guard (exn (else (set! ok true))) (vector-ref (vector 1 2 3) -1))
|
||||
(assert ok)))
|
||||
(deftest
|
||||
"vector-set! out of bounds raises"
|
||||
(let
|
||||
((ok false))
|
||||
(guard
|
||||
(exn (else (set! ok true)))
|
||||
(vector-set! (vector 1 2 3) 10 99))
|
||||
(assert ok)))
|
||||
(deftest
|
||||
"vector list round-trip"
|
||||
(let
|
||||
((lst (list 5 10 15 20)))
|
||||
(assert-equal lst (vector->list (list->vector lst)))))
|
||||
(deftest
|
||||
"vector mutation does not affect copy"
|
||||
(let
|
||||
((v1 (vector 1 2 3)))
|
||||
(let
|
||||
((v2 (vector-copy v1)))
|
||||
(vector-set! v2 0 100)
|
||||
(assert-equal 1 (vector-ref v1 0))
|
||||
(assert-equal 100 (vector-ref v2 0)))))
|
||||
(deftest
|
||||
"vector-length after fill"
|
||||
(let
|
||||
((v (make-vector 5 0)))
|
||||
(vector-fill! v 1)
|
||||
(assert-equal 5 (vector-length v)))))
|
||||
@@ -1,195 +1,156 @@
|
||||
;; ==========================================================================
|
||||
;; test.sx — Self-hosting SX test suite (backward-compatible entry point)
|
||||
;;
|
||||
;; This file includes the test framework and core eval tests inline.
|
||||
;; It exists for backward compatibility — runners that load "test.sx"
|
||||
;; get the same 81 tests as before.
|
||||
;;
|
||||
;; For modular testing, runners should instead load:
|
||||
;; 1. test-framework.sx (macros + assertions)
|
||||
;; 2. One or more test specs: test-eval.sx, test-parser.sx,
|
||||
;; test-router.sx, test-render.sx, etc.
|
||||
;;
|
||||
;; Platform functions required:
|
||||
;; try-call (thunk) -> {:ok true} | {:ok false :error "msg"}
|
||||
;; report-pass (name) -> platform-specific pass output
|
||||
;; report-fail (name error) -> platform-specific fail output
|
||||
;; push-suite (name) -> push suite name onto context stack
|
||||
;; pop-suite () -> pop suite name from context stack
|
||||
;;
|
||||
;; Usage:
|
||||
;; ;; Host injects platform functions into env, then:
|
||||
;; (eval-file "test.sx" env)
|
||||
;;
|
||||
;; The same test.sx runs on every host — Python, JavaScript, etc.
|
||||
;; ==========================================================================
|
||||
|
||||
(defmacro
|
||||
deftest
|
||||
(name &rest body)
|
||||
(quasiquote
|
||||
(let
|
||||
((result (try-call (fn () (splice-unquote body)))))
|
||||
(if
|
||||
(get result "ok")
|
||||
(report-pass (unquote name))
|
||||
(report-fail (unquote name) (get result "error"))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 1. Test framework macros
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; deftest and defsuite are macros that make test.sx directly executable.
|
||||
;; The host provides try-call (error catching), reporting, and suite
|
||||
;; context — everything else is pure SX.
|
||||
(defmacro
|
||||
defsuite
|
||||
(name &rest items)
|
||||
(quasiquote
|
||||
(do (push-suite (unquote name)) (splice-unquote items) (pop-suite))))
|
||||
|
||||
(defmacro deftest (name &rest body)
|
||||
`(let ((result (try-call (fn () ,@body))))
|
||||
(if (get result "ok")
|
||||
(report-pass ,name)
|
||||
(report-fail ,name (get result "error")))))
|
||||
|
||||
(defmacro defsuite (name &rest items)
|
||||
`(do (push-suite ,name)
|
||||
,@items
|
||||
(pop-suite)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 2. Assertion helpers — defined in SX, available in test bodies
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; These are regular functions (not special forms). They use the `assert`
|
||||
;; primitive underneath but provide better error messages.
|
||||
|
||||
(define assert-equal
|
||||
(fn (expected actual)
|
||||
(assert (equal? expected actual)
|
||||
(define
|
||||
assert-equal
|
||||
(fn
|
||||
(expected actual)
|
||||
(assert
|
||||
(equal? expected actual)
|
||||
(str "Expected " (str expected) " but got " (str actual)))))
|
||||
|
||||
(define assert-not-equal
|
||||
(fn (a b)
|
||||
(assert (not (equal? a b))
|
||||
(define
|
||||
assert-not-equal
|
||||
(fn
|
||||
(a b)
|
||||
(assert
|
||||
(not (equal? a b))
|
||||
(str "Expected values to differ but both are " (str a)))))
|
||||
|
||||
(define assert-true
|
||||
(fn (val)
|
||||
(assert val (str "Expected truthy but got " (str val)))))
|
||||
(define
|
||||
assert-true
|
||||
(fn (val) (assert val (str "Expected truthy but got " (str val)))))
|
||||
|
||||
(define assert-false
|
||||
(fn (val)
|
||||
(assert (not val) (str "Expected falsy but got " (str val)))))
|
||||
(define
|
||||
assert-false
|
||||
(fn (val) (assert (not val) (str "Expected falsy but got " (str val)))))
|
||||
|
||||
(define assert-nil
|
||||
(fn (val)
|
||||
(assert (nil? val) (str "Expected nil but got " (str val)))))
|
||||
(define
|
||||
assert-nil
|
||||
(fn (val) (assert (nil? val) (str "Expected nil but got " (str val)))))
|
||||
|
||||
(define assert-type
|
||||
(fn (expected-type val)
|
||||
;; Implemented via predicate dispatch since type-of is a platform
|
||||
;; function not available in all hosts. Uses nested if to avoid
|
||||
;; Scheme-style cond detection for 2-element predicate calls.
|
||||
;; Boolean checked before number (subtypes on some platforms).
|
||||
(let ((actual-type
|
||||
(if (nil? val) "nil"
|
||||
(if (boolean? val) "boolean"
|
||||
(if (number? val) "number"
|
||||
(if (string? val) "string"
|
||||
(if (list? val) "list"
|
||||
(if (dict? val) "dict"
|
||||
"unknown"))))))))
|
||||
(assert (= expected-type actual-type)
|
||||
(define
|
||||
assert-type
|
||||
(fn
|
||||
(expected-type val)
|
||||
(let
|
||||
((actual-type (if (nil? val) "nil" (if (boolean? val) "boolean" (if (number? val) "number" (if (string? val) "string" (if (list? val) "list" (if (dict? val) "dict" "unknown"))))))))
|
||||
(assert
|
||||
(= expected-type actual-type)
|
||||
(str "Expected type " expected-type " but got " actual-type)))))
|
||||
|
||||
(define assert-length
|
||||
(fn (expected-len col)
|
||||
(assert (= (len col) expected-len)
|
||||
(define
|
||||
assert-length
|
||||
(fn
|
||||
(expected-len col)
|
||||
(assert
|
||||
(= (len col) expected-len)
|
||||
(str "Expected length " expected-len " but got " (len col)))))
|
||||
|
||||
(define assert-contains
|
||||
(fn (item col)
|
||||
(assert (some (fn (x) (equal? x item)) col)
|
||||
(define
|
||||
assert-contains
|
||||
(fn
|
||||
(item col)
|
||||
(assert
|
||||
(some (fn (x) (equal? x item)) col)
|
||||
(str "Expected collection to contain " (str item)))))
|
||||
|
||||
(define assert-throws
|
||||
(fn (thunk)
|
||||
(let ((result (try-call thunk)))
|
||||
(assert (not (get result "ok"))
|
||||
(define
|
||||
assert-throws
|
||||
(fn
|
||||
(thunk)
|
||||
(let
|
||||
((result (try-call thunk)))
|
||||
(assert
|
||||
(not (get result "ok"))
|
||||
"Expected an error to be thrown but none was"))))
|
||||
|
||||
|
||||
;; ==========================================================================
|
||||
;; 3. Test suites — SX testing SX
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3a. Literals and types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "literals"
|
||||
(deftest "numbers are numbers"
|
||||
(defsuite
|
||||
"literals"
|
||||
(deftest
|
||||
"numbers are numbers"
|
||||
(assert-type "number" 42)
|
||||
(assert-type "number" 3.14)
|
||||
(assert-type "number" -1))
|
||||
|
||||
(deftest "strings are strings"
|
||||
(deftest
|
||||
"strings are strings"
|
||||
(assert-type "string" "hello")
|
||||
(assert-type "string" ""))
|
||||
|
||||
(deftest "booleans are booleans"
|
||||
(deftest
|
||||
"booleans are booleans"
|
||||
(assert-type "boolean" true)
|
||||
(assert-type "boolean" false))
|
||||
|
||||
(deftest "nil is nil"
|
||||
(assert-type "nil" nil)
|
||||
(assert-nil nil))
|
||||
|
||||
(deftest "lists are lists"
|
||||
(deftest "nil is nil" (assert-type "nil" nil) (assert-nil nil))
|
||||
(deftest
|
||||
"lists are lists"
|
||||
(assert-type "list" (list 1 2 3))
|
||||
(assert-type "list" (list)))
|
||||
(deftest "dicts are dicts" (assert-type "dict" {:b 2 :a 1})))
|
||||
|
||||
(deftest "dicts are dicts"
|
||||
(assert-type "dict" {:a 1 :b 2})))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3b. Arithmetic
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "arithmetic"
|
||||
(deftest "addition"
|
||||
(defsuite
|
||||
"arithmetic"
|
||||
(deftest
|
||||
"addition"
|
||||
(assert-equal 3 (+ 1 2))
|
||||
(assert-equal 0 (+ 0 0))
|
||||
(assert-equal -1 (+ 1 -2))
|
||||
(assert-equal 10 (+ 1 2 3 4)))
|
||||
|
||||
(deftest "subtraction"
|
||||
(deftest
|
||||
"subtraction"
|
||||
(assert-equal 1 (- 3 2))
|
||||
(assert-equal -1 (- 2 3)))
|
||||
|
||||
(deftest "multiplication"
|
||||
(deftest
|
||||
"multiplication"
|
||||
(assert-equal 6 (* 2 3))
|
||||
(assert-equal 0 (* 0 100))
|
||||
(assert-equal 24 (* 1 2 3 4)))
|
||||
|
||||
(deftest "division"
|
||||
(deftest
|
||||
"division"
|
||||
(assert-equal 2 (/ 6 3))
|
||||
(assert-equal 2.5 (/ 5 2)))
|
||||
|
||||
(deftest "modulo"
|
||||
(deftest
|
||||
"modulo"
|
||||
(assert-equal 1 (mod 7 3))
|
||||
(assert-equal 0 (mod 6 3))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3c. Comparison
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "comparison"
|
||||
(deftest "equality"
|
||||
(defsuite
|
||||
"comparison"
|
||||
(deftest
|
||||
"equality"
|
||||
(assert-true (= 1 1))
|
||||
(assert-false (= 1 2))
|
||||
(assert-true (= "a" "a"))
|
||||
(assert-false (= "a" "b")))
|
||||
|
||||
(deftest "deep equality"
|
||||
(assert-true (equal? (list 1 2 3) (list 1 2 3)))
|
||||
(assert-false (equal? (list 1 2) (list 1 3)))
|
||||
(deftest
|
||||
"deep equality"
|
||||
(assert-true
|
||||
(equal?
|
||||
(list 1 2 3)
|
||||
(list 1 2 3)))
|
||||
(assert-false
|
||||
(equal? (list 1 2) (list 1 3)))
|
||||
(assert-true (equal? {:a 1} {:a 1}))
|
||||
(assert-false (equal? {:a 1} {:a 2})))
|
||||
|
||||
(deftest "ordering"
|
||||
(deftest
|
||||
"ordering"
|
||||
(assert-true (< 1 2))
|
||||
(assert-false (< 2 1))
|
||||
(assert-true (> 2 1))
|
||||
@@ -198,405 +159,418 @@
|
||||
(assert-true (>= 2 2))
|
||||
(assert-true (>= 3 2))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3d. String operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "strings"
|
||||
(deftest "str concatenation"
|
||||
(defsuite
|
||||
"strings"
|
||||
(deftest
|
||||
"str concatenation"
|
||||
(assert-equal "abc" (str "a" "b" "c"))
|
||||
(assert-equal "hello world" (str "hello" " " "world"))
|
||||
(assert-equal "42" (str 42))
|
||||
(assert-equal "" (str)))
|
||||
|
||||
(deftest "string-length"
|
||||
(deftest
|
||||
"string-length"
|
||||
(assert-equal 5 (string-length "hello"))
|
||||
(assert-equal 0 (string-length "")))
|
||||
|
||||
(deftest "substring"
|
||||
(deftest
|
||||
"substring"
|
||||
(assert-equal "ell" (substring "hello" 1 4))
|
||||
(assert-equal "hello" (substring "hello" 0 5)))
|
||||
|
||||
(deftest "string-contains?"
|
||||
(deftest
|
||||
"string-contains?"
|
||||
(assert-true (string-contains? "hello world" "world"))
|
||||
(assert-false (string-contains? "hello" "xyz")))
|
||||
|
||||
(deftest "upcase and downcase"
|
||||
(deftest
|
||||
"upcase and downcase"
|
||||
(assert-equal "HELLO" (upcase "hello"))
|
||||
(assert-equal "hello" (downcase "HELLO")))
|
||||
|
||||
(deftest "trim"
|
||||
(deftest
|
||||
"trim"
|
||||
(assert-equal "hello" (trim " hello "))
|
||||
(assert-equal "hello" (trim "hello")))
|
||||
|
||||
(deftest "split and join"
|
||||
(deftest
|
||||
"split and join"
|
||||
(assert-equal (list "a" "b" "c") (split "a,b,c" ","))
|
||||
(assert-equal "a-b-c" (join "-" (list "a" "b" "c")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3e. List operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "lists"
|
||||
(deftest "constructors"
|
||||
(assert-equal (list 1 2 3) (list 1 2 3))
|
||||
(defsuite
|
||||
"lists"
|
||||
(deftest
|
||||
"constructors"
|
||||
(assert-equal
|
||||
(list 1 2 3)
|
||||
(list 1 2 3))
|
||||
(assert-equal (list) (list))
|
||||
(assert-length 3 (list 1 2 3)))
|
||||
|
||||
(deftest "first and rest"
|
||||
(deftest
|
||||
"first and rest"
|
||||
(assert-equal 1 (first (list 1 2 3)))
|
||||
(assert-equal (list 2 3) (rest (list 1 2 3)))
|
||||
(assert-equal
|
||||
(list 2 3)
|
||||
(rest (list 1 2 3)))
|
||||
(assert-nil (first (list)))
|
||||
(assert-equal (list) (rest (list))))
|
||||
|
||||
(deftest "nth"
|
||||
(assert-equal 1 (nth (list 1 2 3) 0))
|
||||
(assert-equal 2 (nth (list 1 2 3) 1))
|
||||
(assert-equal 3 (nth (list 1 2 3) 2)))
|
||||
|
||||
(deftest "last"
|
||||
(deftest
|
||||
"nth"
|
||||
(assert-equal
|
||||
1
|
||||
(nth (list 1 2 3) 0))
|
||||
(assert-equal
|
||||
2
|
||||
(nth (list 1 2 3) 1))
|
||||
(assert-equal
|
||||
3
|
||||
(nth (list 1 2 3) 2)))
|
||||
(deftest
|
||||
"last"
|
||||
(assert-equal 3 (last (list 1 2 3)))
|
||||
(assert-nil (last (list))))
|
||||
|
||||
(deftest "cons and append"
|
||||
(assert-equal (list 0 1 2) (cons 0 (list 1 2)))
|
||||
(assert-equal (list 1 2 3 4) (append (list 1 2) (list 3 4))))
|
||||
|
||||
(deftest "reverse"
|
||||
(assert-equal (list 3 2 1) (reverse (list 1 2 3)))
|
||||
(deftest
|
||||
"cons and append"
|
||||
(assert-equal
|
||||
(list 0 1 2)
|
||||
(cons 0 (list 1 2)))
|
||||
(assert-equal
|
||||
(list 1 2 3 4)
|
||||
(append (list 1 2) (list 3 4))))
|
||||
(deftest
|
||||
"reverse"
|
||||
(assert-equal
|
||||
(list 3 2 1)
|
||||
(reverse (list 1 2 3)))
|
||||
(assert-equal (list) (reverse (list))))
|
||||
|
||||
(deftest "empty?"
|
||||
(deftest
|
||||
"empty?"
|
||||
(assert-true (empty? (list)))
|
||||
(assert-false (empty? (list 1))))
|
||||
|
||||
(deftest "len"
|
||||
(deftest
|
||||
"len"
|
||||
(assert-equal 0 (len (list)))
|
||||
(assert-equal 3 (len (list 1 2 3))))
|
||||
(deftest
|
||||
"contains?"
|
||||
(assert-true
|
||||
(contains? (list 1 2 3) 2))
|
||||
(assert-false
|
||||
(contains? (list 1 2 3) 4)))
|
||||
(deftest
|
||||
"flatten"
|
||||
(assert-equal
|
||||
(list 1 2 3 4)
|
||||
(flatten
|
||||
(list (list 1 2) (list 3 4))))))
|
||||
|
||||
(deftest "contains?"
|
||||
(assert-true (contains? (list 1 2 3) 2))
|
||||
(assert-false (contains? (list 1 2 3) 4)))
|
||||
|
||||
(deftest "flatten"
|
||||
(assert-equal (list 1 2 3 4) (flatten (list (list 1 2) (list 3 4))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3f. Dict operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "dicts"
|
||||
(deftest "dict literal"
|
||||
(assert-type "dict" {:a 1 :b 2})
|
||||
(defsuite
|
||||
"dicts"
|
||||
(deftest
|
||||
"dict literal"
|
||||
(assert-type "dict" {:b 2 :a 1})
|
||||
(assert-equal 1 (get {:a 1} "a"))
|
||||
(assert-equal 2 (get {:a 1 :b 2} "b")))
|
||||
|
||||
(deftest "assoc"
|
||||
(assert-equal {:a 1 :b 2} (assoc {:a 1} "b" 2))
|
||||
(assert-equal 2 (get {:b 2 :a 1} "b")))
|
||||
(deftest
|
||||
"assoc"
|
||||
(assert-equal {:b 2 :a 1} (assoc {:a 1} "b" 2))
|
||||
(assert-equal {:a 99} (assoc {:a 1} "a" 99)))
|
||||
|
||||
(deftest "dissoc"
|
||||
(assert-equal {:b 2} (dissoc {:a 1 :b 2} "a")))
|
||||
|
||||
(deftest "keys and vals"
|
||||
(let ((d {:a 1 :b 2}))
|
||||
(deftest "dissoc" (assert-equal {:b 2} (dissoc {:b 2 :a 1} "a")))
|
||||
(deftest
|
||||
"keys and vals"
|
||||
(let
|
||||
((d {:b 2 :a 1}))
|
||||
(assert-length 2 (keys d))
|
||||
(assert-length 2 (vals d))
|
||||
(assert-contains "a" (keys d))
|
||||
(assert-contains "b" (keys d))))
|
||||
|
||||
(deftest "has-key?"
|
||||
(deftest
|
||||
"has-key?"
|
||||
(assert-true (has-key? {:a 1} "a"))
|
||||
(assert-false (has-key? {:a 1} "b")))
|
||||
(deftest
|
||||
"merge"
|
||||
(assert-equal {:c 3 :b 2 :a 1} (merge {:b 2 :a 1} {:c 3}))
|
||||
(assert-equal {:b 2 :a 99} (merge {:b 2 :a 1} {:a 99}))))
|
||||
|
||||
(deftest "merge"
|
||||
(assert-equal {:a 1 :b 2 :c 3}
|
||||
(merge {:a 1 :b 2} {:c 3}))
|
||||
(assert-equal {:a 99 :b 2}
|
||||
(merge {:a 1 :b 2} {:a 99}))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3g. Predicates
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "predicates"
|
||||
(deftest "nil?"
|
||||
(defsuite
|
||||
"predicates"
|
||||
(deftest
|
||||
"nil?"
|
||||
(assert-true (nil? nil))
|
||||
(assert-false (nil? 0))
|
||||
(assert-false (nil? false))
|
||||
(assert-false (nil? "")))
|
||||
|
||||
(deftest "number?"
|
||||
(deftest
|
||||
"number?"
|
||||
(assert-true (number? 42))
|
||||
(assert-true (number? 3.14))
|
||||
(assert-false (number? "42")))
|
||||
|
||||
(deftest "string?"
|
||||
(deftest
|
||||
"string?"
|
||||
(assert-true (string? "hello"))
|
||||
(assert-false (string? 42)))
|
||||
|
||||
(deftest "list?"
|
||||
(deftest
|
||||
"list?"
|
||||
(assert-true (list? (list 1 2)))
|
||||
(assert-false (list? "not a list")))
|
||||
|
||||
(deftest "dict?"
|
||||
(deftest
|
||||
"dict?"
|
||||
(assert-true (dict? {:a 1}))
|
||||
(assert-false (dict? (list 1))))
|
||||
|
||||
(deftest "boolean?"
|
||||
(deftest
|
||||
"boolean?"
|
||||
(assert-true (boolean? true))
|
||||
(assert-true (boolean? false))
|
||||
(assert-false (boolean? nil))
|
||||
(assert-false (boolean? 0)))
|
||||
|
||||
(deftest "not"
|
||||
(deftest
|
||||
"not"
|
||||
(assert-true (not false))
|
||||
(assert-true (not nil))
|
||||
(assert-false (not true))
|
||||
(assert-false (not 1))
|
||||
(assert-false (not "x"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3h. Special forms
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "special-forms"
|
||||
(deftest "if"
|
||||
(defsuite
|
||||
"special-forms"
|
||||
(deftest
|
||||
"if"
|
||||
(assert-equal "yes" (if true "yes" "no"))
|
||||
(assert-equal "no" (if false "yes" "no"))
|
||||
(assert-equal "no" (if nil "yes" "no"))
|
||||
(assert-nil (if false "yes")))
|
||||
|
||||
(deftest "when"
|
||||
(deftest
|
||||
"when"
|
||||
(assert-equal "yes" (when true "yes"))
|
||||
(assert-nil (when false "yes")))
|
||||
|
||||
(deftest "cond"
|
||||
(deftest
|
||||
"cond"
|
||||
(assert-equal "a" (cond true "a" :else "b"))
|
||||
(assert-equal "b" (cond false "a" :else "b"))
|
||||
(assert-equal "c" (cond
|
||||
false "a"
|
||||
false "b"
|
||||
:else "c")))
|
||||
|
||||
(deftest "and"
|
||||
(assert-equal "c" (cond false "a" false "b" :else "c")))
|
||||
(deftest
|
||||
"and"
|
||||
(assert-true (and true true))
|
||||
(assert-false (and true false))
|
||||
(assert-false (and false true))
|
||||
(assert-equal 3 (and 1 2 3)))
|
||||
|
||||
(deftest "or"
|
||||
(deftest
|
||||
"or"
|
||||
(assert-equal 1 (or 1 2))
|
||||
(assert-equal 2 (or false 2))
|
||||
(assert-equal "fallback" (or nil false "fallback"))
|
||||
(assert-false (or false false)))
|
||||
|
||||
(deftest "let"
|
||||
(assert-equal 3 (let ((x 1) (y 2)) (+ x y)))
|
||||
(assert-equal "hello world"
|
||||
(deftest
|
||||
"let"
|
||||
(assert-equal
|
||||
3
|
||||
(let ((x 1) (y 2)) (+ x y)))
|
||||
(assert-equal
|
||||
"hello world"
|
||||
(let ((a "hello") (b " world")) (str a b))))
|
||||
|
||||
(deftest "let clojure-style"
|
||||
(deftest
|
||||
"let clojure-style"
|
||||
(assert-equal 3 (let (x 1 y 2) (+ x y))))
|
||||
|
||||
(deftest "do / begin"
|
||||
(deftest
|
||||
"do / begin"
|
||||
(assert-equal 3 (do 1 2 3))
|
||||
(assert-equal "last" (begin "first" "middle" "last")))
|
||||
|
||||
(deftest "define"
|
||||
(define x 42)
|
||||
(assert-equal 42 x))
|
||||
|
||||
(deftest "set!"
|
||||
(deftest "define" (define x 42) (assert-equal 42 x))
|
||||
(deftest
|
||||
"set!"
|
||||
(define x 1)
|
||||
(set! x 2)
|
||||
(assert-equal 2 x)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3i. Lambda and closures
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "lambdas"
|
||||
(deftest "basic lambda"
|
||||
(let ((add (fn (a b) (+ a b))))
|
||||
(defsuite
|
||||
"lambdas"
|
||||
(deftest
|
||||
"basic lambda"
|
||||
(let
|
||||
((add (fn (a b) (+ a b))))
|
||||
(assert-equal 3 (add 1 2))))
|
||||
|
||||
(deftest "closure captures env"
|
||||
(let ((x 10))
|
||||
(let ((add-x (fn (y) (+ x y))))
|
||||
(deftest
|
||||
"closure captures env"
|
||||
(let
|
||||
((x 10))
|
||||
(let
|
||||
((add-x (fn (y) (+ x y))))
|
||||
(assert-equal 15 (add-x 5)))))
|
||||
|
||||
(deftest "lambda as argument"
|
||||
(assert-equal (list 2 4 6)
|
||||
(map (fn (x) (* x 2)) (list 1 2 3))))
|
||||
|
||||
(deftest "recursive lambda via define"
|
||||
(define factorial
|
||||
(fn (n) (if (<= n 1) 1 (* n (factorial (- n 1))))))
|
||||
(deftest
|
||||
"lambda as argument"
|
||||
(assert-equal
|
||||
(list 2 4 6)
|
||||
(map
|
||||
(fn (x) (* x 2))
|
||||
(list 1 2 3))))
|
||||
(deftest
|
||||
"recursive lambda via define"
|
||||
(define
|
||||
factorial
|
||||
(fn
|
||||
(n)
|
||||
(if
|
||||
(<= n 1)
|
||||
1
|
||||
(* n (factorial (- n 1))))))
|
||||
(assert-equal 120 (factorial 5)))
|
||||
|
||||
(deftest "higher-order returns lambda"
|
||||
(let ((make-adder (fn (n) (fn (x) (+ n x)))))
|
||||
(let ((add5 (make-adder 5)))
|
||||
(deftest
|
||||
"higher-order returns lambda"
|
||||
(let
|
||||
((make-adder (fn (n) (fn (x) (+ n x)))))
|
||||
(let
|
||||
((add5 (make-adder 5)))
|
||||
(assert-equal 8 (add5 3))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3j. Higher-order forms
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "higher-order"
|
||||
(deftest "map"
|
||||
(assert-equal (list 2 4 6)
|
||||
(map (fn (x) (* x 2)) (list 1 2 3)))
|
||||
(defsuite
|
||||
"higher-order"
|
||||
(deftest
|
||||
"map"
|
||||
(assert-equal
|
||||
(list 2 4 6)
|
||||
(map
|
||||
(fn (x) (* x 2))
|
||||
(list 1 2 3)))
|
||||
(assert-equal (list) (map (fn (x) x) (list))))
|
||||
|
||||
(deftest "filter"
|
||||
(assert-equal (list 2 4)
|
||||
(filter (fn (x) (= (mod x 2) 0)) (list 1 2 3 4)))
|
||||
(assert-equal (list)
|
||||
(deftest
|
||||
"filter"
|
||||
(assert-equal
|
||||
(list 2 4)
|
||||
(filter
|
||||
(fn (x) (= (mod x 2) 0))
|
||||
(list 1 2 3 4)))
|
||||
(assert-equal
|
||||
(list)
|
||||
(filter (fn (x) false) (list 1 2 3))))
|
||||
|
||||
(deftest "reduce"
|
||||
(assert-equal 10 (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4)))
|
||||
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list))))
|
||||
|
||||
(deftest "some"
|
||||
(assert-true (some (fn (x) (> x 3)) (list 1 2 3 4 5)))
|
||||
(assert-false (some (fn (x) (> x 10)) (list 1 2 3))))
|
||||
|
||||
(deftest "every?"
|
||||
(assert-true (every? (fn (x) (> x 0)) (list 1 2 3)))
|
||||
(assert-false (every? (fn (x) (> x 2)) (list 1 2 3))))
|
||||
|
||||
(deftest "map-indexed"
|
||||
(assert-equal (list "0:a" "1:b" "2:c")
|
||||
(deftest
|
||||
"reduce"
|
||||
(assert-equal
|
||||
10
|
||||
(reduce
|
||||
(fn (acc x) (+ acc x))
|
||||
0
|
||||
(list 1 2 3 4)))
|
||||
(assert-equal
|
||||
0
|
||||
(reduce (fn (acc x) (+ acc x)) 0 (list))))
|
||||
(deftest
|
||||
"some"
|
||||
(assert-true
|
||||
(some
|
||||
(fn (x) (> x 3))
|
||||
(list 1 2 3 4 5)))
|
||||
(assert-false
|
||||
(some
|
||||
(fn (x) (> x 10))
|
||||
(list 1 2 3))))
|
||||
(deftest
|
||||
"every?"
|
||||
(assert-true
|
||||
(every?
|
||||
(fn (x) (> x 0))
|
||||
(list 1 2 3)))
|
||||
(assert-false
|
||||
(every?
|
||||
(fn (x) (> x 2))
|
||||
(list 1 2 3))))
|
||||
(deftest
|
||||
"map-indexed"
|
||||
(assert-equal
|
||||
(list "0:a" "1:b" "2:c")
|
||||
(map-indexed (fn (i x) (str i ":" x)) (list "a" "b" "c")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3k. Components
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "components"
|
||||
(deftest "defcomp creates component"
|
||||
(defcomp ~test-comp (&key title)
|
||||
(div title))
|
||||
;; Component is bound and not nil
|
||||
(defsuite
|
||||
"components"
|
||||
(deftest
|
||||
"defcomp creates component"
|
||||
(defcomp ~test-comp (&key title) (div title))
|
||||
(assert-true (not (nil? ~test-comp))))
|
||||
|
||||
(deftest "component renders with keyword args"
|
||||
(defcomp ~greeting (&key name)
|
||||
(span (str "Hello, " name "!")))
|
||||
(deftest
|
||||
"component renders with keyword args"
|
||||
(defcomp ~greeting (&key name) (span (str "Hello, " name "!")))
|
||||
(assert-true (not (nil? ~greeting))))
|
||||
|
||||
(deftest "component with children"
|
||||
(defcomp ~box (&key &rest children)
|
||||
(div :class "box" children))
|
||||
(deftest
|
||||
"component with children"
|
||||
(defcomp ~box (&key &rest children) (div :class "box" children))
|
||||
(assert-true (not (nil? ~box))))
|
||||
|
||||
(deftest "component with default via or"
|
||||
(defcomp ~label (&key text)
|
||||
(span (or text "default")))
|
||||
(deftest
|
||||
"component with default via or"
|
||||
(defcomp ~label (&key text) (span (or text "default")))
|
||||
(assert-true (not (nil? ~label)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3l. Macros
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "macros"
|
||||
(deftest "defmacro creates macro"
|
||||
(defmacro unless (cond &rest body)
|
||||
`(if (not ,cond) (do ,@body)))
|
||||
(defsuite
|
||||
"macros"
|
||||
(deftest
|
||||
"defmacro creates macro"
|
||||
(defmacro
|
||||
unless
|
||||
(cond &rest body)
|
||||
(quasiquote (if (not (unquote cond)) (do (splice-unquote body)))))
|
||||
(assert-equal "yes" (unless false "yes"))
|
||||
(assert-nil (unless true "no")))
|
||||
(deftest
|
||||
"quasiquote and unquote"
|
||||
(let
|
||||
((x 42))
|
||||
(assert-equal
|
||||
(list 1 42 3)
|
||||
(quasiquote (1 (unquote x) 3)))))
|
||||
(deftest
|
||||
"splice-unquote"
|
||||
(let
|
||||
((xs (list 2 3 4)))
|
||||
(assert-equal
|
||||
(list 1 2 3 4 5)
|
||||
(quasiquote (1 (splice-unquote xs) 5))))))
|
||||
|
||||
(deftest "quasiquote and unquote"
|
||||
(let ((x 42))
|
||||
(assert-equal (list 1 42 3) `(1 ,x 3))))
|
||||
|
||||
(deftest "splice-unquote"
|
||||
(let ((xs (list 2 3 4)))
|
||||
(assert-equal (list 1 2 3 4 5) `(1 ,@xs 5)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3m. Threading macro
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "threading"
|
||||
(deftest "thread-first"
|
||||
(defsuite
|
||||
"threading"
|
||||
(deftest
|
||||
"thread-first"
|
||||
(assert-equal 8 (-> 5 (+ 1) (+ 2)))
|
||||
(assert-equal "HELLO" (-> "hello" upcase))
|
||||
(assert-equal "HELLO WORLD"
|
||||
(-> "hello"
|
||||
(str " world")
|
||||
upcase))))
|
||||
(assert-equal "HELLO WORLD" (-> "hello" (str " world") upcase))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3n. Truthiness
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "truthiness"
|
||||
(deftest "truthy values"
|
||||
(defsuite
|
||||
"truthiness"
|
||||
(deftest
|
||||
"truthy values"
|
||||
(assert-true (if 1 true false))
|
||||
(assert-true (if "x" true false))
|
||||
(assert-true (if (list 1) true false))
|
||||
(assert-true (if true true false)))
|
||||
|
||||
(deftest "falsy values"
|
||||
(deftest
|
||||
"falsy values"
|
||||
(assert-false (if false true false))
|
||||
(assert-false (if nil true false)))
|
||||
(assert-false (if nil true false))))
|
||||
|
||||
;; NOTE: empty list, zero, and empty string truthiness is
|
||||
;; platform-dependent. Python treats all three as falsy.
|
||||
;; JavaScript treats [] as truthy but 0 and "" as falsy.
|
||||
;; These tests are omitted — each bootstrapper should emit
|
||||
;; platform-specific truthiness tests instead.
|
||||
)
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3o. Edge cases and regression tests
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "edge-cases"
|
||||
(deftest "nested let scoping"
|
||||
(let ((x 1))
|
||||
(let ((x 2))
|
||||
(assert-equal 2 x))
|
||||
;; outer x should be unchanged by inner let
|
||||
;; (this tests that let creates a new scope)
|
||||
))
|
||||
|
||||
(deftest "recursive map"
|
||||
(assert-equal (list (list 2 4) (list 6 8))
|
||||
(map (fn (sub) (map (fn (x) (* x 2)) sub))
|
||||
(list (list 1 2) (list 3 4)))))
|
||||
|
||||
(deftest "keyword as value"
|
||||
(defsuite
|
||||
"edge-cases"
|
||||
(deftest
|
||||
"nested let scoping"
|
||||
(let
|
||||
((x 1))
|
||||
(let ((x 2)) (assert-equal 2 x))))
|
||||
(deftest
|
||||
"recursive map"
|
||||
(assert-equal
|
||||
(list (list 2 4) (list 6 8))
|
||||
(map
|
||||
(fn (sub) (map (fn (x) (* x 2)) sub))
|
||||
(list (list 1 2) (list 3 4)))))
|
||||
(deftest
|
||||
"keyword as value"
|
||||
(assert-equal "class" :class)
|
||||
(assert-equal "id" :id))
|
||||
|
||||
(deftest "dict with evaluated values"
|
||||
(let ((x 42))
|
||||
(assert-equal 42 (get {:val x} "val"))))
|
||||
|
||||
(deftest "nil propagation"
|
||||
(deftest
|
||||
"dict with evaluated values"
|
||||
(let ((x 42)) (assert-equal 42 (get {:val x} "val"))))
|
||||
(deftest
|
||||
"nil propagation"
|
||||
(assert-nil (get {:a 1} "missing"))
|
||||
(assert-equal "default" (or (get {:a 1} "missing") "default")))
|
||||
|
||||
(deftest "empty operations"
|
||||
(deftest
|
||||
"empty operations"
|
||||
(assert-equal (list) (map (fn (x) x) (list)))
|
||||
(assert-equal (list) (filter (fn (x) true) (list)))
|
||||
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list)))
|
||||
(assert-equal
|
||||
0
|
||||
(reduce (fn (acc x) (+ acc x)) 0 (list)))
|
||||
(assert-equal 0 (len (list)))
|
||||
(assert-equal "" (str))))
|
||||
|
||||
Reference in New Issue
Block a user