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

Clean up r6rs-library-transformer

Browse source
This commit is contained in:
Daphne Preston-Kendal 2024-10-18 19:45:45 +02:00
parent d61e9162f7
commit 1ca9225a87
1 changed files with 15 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
lib/meta-7.scm
View file

@ -358,17 +358,13 @@
(define r6rs-library-transformer
(er-macro-transformer
(lambda (expr rename compare)
(define (symbolic-id=? id_1 id_2)
(eq? (strip-syntactic-closures id_1)
(strip-syntactic-closures id_2)))
(define (clean-up-r6rs-library-name name)
(define (srfi-number->exact-integer component)
(if (symbol? component)
(let* ((symbol-name (symbol->string component))
(maybe-number-as-string (substring symbol-name 1)))
(let* ((symbol-name (symbol->string component)))
(if (and (char=? (string-ref symbol-name 0) #\:)
(every char-numeric?
(string->list maybe-number-as-string)))
(cdr (string->list symbol-name))))
(string->number maybe-number-as-string)
#f))
#f))
@ -382,41 +378,34 @@
name)))
(define (clean-up-r6rs-import import-spec)
(cond ((identifier? import-spec) import-spec)
((member (car import-spec)
'(only except prefix rename)
symbolic-id=?)
((memq (car import-spec)
'(only except prefix rename))
(cons (car import-spec)
(cons (clean-up-r6rs-library-name (cadr import-spec))
(cddr import-spec))))
((member (car import-spec)
'(library for)
symbolic-id=?)
((memq (car import-spec)
'(library for))
(clean-up-r6rs-library-name (cadr import-spec)))
(else (clean-up-r6rs-library-name import-spec))))
(if (not (symbolic-id=? (car expr) 'library))
(error "r6rs-library-transformer: I expect to process declarations called library, but this was a new one to me" (car expr) 'library))
(if (not (eq? (car expr) 'library))
(error "r6rs-library-transformer: I expect to process declarations called library, but this was a new one to me" (car expr)))
(if (not (and (list? expr)
(>= (length expr) 3)
(list? (list-ref expr 1))
(list? (list-ref expr 2))
(symbolic-id=? (car (list-ref expr 2)) 'export)
(eq? (car (list-ref expr 2)) 'export)
(list? (list-ref expr 3))
(symbolic-id=? (car (list-ref expr 3)) 'import)))
(eq? (car (list-ref expr 3)) 'import)))
(error "r6rs-library-transformer: the form of a library declaration is (library <name> (export <export-spec> ...) (import <import-spec> ...) <defexpr> ...)" expr))
(let ((library-name (clean-up-r6rs-library-name (list-ref expr 1)))
(exports (cdr (list-ref expr 2)))
(imports (map clean-up-r6rs-import (cdr (list-ref expr 3))))
(body (cddr (cddr expr)))
(_define-library (rename 'define-library))
(_export (rename 'export))
(_import (rename 'import))
(_begin (rename 'begin)))
`(,_define-library ,library-name
(,_export ,@exports)
(,_import ,@imports)
(,_begin ,@body))))))
(body (cddr (cddr expr))))
`(define-library ,library-name
(export ,@exports)
(import ,@imports)
(begin ,@body))))))
(define-syntax library r6rs-library-transformer)