#!r6rs
;; Copyright 2010 Derick Eddington.  My MIT-style license is in the file named
;; LICENSE from the original collection this file is distributed with.

(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
"#!r6rs
;; Automatically generated by ~a
(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 "%3a~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)
