diff --git a/lib/meta-7.scm b/lib/meta-7.scm index 2f6dea68..4c6c4f2b 100644 --- a/lib/meta-7.scm +++ b/lib/meta-7.scm @@ -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 (export ...) (import ...) ...)" 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)