Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +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 (define r6rs-library-transformer
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (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 (clean-up-r6rs-library-name name)
(define (srfi-number->exact-integer component) (define (srfi-number->exact-integer component)
(if (symbol? component) (if (symbol? component)
(let* ((symbol-name (symbol->string component)) (let* ((symbol-name (symbol->string component)))
(maybe-number-as-string (substring symbol-name 1)))
(if (and (char=? (string-ref symbol-name 0) #\:) (if (and (char=? (string-ref symbol-name 0) #\:)
(every char-numeric? (every char-numeric?
(string->list maybe-number-as-string))) (cdr (string->list symbol-name))))
(string->number maybe-number-as-string) (string->number maybe-number-as-string)
#f)) #f))
#f)) #f))
@ -382,41 +378,34 @@
name))) name)))
(define (clean-up-r6rs-import import-spec) (define (clean-up-r6rs-import import-spec)
(cond ((identifier? import-spec) import-spec) (cond ((identifier? import-spec) import-spec)
((member (car import-spec) ((memq (car import-spec)
'(only except prefix rename) '(only except prefix rename))
symbolic-id=?)
(cons (car import-spec) (cons (car import-spec)
(cons (clean-up-r6rs-library-name (cadr import-spec)) (cons (clean-up-r6rs-library-name (cadr import-spec))
(cddr import-spec)))) (cddr import-spec))))
((member (car import-spec) ((memq (car import-spec)
'(library for) '(library for))
symbolic-id=?)
(clean-up-r6rs-library-name (cadr import-spec))) (clean-up-r6rs-library-name (cadr import-spec)))
(else (clean-up-r6rs-library-name import-spec)))) (else (clean-up-r6rs-library-name import-spec))))
(if (not (symbolic-id=? (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) '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) (if (not (and (list? expr)
(>= (length expr) 3) (>= (length expr) 3)
(list? (list-ref expr 1)) (list? (list-ref expr 1))
(list? (list-ref expr 2)) (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)) (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)) (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))) (let ((library-name (clean-up-r6rs-library-name (list-ref expr 1)))
(exports (cdr (list-ref expr 2))) (exports (cdr (list-ref expr 2)))
(imports (map clean-up-r6rs-import (cdr (list-ref expr 3)))) (imports (map clean-up-r6rs-import (cdr (list-ref expr 3))))
(body (cddr (cddr expr))) (body (cddr (cddr expr))))
`(define-library ,library-name
(_define-library (rename 'define-library)) (export ,@exports)
(_export (rename 'export)) (import ,@imports)
(_import (rename 'import)) (begin ,@body))))))
(_begin (rename 'begin)))
`(,_define-library ,library-name
(,_export ,@exports)
(,_import ,@imports)
(,_begin ,@body))))))
(define-syntax library r6rs-library-transformer) (define-syntax library r6rs-library-transformer)