chibi-scheme/tools/generate-install-meta.scm
2015-05-08 00:01:59 +09:00

58 lines
1.9 KiB
Scheme
Executable file

#! /usr/bin/env chibi-scheme
;; Generate a single .meta file for the chibi package listing all
;; installed builtin packages. Minimal information with no signature,
;; just for the sake of tracking versions so we can install individual
;; updates.
;; Just depend on the core for simpler bootstrapping.
(import (chibi))
(define (read-line)
(let lp ((res '()))
(let ((ch (read-char)))
(cond ((or (eof-object? ch) (eqv? #\newline ch))
(if (and (null? res) (eof-object? ch))
ch
(list->string (reverse res))))
((eqv? #\return ch) (lp))
(else (lp (cons ch res)))))))
(define (install-library? name)
(and (list? name)
(>= (length name) 2)
(let ((x (car (reverse name))))
(and (not (and (eq? 'test x)
(number? (cadr (reverse name)))))
(let* ((s (if (number? x) (number->string x) (symbol->string x)))
(len (string-length s)))
(not (and (> len 5)
(equal? "-test" (substring s (- len 5) len)))))))))
(define (parse-library file)
(protect (exn (else #f))
(let ((x (call-with-input-file file read)))
(and (pair? x)
(eq? 'define-library (car x))
(install-library? (cadr x))
(cadr x)))))
(define (extract-libraries)
(let lp ((res '()))
(let ((file (read-line)))
(cond
((eof-object? file) (reverse res))
((parse-library file) => (lambda (lib) (lp (cons lib res))))
(else (lp res))))))
;; usage: find <dir> -name \*.sld | generate-install-meta.scm <version>
(let ((libs (extract-libraries))
(version (cadr (command-line))))
(display ";; generated by generate-install-meta.scm - do not edit\n\n")
(write
`(package
(version ,version)
,@(map
(lambda (lib) `(library (name ,lib)))
libs)))
(newline))