thin-provisioning-tools/functional-tests/srfi/private/make-aliased-libraries.sps
Joe Thornber 3e5de399a7 [functional tests] Remove dependency on the ThunderChez library.
I've just moved the relevant code into the functional-tests dir.
2020-04-30 12:07:42 +01:00

55 lines
1.6 KiB
Scheme

#!r6rs
(import
(rnrs)
(only (srfi private registry) available-features)
(only (xitomatl lists) map/filter)
(only (xitomatl match) match-lambda)
(only (xitomatl common) format fprintf printf)
(only (xitomatl strings) string-intersperse)
(only (xitomatl predicates) symbol<?)
(only (xitomatl environments) environment environment-symbols))
(define srfi-libraries/mnemonics
(map/filter (match-lambda
;; NOTE: Uses only the 3-element names.
((:and ('srfi (:symbol ":(\\d+)" num) _)
name)
(list (string->number (symbol->string num))
name))
(_ #F))
available-features))
(define alias-template
";; Automatically generated by ~a
#!r6rs
(library ~s
(export
~a)
(import ~s)
)
")
(define program-name (car (command-line)))
(for-each
(lambda (x)
(let* ((srfi-num (car x))
(lib-name (cadr x))
(exports (list-sort symbol<?
(environment-symbols (environment lib-name))))
(alias-name `(srfi ,(string->symbol (format ":~d" srfi-num))))
(out-file (format "~d.sls" srfi-num)))
(cond
((file-exists? out-file)
(printf "Skipping ~a because it already exists.\n" out-file))
(else
(call-with-output-file out-file
(lambda (fop)
(fprintf fop alias-template
program-name
alias-name
(string-intersperse (map symbol->string exports) "\n ")
lib-name)))
(printf "~a\n" out-file)))))
srfi-libraries/mnemonics)