diff --git a/host/chez/host-static.ss b/host/chez/host-static.ss index 95e0937..a1dde7b 100644 --- a/host/chez/host-static.ss +++ b/host/chez/host-static.ss @@ -294,6 +294,20 @@ (cons "close" (lambda (self) jolt-nil)) (cons "toString" (lambda (self) (sb-str self))))) +;; a file-backed writer (clojure.java.io/writer of a File/path): accumulates like +;; StringWriter, then persists to the path on flush/close, so +;; (with-open [w (io/writer "f")] (.write w …)) writes the file. State #(path buf). +(define (fw-path self) (vector-ref (jhost-state self) 0)) +(define (fw-buf self) (vector-ref (jhost-state self) 1)) +(define (fw-append! self s) (vector-set! (jhost-state self) 1 (string-append (fw-buf self) s))) +(define (fw-flush! self) (jolt-spit (fw-path self) (fw-buf self))) ; jolt-spit: io.ss +(register-host-methods! "file-writer" + (list (cons "write" (lambda (self x) (fw-append! self (writer-piece x)) jolt-nil)) + (cons "append" (lambda (self x) (fw-append! self (render-piece x)) self)) + (cons "flush" (lambda (self) (fw-flush! self) jolt-nil)) + (cons "close" (lambda (self) (fw-flush! self) jolt-nil)) + (cons "toString" (lambda (self) (fw-buf self))))) + ;; ---- StringReader ----------------------------------------------------------- ;; state: a vector #(string pos marked). (register-class-ctor! "StringReader" @@ -310,6 +324,19 @@ (cons "reset" (lambda (self) (sr-pos! self (vector-ref (jhost-state self) 2)) jolt-nil)) (cons "skip" (lambda (self n) (let ((n (jnum->exact n))) (sr-pos! self (min (string-length (sr-s self)) (+ (sr-pos self) n))) (->num n)))) + ;; readLine: the next line without its terminator (\n or \r\n), nil at EOF — + ;; what line-seq drives over a BufferedReader. + (cons "readLine" + (lambda (self) + (let ((s (sr-s self)) (p (sr-pos self)) (len (string-length (sr-s self)))) + (if (>= p len) jolt-nil + (let scan ((i p)) + (cond + ((>= i len) (sr-pos! self len) (substring s p len)) + ((char=? (string-ref s i) #\newline) + (sr-pos! self (+ i 1)) + (substring s p (if (and (> i p) (char=? (string-ref s (- i 1)) #\return)) (- i 1) i))) + (else (scan (+ i 1))))))))) (cons "close" (lambda (self) jolt-nil)))) ;; ---- PushbackReader --------------------------------------------------------- diff --git a/host/chez/io.ss b/host/chez/io.ss index 5ad274d..2367099 100644 --- a/host/chez/io.ss +++ b/host/chez/io.ss @@ -245,9 +245,22 @@ (host-new "StringReader" (seq-source->string x))) (else (host-new "StringReader" (jolt-str-render-one x))))) +;; --- clojure.java.io/writer: an existing writer passes through; a File / path +;; gets a file-backed writer (host-static.ss "file-writer") that persists on +;; flush/close. Mirrors io.clj's writer over the host's StringWriter/file ports. +(define (jolt-io-writer x) + (cond + ((and (jhost? x) (string=? (jhost-tag x) "writer")) x) + ((and (jhost? x) (string=? (jhost-tag x) "file-writer")) x) + ((jfile? x) (make-jhost "file-writer" (vector (jfile-path x) ""))) + ((string? x) (make-jhost "file-writer" (vector x ""))) + (else (error #f "io/writer: don't know how to create a writer from" x)))) + ;; --- clojure.java.io ns ----------------------------------------------------- (def-var! "clojure.java.io" "file" jolt-make-file) (def-var! "clojure.java.io" "as-file" (lambda (x) (if (jfile? x) x (make-jfile (file-path-of x))))) (def-var! "clojure.java.io" "reader" jolt-io-reader) +(def-var! "clojure.java.io" "writer" jolt-io-writer) (def-var! "clojure.java.io" "input-stream" jolt-io-reader) +(def-var! "clojure.java.io" "output-stream" jolt-io-writer) (def-var! "clojure.java.io" "as-url" (lambda (x) (if (and (jhost? x) (string=? (jhost-tag x) "url")) x (make-url (jolt-str-render-one x))))) diff --git a/host/chez/loader.ss b/host/chez/loader.ss index 7f7cad2..7fb9cb9 100644 --- a/host/chez/loader.ss +++ b/host/chez/loader.ss @@ -57,12 +57,21 @@ ;; Read every form from a file and compile+eval it in turn. The first form is ;; normally (ns …), which expands to (in-ns …) and switches the current ns, so ;; later forms compile in that namespace — (chez-current-ns) is re-read each step. +;; +;; Reads by POSITION rather than via __parse-next: a top-level form that reads as +;; nothing — a :cljs-only #? with no matching branch, a #_ discard, a trailing +;; comment — yields rdr-eof but still advances. parse-next collapses that to "no +;; more forms", which would silently drop the entire rest of the file; here we +;; skip the no-op form and continue to true end-of-string. (define (load-jolt-file path) - (let loop ((src (read-file-string path))) - (let ((pn (jolt-parse-next src))) - (unless (jolt-nil? pn) - (jolt-compile-eval-form (jolt-nth pn 0) (chez-current-ns)) - (loop (jolt-nth pn 1)))))) + (let* ((src (read-file-string path)) (end (string-length src))) + (let loop ((i 0)) + (when (< i end) + (let-values (((form j) (rdr-read-form src i end))) + (when (> j i) + (unless (rdr-eof? form) + (jolt-compile-eval-form form (chez-current-ns))) + (loop j))))))) ;; load-namespace: load `name`'s source once. Marked loaded BEFORE eval so a ;; dependency cycle terminates (Clojure's behavior). The caller's current ns is diff --git a/host/chez/reader.ss b/host/chez/reader.ss index 3fa26bd..6de5442 100644 --- a/host/chez/reader.ss +++ b/host/chez/reader.ss @@ -33,6 +33,10 @@ (define rdr-eof (list 'reader-eof)) (define (rdr-eof? x) (eq? x rdr-eof)) +;; A splicing reader conditional #?@(...) yields this wrapper; the enclosing +;; sequence reader splices its items in place (never a legal jolt value). +(define-record-type rdr-splice-t (fields items) (nongenerative rdr-splice-v1)) + (define (rdr-ws? c) (or (char-whitespace? c) (char=? c #\,))) @@ -248,9 +252,11 @@ ((char=? (string-ref s i) close) (values (reverse acc) (+ i 1))) (else (let-values (((form j) (rdr-read-form s i end))) - (if (rdr-eof? form) - (loop j acc) ; a #_ discard or close — re-check at j - (loop j (cons form acc))))))))) + (cond + ((rdr-eof? form) (loop j acc)) ; a #_ discard or no-match #? — re-check at j + ((rdr-splice-t? form) ; #?@ — splice the matched collection's items + (loop j (append (reverse (rdr-splice-t-items form)) acc))) + (else (loop j (cons form acc)))))))))) ;; Map literals must preserve SOURCE key order so the analyzer emits the value ;; expressions in source order (Clojure guarantees left-to-right map-literal eval). @@ -360,9 +366,13 @@ (if rest-sym (list (jolt-symbol #f "&") rest-sym) '())))) (values (jolt-list (jolt-symbol #f "fn*") (apply jolt-vector params) body) j)))))) -;; reader conditionals (jolt-qjr0): jolt's feature set is {:jolt :default}; the -;; FIRST clause whose feature key is in the set wins (clause order, like Clojure). -(define rdr-features '("jolt" "default")) +;; reader conditionals (jolt-qjr0): jolt's feature set is {:jolt :clj :default}; +;; the FIRST clause whose feature key is in the set wins (clause order, like +;; Clojure). jolt is a Clojure/JVM-compatible host — it emulates clojure.lang.* +;; and java.* interop — so it reads the :clj branch of a .cljc library (the JVM +;; code path its host shims target), not the :cljs one. A library can still +;; override with a :jolt-specific branch (place it before :clj). +(define rdr-features '("jolt" "clj" "default")) (define (rdr-feature? kw) (and (keyword? kw) (jolt-nil? (let ((n (keyword-t-ns kw))) (if n n jolt-nil))) (and (member (keyword-t-name kw) rdr-features) #t))) @@ -376,7 +386,17 @@ (else '())))) (let loop ((xs items)) (cond ((or (null? xs) (null? (cdr xs))) (values rdr-eof j)) ; no match -> discard - ((rdr-feature? (car xs)) (values (cadr xs) j)) + ((rdr-feature? (car xs)) + (if splice + ;; #?@ — the matched value is a collection whose ITEMS splice + ;; into the enclosing sequence (read-seq expands the wrapper). + (let ((v (cadr xs))) + (values (make-rdr-splice-t + (cond ((pvec? v) (seq->list v)) + ((or (cseq? v) (empty-list-t? v)) (seq->list v)) + (else (list v)))) + j)) + (values (cadr xs) j))) (else (loop (cddr xs))))))))) (define (rdr-read-dispatch s i end) ; i points just past the '#' diff --git a/host/chez/run-corpus.ss b/host/chez/run-corpus.ss index fbfb32b..0f6e3d7 100644 --- a/host/chez/run-corpus.ss +++ b/host/chez/run-corpus.ss @@ -11,7 +11,7 @@ ;; reset between cases so there is no leakage — same isolation a fresh process gives. ;; ;; chez --script host/chez/run-corpus.ss -;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2726) +;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2730) ;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0) ;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels (import (chezscheme)) @@ -196,7 +196,7 @@ ;; Regression floor: fail on any NEW divergence or if pass drops below the floor. (define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_FLOOR"))) - (if s (string->number s) 2726))) + (if s (string->number s) 2730))) (define floor (if limit 0 base-floor)) (when (or (> (length diverged) 0) (< pass floor)) (printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n" diff --git a/host/chez/seed/image.ss b/host/chez/seed/image.ss index 9226aa1..523c392 100644 --- a/host/chez/seed/image.ss +++ b/host/chez/seed/image.ss @@ -131,7 +131,7 @@ (guard (e (#t #f)) (def-var-with-meta! "jolt.backend-scheme" "scheme-reserved" (let* ((_o$1341 "if") (_o$1342 "begin") (_o$1343 "lambda") (_o$1344 "let") (_o$1345 "let*") (_o$1346 "letrec") (_o$1347 "letrec*") (_o$1348 "quote") (_o$1349 "quasiquote") (_o$1350 "unquote") (_o$1351 "set!") (_o$1352 "define") (_o$1353 "define-syntax") (_o$1354 "cond") (_o$1355 "case") (_o$1356 "when") (_o$1357 "unless") (_o$1358 "and") (_o$1359 "or") (_o$1360 "do") (_o$1361 "else") (_o$1362 "guard") (_o$1363 "parameterize") (_o$1364 "delay") (_o$1365 "values")) (jolt-hash-set _o$1341 _o$1342 _o$1343 _o$1344 _o$1345 _o$1346 _o$1347 _o$1348 _o$1349 _o$1350 _o$1351 _o$1352 _o$1353 _o$1354 _o$1355 _o$1356 _o$1357 _o$1358 _o$1359 _o$1360 _o$1361 _o$1362 _o$1363 _o$1364 _o$1365)) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "munge-name" (letrec ((munge-name (lambda (s) (let fnrec1366 ((s s)) (let* ((s (jolt-invoke (var-deref "clojure.string" "replace") s "#" "_"))) (if (jolt-contains? (var-deref "jolt.backend-scheme" "scheme-reserved") s) (jolt-invoke (var-deref "clojure.core" "str") "_" s) s)))))) munge-name))) + (def-var! "jolt.backend-scheme" "munge-name" (letrec ((munge-name (lambda (s) (let fnrec1366 ((s s)) (let* ((s (jolt-invoke (var-deref "clojure.string" "replace") (jolt-invoke (var-deref "clojure.string" "replace") s "#" "_") "'" "_PRIME_"))) (if (jolt-contains? (var-deref "jolt.backend-scheme" "scheme-reserved") s) (jolt-invoke (var-deref "clojure.core" "str") "_" s) s)))))) munge-name))) (guard (e (#t #f)) (declare-var! "jolt.backend-scheme" "emit")) (guard (e (#t #f)) diff --git a/host/chez/seed/prelude.ss b/host/chez/seed/prelude.ss index ce3263e..993de24 100644 --- a/host/chez/seed/prelude.ss +++ b/host/chez/seed/prelude.ss @@ -47,7 +47,7 @@ (lambda syms (let fnrec1001 ((syms (list->cseq syms))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "do")) (jolt-map (lambda (s) (let fnrec1002 ((s s)) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "def")) (jolt-invoke (var-deref "clojure.core" "__sq1") s)))) syms))))) (mark-macro! "clojure.core" "declare")) (guard (e (#t #f)) - (def-var! "clojure.core" "destructure" (letrec ((destructure (lambda (bindings) (let fnrec1003 ((bindings bindings)) (let* ((find-or (lambda (or-map nm) (let fnrec1004 ((or-map or-map) (nm nm)) (jolt-reduce (lambda (acc k) (let fnrec1005 ((acc acc) (k k)) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "symbol?") k))) (if (jolt-truthy? and__13__auto) (jolt= nm (jolt-invoke (var-deref "clojure.core" "name") k)) and__13__auto))) (let* ((_o$1006 #t) (_o$1007 (jolt-get or-map k))) (jolt-vector _o$1006 _o$1007)) acc))) (let* ((_o$1008 #f) (_o$1009 jolt-nil)) (jolt-vector _o$1008 _o$1009)) (if (jolt-truthy? or-map) (jolt-keys or-map) (jolt-vector)))))) (amp? (lambda (x) (let fnrec1010 ((x x)) (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "symbol?") x))) (if (jolt-truthy? and__13__auto) (jolt= "&" (jolt-invoke (var-deref "clojure.core" "name") x)) and__13__auto))))) (proc (letrec ((proc (lambda (pat init acc) (let fnrec1011 ((pat pat) (init init) (acc acc)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "symbol?") pat)) (jolt-conj (jolt-conj acc pat) init) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "vector?") pat)) (let* ((g (jolt-invoke (var-deref "clojure.core" "symbol") (jolt-invoke (var-deref "clojure.core" "str") (jolt-invoke (var-deref "clojure.core" "gensym") )))) (n (jolt-count pat)) (vloop (letrec ((vloop (lambda (i idx a) (let fnrec1015 ((i i) (idx idx) (a a)) (if (< i n) (let* ((elem (jolt-nth pat i))) (if (jolt-truthy? (jolt-invoke amp? elem)) (jolt-invoke vloop (+ i 2) idx (jolt-invoke proc (jolt-nth pat (jolt-inc i)) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "nthnext")) (jolt-invoke (var-deref "clojure.core" "__sq1") g) (jolt-invoke (var-deref "clojure.core" "__sq1") idx)) a)) (if (jolt= elem (keyword #f "as")) (jolt-invoke vloop (+ i 2) idx (jolt-invoke proc (jolt-nth pat (jolt-inc i)) g a)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke vloop (jolt-inc i) (jolt-inc idx) (jolt-invoke proc elem (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "nth")) (jolt-invoke (var-deref "clojure.core" "__sq1") g) (jolt-invoke (var-deref "clojure.core" "__sq1") idx) (jolt-invoke (var-deref "clojure.core" "__sq1") jolt-nil)) a)) jolt-nil)))) a))))) vloop))) (jolt-invoke vloop 0 0 (jolt-conj (jolt-conj acc g) init))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "map?") pat)) (let* ((g (jolt-invoke (var-deref "clojure.core" "symbol") (jolt-invoke (var-deref "clojure.core" "str") (jolt-invoke (var-deref "clojure.core" "gensym") )))) (gm (jolt-invoke (var-deref "clojure.core" "symbol") (jolt-invoke (var-deref "clojure.core" "str") (jolt-invoke (var-deref "clojure.core" "gensym") )))) (coerce (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "sequential?")) (jolt-invoke (var-deref "clojure.core" "__sq1") g))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "and")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "=")) (jolt-invoke (var-deref "clojure.core" "__sq1") 1) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "count")) (jolt-invoke (var-deref "clojure.core" "__sq1") g))))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "map?")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "first")) (jolt-invoke (var-deref "clojure.core" "__sq1") g))))))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "first")) (jolt-invoke (var-deref "clojure.core" "__sq1") g))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "apply")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "hash-map")) (jolt-invoke (var-deref "clojure.core" "__sq1") g))))) (jolt-invoke (var-deref "clojure.core" "__sq1") g))) (or-map (jolt-get pat (keyword #f "or"))) (as-sym (jolt-get pat (keyword #f "as"))) (bound (jolt-conj (jolt-conj (jolt-conj (jolt-conj acc g) init) gm) coerce)) (base (if (jolt-truthy? as-sym) (jolt-conj (jolt-conj bound as-sym) gm) bound)) (group (lambda (a kw kind) (let fnrec1013 ((a a) (kw kw) (kind kind)) (let* ((names (jolt-get pat kw))) (if (jolt-truthy? names) (jolt-reduce (lambda (aa s) (let fnrec1014 ((aa aa) (s s)) (let* ((local (jolt-invoke (var-deref "clojure.core" "name") s)) (nsp (jolt-invoke (var-deref "clojure.core" "namespace") s)) (keyform (if (jolt= kind (keyword #f "kw")) (jolt-invoke (var-deref "clojure.core" "keyword") (if (jolt-truthy? nsp) (jolt-invoke (var-deref "clojure.core" "str") nsp "/" local) local)) (if (jolt= kind (keyword #f "str")) local (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "quote")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "symbol") nsp local))) jolt-nil)))) (fo (jolt-invoke find-or or-map local))) (jolt-conj (jolt-conj aa (jolt-invoke (var-deref "clojure.core" "symbol") local)) (if (jolt-truthy? (jolt-nth fo 0)) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "get")) (jolt-invoke (var-deref "clojure.core" "__sq1") gm) (jolt-invoke (var-deref "clojure.core" "__sq1") keyform) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-nth fo 1))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "get")) (jolt-invoke (var-deref "clojure.core" "__sq1") gm) (jolt-invoke (var-deref "clojure.core" "__sq1") keyform))))))) a names) a))))) (g1 (jolt-invoke group base (keyword #f "keys") (keyword #f "kw"))) (g2 (jolt-invoke group g1 (keyword #f "strs") (keyword #f "str"))) (g3 (jolt-invoke group g2 (keyword #f "syms") (keyword #f "sym")))) (jolt-reduce (lambda (a k) (let fnrec1012 ((a a) (k k)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "keyword?") k)) a (jolt-invoke proc k (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "get")) (jolt-invoke (var-deref "clojure.core" "__sq1") gm) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-get pat k))) a)))) g3 (jolt-keys pat))) (if (jolt-truthy? (keyword #f "else")) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "unsupported destructuring pattern")) jolt-nil)))))))) proc)) (ploop (letrec ((ploop (lambda (i acc) (let fnrec1016 ((i i) (acc acc)) (if (< i (jolt-count bindings)) (jolt-invoke ploop (+ i 2) (jolt-invoke proc (jolt-nth bindings i) (jolt-nth bindings (jolt-inc i)) acc)) acc))))) ploop))) (jolt-invoke ploop 0 (jolt-vector))))))) destructure))) + (def-var! "clojure.core" "destructure" (letrec ((destructure (lambda (bindings) (let fnrec1003 ((bindings bindings)) (let* ((find-or (lambda (or-map nm) (let fnrec1004 ((or-map or-map) (nm nm)) (jolt-reduce (lambda (acc k) (let fnrec1005 ((acc acc) (k k)) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "symbol?") k))) (if (jolt-truthy? and__13__auto) (jolt= nm (jolt-invoke (var-deref "clojure.core" "name") k)) and__13__auto))) (let* ((_o$1006 #t) (_o$1007 (jolt-get or-map k))) (jolt-vector _o$1006 _o$1007)) acc))) (let* ((_o$1008 #f) (_o$1009 jolt-nil)) (jolt-vector _o$1008 _o$1009)) (if (jolt-truthy? or-map) (jolt-keys or-map) (jolt-vector)))))) (amp? (lambda (x) (let fnrec1010 ((x x)) (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "symbol?") x))) (if (jolt-truthy? and__13__auto) (jolt= "&" (jolt-invoke (var-deref "clojure.core" "name") x)) and__13__auto))))) (proc (letrec ((proc (lambda (pat init acc) (let fnrec1011 ((pat pat) (init init) (acc acc)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "symbol?") pat)) (jolt-conj (jolt-conj acc pat) init) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "vector?") pat)) (let* ((g (jolt-invoke (var-deref "clojure.core" "symbol") (jolt-invoke (var-deref "clojure.core" "str") (jolt-invoke (var-deref "clojure.core" "gensym") )))) (n (jolt-count pat)) (vloop (letrec ((vloop (lambda (i idx a) (let fnrec1015 ((i i) (idx idx) (a a)) (if (< i n) (let* ((elem (jolt-nth pat i))) (if (jolt-truthy? (jolt-invoke amp? elem)) (jolt-invoke vloop (+ i 2) idx (jolt-invoke proc (jolt-nth pat (jolt-inc i)) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "nthnext")) (jolt-invoke (var-deref "clojure.core" "__sq1") g) (jolt-invoke (var-deref "clojure.core" "__sq1") idx)) a)) (if (jolt= elem (keyword #f "as")) (jolt-invoke vloop (+ i 2) idx (jolt-invoke proc (jolt-nth pat (jolt-inc i)) g a)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke vloop (jolt-inc i) (jolt-inc idx) (jolt-invoke proc elem (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "nth")) (jolt-invoke (var-deref "clojure.core" "__sq1") g) (jolt-invoke (var-deref "clojure.core" "__sq1") idx) (jolt-invoke (var-deref "clojure.core" "__sq1") jolt-nil)) a)) jolt-nil)))) a))))) vloop))) (jolt-invoke vloop 0 0 (jolt-conj (jolt-conj acc g) init))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "map?") pat)) (let* ((g (jolt-invoke (var-deref "clojure.core" "symbol") (jolt-invoke (var-deref "clojure.core" "str") (jolt-invoke (var-deref "clojure.core" "gensym") )))) (gm (jolt-invoke (var-deref "clojure.core" "symbol") (jolt-invoke (var-deref "clojure.core" "str") (jolt-invoke (var-deref "clojure.core" "gensym") )))) (coerce (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "sequential?")) (jolt-invoke (var-deref "clojure.core" "__sq1") g))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "and")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "=")) (jolt-invoke (var-deref "clojure.core" "__sq1") 1) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "count")) (jolt-invoke (var-deref "clojure.core" "__sq1") g))))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "map?")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "first")) (jolt-invoke (var-deref "clojure.core" "__sq1") g))))))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "first")) (jolt-invoke (var-deref "clojure.core" "__sq1") g))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "apply")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "hash-map")) (jolt-invoke (var-deref "clojure.core" "__sq1") g))))) (jolt-invoke (var-deref "clojure.core" "__sq1") g))) (or-map (jolt-get pat (keyword #f "or"))) (as-sym (jolt-get pat (keyword #f "as"))) (bound (jolt-conj (jolt-conj (jolt-conj (jolt-conj acc g) init) gm) coerce)) (base (if (jolt-truthy? as-sym) (jolt-conj (jolt-conj bound as-sym) gm) bound)) (group (lambda (a kw kind) (let fnrec1013 ((a a) (kw kw) (kind kind)) (let* ((names (jolt-get pat kw))) (if (jolt-truthy? names) (jolt-reduce (lambda (aa s) (let fnrec1014 ((aa aa) (s s)) (let* ((local (jolt-invoke (var-deref "clojure.core" "name") s)) (nsp (jolt-invoke (var-deref "clojure.core" "namespace") s)) (keyform (if (jolt= kind (keyword #f "kw")) (jolt-invoke (var-deref "clojure.core" "keyword") (if (jolt-truthy? nsp) (jolt-invoke (var-deref "clojure.core" "str") nsp "/" local) local)) (if (jolt= kind (keyword #f "str")) local (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "quote")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "symbol") nsp local))) jolt-nil)))) (fo (jolt-invoke find-or or-map local))) (jolt-conj (jolt-conj aa (jolt-invoke (var-deref "clojure.core" "symbol") local)) (if (jolt-truthy? (jolt-nth fo 0)) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "get")) (jolt-invoke (var-deref "clojure.core" "__sq1") gm) (jolt-invoke (var-deref "clojure.core" "__sq1") keyform) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-nth fo 1))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "get")) (jolt-invoke (var-deref "clojure.core" "__sq1") gm) (jolt-invoke (var-deref "clojure.core" "__sq1") keyform))))))) a names) a))))) (g1 (jolt-invoke group base (keyword #f "keys") (keyword #f "kw"))) (g2 (jolt-invoke group g1 (keyword #f "strs") (keyword #f "str"))) (g3 (jolt-invoke group g2 (keyword #f "syms") (keyword #f "sym")))) (jolt-reduce (lambda (a k) (let fnrec1012 ((a a) (k k)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "keyword?") k)) a (jolt-invoke proc k (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "get")) (jolt-invoke (var-deref "clojure.core" "__sq1") gm) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-get pat k))) a)))) g3 (jolt-keys pat))) (if (jolt-truthy? (keyword #f "else")) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "unsupported destructuring pattern: " (jolt-invoke (var-deref "clojure.core" "pr-str") pat))) jolt-nil)))))))) proc)) (ploop (letrec ((ploop (lambda (i acc) (let fnrec1016 ((i i) (acc acc)) (if (< i (jolt-count bindings)) (jolt-invoke ploop (+ i 2) (jolt-invoke proc (jolt-nth bindings i) (jolt-nth bindings (jolt-inc i)) acc)) acc))))) ploop))) (jolt-invoke ploop 0 (jolt-vector))))))) destructure))) (guard (e (#t #f)) (def-var! "clojure.core" "let" (lambda (bindings . body) (let fnrec1017 ((bindings bindings) (body (list->cseq body))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "let*")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqvec") (jolt-invoke (var-deref "clojure.core" "destructure") bindings))) body)))) diff --git a/jolt-core/clojure/core/00-syntax.clj b/jolt-core/clojure/core/00-syntax.clj index 8d18e24..f224fc3 100644 --- a/jolt-core/clojure/core/00-syntax.clj +++ b/jolt-core/clojure/core/00-syntax.clj @@ -247,7 +247,7 @@ a (proc k `(get ~gm ~(get pat k)) a))) g3 (keys pat))) - :else (throw (str "unsupported destructuring pattern")))) + :else (throw (str "unsupported destructuring pattern: " (pr-str pat))))) ploop (fn* ploop [i acc] (if (< i (count bindings)) diff --git a/jolt-core/jolt/backend_scheme.clj b/jolt-core/jolt/backend_scheme.clj index ba50852..6b177a0 100644 --- a/jolt-core/jolt/backend_scheme.clj +++ b/jolt-core/jolt/backend_scheme.clj @@ -120,7 +120,13 @@ ;; starts a datum in Scheme, so replace it with `_`. A name that collides with a ;; Scheme keyword is prefixed with `_` so it can never shadow the emitted form. (defn- munge-name [s] - (let [s (str/replace s "#" "_")] + ;; A Clojure symbol may contain chars that break a Scheme identifier: ' is the + ;; quote reader macro (a bare f' would read as f then 'rest), # already maps to + ;; _. Munge both to safe tokens; the same mapping applies at the binding and at + ;; every reference, so resolution stays consistent. + (let [s (-> s + (str/replace "#" "_") + (str/replace "'" "_PRIME_"))] (if (contains? scheme-reserved s) (str "_" s) s))) (declare emit)