giles
1ad8e74aa6
Type predicates, arithmetic, chars (inline α/digit/case), format, gensym, values, sets, radix, list utilities. cl-empty? guards all list traversal against () vs nil in sx_server. Load spec/stdlib.sx in test.sh to expose format. Fix lib/r7rs.sx number->string to use (= (len r) 0) not (nil? r). 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 (= (len r) 0) (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))
|