JVM-semantics fixes and small cleanups
- take-last / drop-last return seqs, not vectors: take-last wraps in seq; drop-last is the JVM (map (fn [x _] x) coll (drop n coll)) form (lazy, () when empty). - cycle is lazy ((lazy-seq (concat coll (cycle coll)))) so it no longer counts its argument and terminates on a lazy/infinite input. - fold's foldable-call catch uses :default, matching the rest of jolt-core and also catching a raw host condition from a folding primitive. - alts! rejects non-channel ports with a clear error (put specs / :default are unsupported) instead of crashing inside ac-poll!. - Misc: drop the unreachable second getCause clause; jolt-nth on a string raises 'nth "index out of bounds" like the vector branch; name the inline fixpoint cap; bld-sh-capture rejoins lines with newlines; clarify a couple of comments.
This commit is contained in:
parent
524d4cd8d1
commit
14547bd1d5
11 changed files with 642 additions and 616 deletions
|
|
@ -152,11 +152,19 @@
|
|||
(else ac-poll-empty))))
|
||||
|
||||
;; (alts! [ch ...]) — take from whichever channel is ready first; returns
|
||||
;; [value channel] (value nil if that channel closed). Take-only.
|
||||
;; [value channel] (value nil if that channel closed). Take-only: every port must
|
||||
;; be a channel — put specs [ch val] and the :default option are not supported, so
|
||||
;; reject them with a clear error instead of crashing inside ac-poll!.
|
||||
;; Polls with a 1ms backoff — no cross-channel wait-set yet.
|
||||
(define ac-1ms (make-time 'time-duration 1000000 0))
|
||||
(define (jolt-async-alts chans)
|
||||
(let ((cs (seq->list (jolt-seq chans))))
|
||||
(for-each (lambda (c)
|
||||
(unless (async-chan? c)
|
||||
(jolt-throw (jolt-ex-info
|
||||
"alts! supports channel ports only (put specs [ch val] and :default are not supported)"
|
||||
(jolt-hash-map)))))
|
||||
cs)
|
||||
(let loop ()
|
||||
(let try ((rest cs))
|
||||
(if (null? rest)
|
||||
|
|
|
|||
|
|
@ -27,9 +27,12 @@
|
|||
(let ((l (get-line in)))
|
||||
(if (eof-object? l)
|
||||
(begin (close-port in)
|
||||
(let ((s (apply string-append (reverse acc))))
|
||||
;; trim a trailing newline-equivalent (we joined without them)
|
||||
s))
|
||||
;; rejoin with newlines (get-line stripped them). Callers use
|
||||
;; single-line output; this just avoids silently concatenating
|
||||
;; two lines into one corrupt token if a command emits more.
|
||||
(let ((ls (reverse acc)))
|
||||
(if (null? ls) ""
|
||||
(fold-left (lambda (s x) (string-append s "\n" x)) (car ls) (cdr ls)))))
|
||||
(loop (cons l acc)))))))
|
||||
|
||||
(define (bld-system cmd)
|
||||
|
|
|
|||
|
|
@ -243,7 +243,8 @@
|
|||
(cond ((pvec? coll) (let ((v (pvec-v coll)))
|
||||
(if (and (fx>=? i 0) (fx<? i (vector-length v))) (vector-ref v i)
|
||||
(error 'nth "index out of bounds"))))
|
||||
((string? coll) (string-ref coll i))
|
||||
((string? coll) (if (and (fx>=? i 0) (fx<? i (string-length coll))) (string-ref coll i)
|
||||
(error 'nth "index out of bounds")))
|
||||
((or (cseq? coll) (empty-list-t? coll)) (seq-nth coll i #f jolt-nil))
|
||||
(else (error 'nth "unsupported collection")))))
|
||||
((coll i d)
|
||||
|
|
|
|||
|
|
@ -174,7 +174,9 @@
|
|||
(keyword #f "name") (jolt-symbol jolt-nil name-str)
|
||||
(keyword #f "methods") methods))
|
||||
|
||||
;; register-protocol-methods!: a no-op for Chez dispatch.
|
||||
;; register-protocol-methods!: intentional no-op. Chez dispatches a protocol method
|
||||
;; by the receiver's type tag at call time, so there is no method table to register;
|
||||
;; this binding exists only because defprotocol-emitted code calls it.
|
||||
(define (register-protocol-methods! proto-name method-names) jolt-nil)
|
||||
|
||||
;; register-method: extend-type/extend register an impl. Host type names keep a
|
||||
|
|
@ -329,7 +331,7 @@
|
|||
((string=? method-name "toString") (condition->message-string obj))
|
||||
((string=? method-name "getCause") jolt-nil)
|
||||
;; java.sql.SQLException chaining — jolt errors don't chain (nil).
|
||||
((or (string=? method-name "getNextException") (string=? method-name "getCause")) jolt-nil)
|
||||
((string=? method-name "getNextException") jolt-nil)
|
||||
((string=? method-name "getStackTrace") (jolt-vector))
|
||||
((string=? method-name "printStackTrace") jolt-nil)
|
||||
(else (error #f (string-append "No method " method-name " on Throwable")))))
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
Loading…
Add table
Add a link
Reference in a new issue