giles
4d7b3e299c
28 tests, passes on both JS and OCaml. - spec/stdlib.sx: pure SX format function - spec/primitives.sx: format primitive declaration - lib/r7rs.sx: fix number->string to support optional radix arg - hosts/ocaml: add format-decimal primitive, load stdlib.sx in test runner - hosts/javascript: load stdlib.sx in test runner Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
90 lines
1.8 KiB
Plaintext
90 lines
1.8 KiB
Plaintext
|
|
|
|
(define-library (sx r7rs)
|
|
(export
|
|
make-error-object
|
|
error-object?
|
|
error-message
|
|
error-object-irritants
|
|
with-exception-handler
|
|
car
|
|
cdr
|
|
cadr
|
|
cddr
|
|
caar
|
|
cdar
|
|
caddr
|
|
cadddr
|
|
null?
|
|
pair?
|
|
procedure?
|
|
boolean=?
|
|
symbol->string
|
|
string->symbol
|
|
number->string
|
|
string->number)
|
|
(begin
|
|
|
|
(define make-error-object (fn (message irritants) {:irritants irritants :type "error-object" :message message}))
|
|
|
|
(define
|
|
error-object?
|
|
(fn (x) (and (dict? x) (= (get x "type") "error-object"))))
|
|
|
|
(define
|
|
error-message
|
|
(fn (x) (if (error-object? x) (get x "message") (str x))))
|
|
|
|
(define
|
|
error-object-irritants
|
|
(fn (x) (if (error-object? x) (get x "irritants") (list))))
|
|
|
|
(defmacro
|
|
with-exception-handler
|
|
(handler thunk)
|
|
(quasiquote
|
|
(handler-bind (((fn (c) true) (unquote handler))) ((unquote thunk)))))
|
|
|
|
(define car first)
|
|
|
|
(define cdr rest)
|
|
|
|
(define cadr (fn (x) (first (rest x))))
|
|
|
|
(define cddr (fn (x) (rest (rest x))))
|
|
|
|
(define caar (fn (x) (first (first x))))
|
|
|
|
(define cdar (fn (x) (rest (first x))))
|
|
|
|
(define caddr (fn (x) (first (rest (rest x)))))
|
|
|
|
(define cadddr (fn (x) (first (rest (rest (rest x))))))
|
|
|
|
(define null? (fn (x) (or (nil? x) (and (list? x) (empty? x)))))
|
|
|
|
(define pair? (fn (x) (and (list? x) (not (empty? x)))))
|
|
|
|
(define procedure? (fn (x) (or (lambda? x) (callable? x))))
|
|
|
|
(define boolean=? (fn (a b) (= a b)))
|
|
|
|
(define symbol->string symbol-name)
|
|
|
|
(define string->symbol make-symbol)
|
|
|
|
(define number->string
|
|
(let ((prim-n->s number->string))
|
|
(fn (n &rest r)
|
|
(if (nil? r) (str n) (prim-n->s n (first r))))))
|
|
|
|
(define
|
|
string->number
|
|
(fn (s) (if (string-contains? s ".") (parse-float s) (parse-int s))))
|
|
|
|
|
|
)) ;; end define-library
|
|
|
|
;; Re-export to global namespace for backward compatibility
|
|
(import (sx r7rs))
|