feat: add Clojure reader compatibility mode (#!cloj / reader-cloj-mode)
ober
2291f91e7fd6d02ca82952262ea3c87d2e86d8c3
new file mode 100644 --- /dev/null +++ b/lib/jerboa/cloj.sls @@ -0,0 +1,97 @@ +#!chezscheme +;;; jerboa/cloj.sls — Clojure reader mode support +;;; +;;; Provides: +;;; reader-cloj-mode — parameter: activates Clojure syntax in the Jerboa reader +;;; fn-literal — macro: expands #(...) anonymous function reader literals +;;; +;;; The Jerboa reader expands #(+ % 1) to (fn-literal + % 1) when cloj mode +;;; is active. fn-literal walks the body, detects % / %1 / %2 / %& references, +;;; and emits the appropriate (lambda ...) form. +;;; +;;; Activation: add #!cloj at the top of any Jerboa source file, or call +;;; (reader-cloj-mode #t) programmatically. + +(library (jerboa cloj) + (export reader-cloj-mode fn-literal activate-cloj-reader!) + + (import (chezscheme) + (only (jerboa reader) reader-cloj-mode)) + + ;;; activate-cloj-reader! — call from library bodies to enable cloj mode + ;; Wraps (reader-cloj-mode #t) so that libraries with restricted import + ;; environments can activate cloj mode with a single function call. + (define (activate-cloj-reader!) (reader-cloj-mode #t)) + + ;;; fn-literal — expands #(...) anonymous function literals + ;; + ;; #(+ % 1) → (lambda (%1) (+ %1 1)) + ;; #(str %1 " " %2) → (lambda (%1 %2) (str %1 " " %2)) + ;; #(apply + %&) → (lambda %& (apply + %&)) + ;; #(begin (f %) %) → (lambda (%1) (begin (f %1) %1)) + ;; + ;; % is an alias for %1. %2, %3, etc. for more positional args. + ;; %& collects all extra args as a rest list. + + (define-syntax fn-literal + (lambda (stx) + + ;; Replace bare % with %1 throughout a datum tree + (define (normalize d) + (cond + ((eq? d '%) '%1) + ((pair? d) (cons (normalize (car d)) (normalize (cdr d)))) + (else d))) + + ;; Walk datum, return (max-positional-n . has-rest?) + ;; Recognises: %1 %2 %3 ... (and %) %& + (define (find-info d) + (let loop ((d d) (n 0) (r? #f)) + (cond + ((null? d) (cons n r?)) + ((eq? d '%&) (cons n #t)) + ((symbol? d) + (let* ((s (symbol->string d)) + (len (string-length s))) + (if (and (> len 1) (char=? (string-ref s 0) #\%)) + (let ((num (string->number (substring s 1 len)))) + (if num (cons (max n num) r?) (cons n r?))) + (cons n r?)))) + ((pair? d) + (let ((r1 (loop (car d) n r?))) + (loop (cdr d) (car r1) (cdr r1)))) + (else (cons n r?))))) + + ;; Build list (1 2 ... n) + (define (range-1-to n) + (let lp ((i n) (acc '())) + (if (= i 0) acc (lp (- i 1) (cons i acc))))) + + (syntax-case stx () + ((kw body-form ...) + (let* ((raw (syntax->datum #'(body-form ...))) + (nb (normalize raw)) + ;; If there's exactly one form, use it directly; else wrap in begin + (body (if (and (pair? nb) (null? (cdr nb))) + (car nb) + (cons 'begin nb))) + (info (find-info body)) + (max-n (car info)) + (rest? (cdr info)) + (positional (map (lambda (i) + (string->symbol + (string-append "%" (number->string i)))) + (range-1-to max-n))) + ;; arg-list: + ;; no args + rest → %& (variadic bare symbol) + ;; no args, no rest → () (nullary) + ;; args + rest → (%1 %2 . %&) (dotted list via append) + ;; args, no rest → (%1 %2 ...) + (arg-list (cond + ((and (null? positional) rest?) '%&) + ((null? positional) '()) + (rest? (append positional '%&)) ;; (append list sym) = dotted + (else positional)))) + (datum->syntax #'kw `(lambda ,arg-list ,body))))))) + + ) ;; end library --- a/lib/jerboa/clojure.sls +++ b/lib/jerboa/clojure.sls @@ -236,6 +236,14 @@ string-map regex-match regex-search regex-replace regex-replace-all + ;; ---- Clojure reader mode ---- + ;; reader-cloj-mode: parameter — (reader-cloj-mode #t) activates Clojure syntax + ;; fn-literal: macro — expands #(...) anonymous function literals + ;; activate-cloj-reader!: procedure — convenience wrapper to enable cloj mode + reader-cloj-mode + fn-literal + activate-cloj-reader! + ;; ================================================================ ;; (std clojure) — Clojure compatibility layer (wins on conflicts) ;; ================================================================ @@ -451,8 +459,8 @@ ;; (std clojure) re-exports from the same underlying modules, so ;; semantics are identical — we just avoid R6RS duplicate-import errors. (except (jerboa prelude) - ;; hash-map — re-exported by (std clojure) as Clojure constructor - hash-map + ;; hash-map, hash-set — re-exported by (std clojure) as Clojure constructors + hash-map hash-set ;; atom / volatile / watches — re-exported by (std clojure) atom atom? reset! swap! compare-and-set! add-watch! remove-watch! @@ -465,6 +473,9 @@ ;; func combinators — re-exported by (std clojure) fnil every-pred some-fn) + ;; Clojure reader mode + fn-literal macro (in its own bootstrap file) + (jerboa cloj) + ;; Clojure compatibility — wins on all conflicts (std clojure) @@ -475,4 +486,12 @@ (std transit) (std clojure seq) (prefix (std clojure string) str/) - (std clojure reducers))) + (std clojure reducers)) + + ;;;; Activate Clojure reader mode for programmatic use + ;; (e.g. REPL sessions, load-file calls). + ;; Files that use Clojure syntax should also start with #!cloj so the + ;; reader is in cloj mode before parsing the (import (jerboa clojure)) form. + (activate-cloj-reader!) + + ) --- a/lib/jerboa/prelude.sls +++ b/lib/jerboa/prelude.sls @@ -31,6 +31,7 @@ hash-find hash-keys hash-values hash-copy hash-clear! hash-merge hash-merge! hash-length hash-table? list->hash-table plist->hash-table + hash-set keyword? keyword->string string->keyword make-keyword error-message error-irritants error-trace displayln 1+ 1- --- a/lib/jerboa/reader.sls +++ b/lib/jerboa/reader.sls @@ -1,9 +1,22 @@ #!chezscheme ;;; reader.sls -- Gerbil-compatible reader for Jerboa ;;; -;;; Handles: [...] → (list ...), {...} → (~ obj method args ...), -;;; #!void/#!eof, keyword: syntax, source locations, -;;; #; datum comments, #| block comments |#, #u8(...), #&box +;;; Default mode: +;;; [...] → (list ...) — Clojure-style vector literal (always) +;;; {@} → method dispatch — {method obj args...} → (~ obj 'method args...) +;;; #{...} → set literal — (hash-set item ...) (always) +;;; @expr → (deref expr) — Clojure-style deref (always) +;;; :pkg/mod → (pkg mod) — Gerbil module-path shorthand +;;; name: → keyword — trailing-colon keyword +;;; +;;; Clojure reader mode (reader-cloj-mode) → #t : +;;; {} → hash map literal — {k1 v1 ...} → (plist->hash-table (list k1 v1 ...)) +;;; #() → anonymous function — #(+ % 1) → (fn-literal + % 1) +;;; :name → keyword — leading-colon Clojure keyword +;;; nil → #f, true → #t, false → #f +;;; +;;; Activation: put #!cloj at the top of any .ss file, or call +;;; (reader-cloj-mode #t) programmatically. (library (jerboa reader) (export @@ -11,6 +24,7 @@ jerboa-read-all jerboa-read-file jerboa-read-string + reader-cloj-mode *max-read-depth* *max-block-comment-depth* *max-string-length* @@ -31,6 +45,12 @@ (define *max-list-length* (make-parameter 1000000)) ;; 1M elements default (define *max-symbol-length* (make-parameter 4096)) ;; 4KB default + ;; When #t, enables Clojure reader syntax: + ;; {} → hash map, #() → anonymous fn, :name → keyword, + ;; nil → #f, true → #t, false → #f + ;; Activated by #!cloj directive or (reader-cloj-mode #t) call. + (define reader-cloj-mode (make-parameter #f)) + ;;;; Source locations (define-record-type source-location (fields path line column) @@ -177,23 +197,35 @@ (reader-next! rs) (annotate rs (cons 'list (read-list rs #\] (+ depth 1))) loc)) - ;; Curly braces → (~ obj method args...) + ;; Curly braces: + ;; cloj mode → hash map literal {k1 v1 ...} → (plist->hash-table (list k1 v1 ...)) + ;; default → method dispatch {method obj args...} → (~ obj 'method args...) ((char=? ch #\{) (reader-next! rs) (let ((items (read-list rs #\} (+ depth 1)))) - (cond - ((null? items) - (error 'jerboa-read "empty method dispatch {}")) - ((null? (cdr items)) - (error 'jerboa-read "method dispatch needs at least {method obj}")) - (else - ;; {method obj args...} → (~ obj 'method args...) - (let ((method (car items)) - (obj (cadr items)) - (args (cddr items))) - (annotate rs - (cons* '~ obj (list 'quote method) args) - loc)))))) + (if (reader-cloj-mode) + ;; Clojure hash map literal + (if (null? items) + (annotate rs '(make-hash-table) loc) + (begin + (when (odd? (length items)) + (error 'jerboa-read + "map literal {} requires an even number of forms (key value ...)" + (length items))) + (annotate rs + (list 'plist->hash-table (cons 'list items)) + loc))) + ;; Default: Jerboa method dispatch + (cond + ((null? items) + (error 'jerboa-read "empty method dispatch {}")) + ((null? (cdr items)) + (error 'jerboa-read "method dispatch needs at least {method obj}")) + (else + (let ((method (car items)) (obj (cadr items)) (args (cddr items))) + (annotate rs + (cons* '~ obj (list 'quote method) args) + loc))))))) ;; Closing delimiters ((or (char=? ch #\)) (char=? ch #\]) (char=? ch #\})) @@ -225,6 +257,11 @@ (annotate rs (list 'unquote-splicing (read-datum rs (+ depth 1))) loc)) (annotate rs (list 'unquote (read-datum rs (+ depth 1))) loc)))) + ;; @ → Clojure-style deref: @atom → (deref atom) + ((char=? ch #\@) + (reader-next! rs) + (annotate rs (list 'deref (read-datum rs (+ depth 1))) loc)) + ;; Hash dispatch ((char=? ch #\#) (reader-next! rs) @@ -359,11 +396,18 @@ (error 'jerboa-read "invalid # syntax" rest)))) (else (annotate rs #f loc))))) - ;; #( vector + ;; #( — vector (default) or anonymous function (cloj mode) + ;; cloj: #(+ % 1) → reads (+ % 1) as one form → (fn-literal (+ % 1)) + ;; → (lambda (%1) (+ %1 1)) + ;; The ( is NOT consumed in cloj mode — read-datum reads the whole list. ((char=? ch #\() - (reader-next! rs) - (let ((items (read-list rs #\) (+ depth 1)))) - (annotate rs (list->vector items) loc))) + (if (reader-cloj-mode) + (let ((body (read-datum rs (+ depth 1)))) + (annotate rs (list 'fn-literal body) loc)) + (begin + (reader-next! rs) + (let ((items (read-list rs #\) (+ depth 1)))) + (annotate rs (list->vector items) loc))))) ;; #u8( bytevector ((char=? ch #\u) @@ -396,7 +440,7 @@ ;; #! hash-bang ((char=? ch #\!) (reader-next! rs) - (read-hash-bang rs loc)) + (read-hash-bang rs loc depth)) ;; #| block comment ((char=? ch #\|) @@ -510,6 +554,13 @@ (lloop (cons c chars))))))))) (error 'jerboa-read "invalid # dispatch" ch)))) + ;; #{...} → Clojure-style set literal + ;; #{1 2 3} → (hash-set 1 2 3) + ((char=? ch #\{) + (reader-next! rs) + (let ((items (read-list rs #\} (+ depth 1)))) + (annotate rs (cons 'hash-set items) loc))) + ;; #r"..." raw string — backslashes are literal, no escape processing. ;; Only \" is handled so you can embed a double-quote inside. ((char=? ch #\r) @@ -556,7 +607,7 @@ ;;;; Hash-bang reader - (define (read-hash-bang rs loc) + (define (read-hash-bang rs loc depth) (let ((ch (reader-peek rs))) (cond ((or (eof-object? ch) (delimiter? ch)) @@ -567,6 +618,11 @@ ((void) (annotate rs (void) loc)) ((eof) (annotate rs (eof-object) loc)) ((optional) (annotate rs (void) loc)) ; placeholder + ;; #!cloj — activate Clojure reader mode for the rest of this file + ;; skips the directive itself, continues reading the next datum + ((cloj) + (reader-cloj-mode #t) + (read-datum rs depth)) (else (annotate rs (list (string->symbol "#!") name) loc)))))))) @@ -721,12 +777,23 @@ (char=? (string-ref s (fx- (string-length s) 1)) #\:)) (let ((kw-name (substring s 0 (fx- (string-length s) 1)))) (annotate rs (string->keyword kw-name) loc))) - ;; :package/module/... → (package module ...) - ;; Gerbil module path syntax + ;; Leading-colon handling differs by mode: + ;; cloj mode : :name → keyword (Clojure-style) + ;; default : :pkg/mod → (pkg mod) Gerbil module-path ((and (fx> (string-length s) 1) (char=? (string-ref s 0) #\:)) - (let ((path (substring s 1 (string-length s)))) - (annotate rs (module-path->list path) loc))) + (if (reader-cloj-mode) + (let ((kw-name (substring s 1 (string-length s)))) + (annotate rs (string->keyword kw-name) loc)) + (let ((path (substring s 1 (string-length s)))) + (annotate rs (module-path->list path) loc)))) + ;; Clojure literal booleans / nil (only in cloj mode) + ((and (reader-cloj-mode) (eq? sym 'nil)) + (annotate rs #f loc)) + ((and (reader-cloj-mode) (eq? sym 'true)) + (annotate rs #t loc)) + ((and (reader-cloj-mode) (eq? sym 'false)) + (annotate rs #f loc)) (else (annotate rs sym loc))))))))) --- a/lib/jerboa/runtime.sls +++ b/lib/jerboa/runtime.sls @@ -19,6 +19,7 @@ list->hash-table plist->hash-table hash-table? hash-eq hash-eq? + hash-set ;; Keywords keyword? keyword->string string->keyword make-keyword @@ -214,6 +215,14 @@ (hashtable-set! ht (car rest) (cadr rest)) (lp (cddr rest))])))) + ;; hash-set: Clojure-style set (hash table where all values are #t) + ;; (hash-set 'a 'b 'c) → eq-hashtable with a, b, c as keys + ;; Used by the reader for #{...} literals + (define (hash-set . items) + (let ([ht (make-eq-hashtable)]) + (for-each (lambda (item) (hashtable-set! ht item #t)) items) + ht)) + ;; hash-eq constructor: (hash-eq (k1 v1) (k2 v2) ...) is a macro in core.sls ;; but we need hash-eq? predicate (define (hash-eq? ht) --- a/lib/std/clojure.sls +++ b/lib/std/clojure.sls @@ -150,7 +150,7 @@ merge merge! list* meta) - (except (jerboa runtime) cons* hash-map) + (except (jerboa runtime) cons* hash-map hash-set) (std pmap) (std immutable) (rename (std pvec) --- a/support/build.ss +++ b/support/build.ss @@ -11,6 +11,7 @@ ;; Errors during compilation of optional/platform-specific libraries are non-fatal. (define libraries-to-compile '((jerboa reader) + (jerboa cloj) (jerboa core) (jerboa runtime) (jerboa ffi)