~ chicken-r7rs (master) /r7rs-library.scm

 1;;;
 2;;; Helpers for working with R7RS library import forms.
 3;;;
 4;;; These are used by r7rs-compile-time during library expansion
 5;;; and scheme.eval for (environment ...) module renaming.
 6;;;
 7
 8(module r7rs-library *
 9  (import-syntax matchable)
10  (import scheme chicken.base)
11  (import (only chicken.string string-intersperse))
12  (import (only chicken.syntax syntax-error))
13
14  (define (fixup-import/export-spec spec loc)
15    (match spec
16      (((and head (or 'only 'except 'rename 'prefix)) name . more)
17       (cons head (cons (fixup-import/export-spec name loc) more)))
18      ((name ...)
19       (parse-library-name name loc))
20      ((? symbol? spec) spec)
21      (else
22       (syntax-error loc "invalid import/export specifier" spec))))
23
24  (define (parse-library-name name loc)
25    (define (fail) (syntax-error loc "invalid library name" name))
26    (match name
27      ((? symbol?) name)
28      ;; We must replicate the core magic that handles SRFI-55's
29      ;; (require-extension (srfi N)), because we also need to generate
30      ;; SRFI-N library names when defining SRFIs from an R7RS module.
31      (('srfi (and num (? fixnum?)))
32       (string->symbol (string-append "srfi-" (number->string num))))
33      ((parts ...)
34       (string->symbol
35        (string-intersperse 
36         (map (lambda (part)
37                (cond ((symbol? part) (symbol->string part))
38                      ((number? part) (number->string part))
39                      (else (fail))))
40              parts)
41         ".")))
42      (else (fail)))))