Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Move datum->syntax back to init-7.scm. Don't crash when renamer not present in syntactic closure.

Browse source
This commit is contained in:
Marc Nieper-Wisskirchen 2018-12-05 15:59:39 +01:00
parent 081a2a7b3f
commit 5c963df96f
2 changed files with 27 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
lib/chibi/syntax-case.scm
View file

@ -46,28 +46,6 @@
(define (syntax->datum stx)
(strip-syntactic-closures stx))
(define (symbol->identifier id symbol)
(if (symbol? id)
symbol
((syntactic-closure-rename id)
symbol)))
;; TODO: Handle cycles in datum.
(define (datum->syntax id datum)
(let loop ((datum datum))
(cond ((pair? datum)
(cons (loop (car datum))
(loop (cdr datum))))
((vector? datum)
(do ((res (make-vector (vector-length datum)))
(i 0 (+ i 1)))
((= i (vector-length datum)) res)
(vector-set! res i (loop (vector-ref datum i)))))
((symbol? datum)
(symbol->identifier id datum))
(else
datum))))
(define-syntax syntax (syntax-transformer #f))
(define-syntax quasisyntax (syntax-transformer 0))
(define-auxiliary-syntax unsyntax)

28
lib/init-7.scm
View file

@ -976,7 +976,7 @@
(syntax-rules-transformer expr rename compare))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; let(rec)-syntax
;; let(rec)-syntax and datum->syntax
(define-syntax let-syntax
(syntax-rules ()
@ -988,6 +988,32 @@
((letrec-syntax ((keyword transformer) ...) . body)
(%letrec-syntax ((keyword (make-transformer transformer)) ...) . body))))
(define (symbol->identifier id symbol)
(cond
((symbol? id)
symbol)
((syntactic-closure-rename id)
=> (lambda (renamer)
(renamer symbol)))
(else
symbol)))
;; TODO: Handle cycles in datum.
(define (datum->syntax id datum)
(let loop ((datum datum))
(cond ((pair? datum)
(cons (loop (car datum))
(loop (cdr datum))))
((vector? datum)
(do ((res (make-vector (vector-length datum)))
(i 0 (+ i 1)))
((= i (vector-length datum)) res)
(vector-set! res i (loop (vector-ref datum i)))))
((symbol? datum)
(symbol->identifier id datum))
(else
datum))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; additional syntax