sort libs within a package before installing,

plus other small fixes for (chibi iset) for chicken
This commit is contained in:
Alex Shinn 2017-01-30 22:48:02 +09:00
parent 374034d7e0
commit 7c12b0aaf3
8 changed files with 93 additions and 7 deletions

View file

@ -433,8 +433,9 @@ snowballs:
$(SNOW_CHIBI) package --license public-domain lib/chibi/char-set/boundary.sld
$(SNOW_CHIBI) package --license public-domain lib/chibi/match.sld
$(SNOW_CHIBI) package -r lib/chibi/char-set.sld
$(SNOW_CHIBI) package -r lib/chibi/iset.sld
$(SNOW_CHIBI) package -r lib/chibi/iset.sld lib/chibi/iset/optimize.sld
$(SNOW_CHIBI) package -r lib/chibi/show.sld lib/chibi/show/pretty.sld
$(SNOW_CHIBI) package lib/srfi/115.sld
$(SNOW_CHIBI) package lib/chibi/app.sld
$(SNOW_CHIBI) package lib/chibi/bytevector.sld
$(SNOW_CHIBI) package lib/chibi/config.sld
@ -451,5 +452,6 @@ snowballs:
$(SNOW_CHIBI) package lib/chibi/string.sld
$(SNOW_CHIBI) package lib/chibi/sxml.sld
$(SNOW_CHIBI) package lib/chibi/term/ansi.sld
$(SNOW_CHIBI) package lib/chibi/term/edit-line.sld
$(SNOW_CHIBI) package lib/chibi/test.sld
$(SNOW_CHIBI) package lib/chibi/uri.sld

View file

@ -7,7 +7,8 @@
;;> found in SRFI-14.
(define-library (chibi iset)
(import (chibi iset base)
(import (scheme base)
(chibi iset base)
(chibi iset iterators)
(chibi iset constructors))
(export

View file

@ -7,6 +7,9 @@
((library (srfi 33)) (import (srfi 33)))
(else (import (srfi 60))))
(include "base.scm")
(cond-expand ;; workaround for #1342
(chicken (begin (define Integer-Set #f)))
(else))
(export
%make-iset make-iset iset? iset-contains? Integer-Set
iset-start iset-end iset-bits iset-left iset-right

View file

@ -2051,8 +2051,22 @@
"pkg"
(lambda (dir preserve)
(tar-extract snowball (lambda (f) (make-path dir (path-strip-top f))))
(let ((libs (filter-map (lambda (lib) (build-library impl cfg lib dir))
(package-libraries pkg))))
(let* ((ordered-lib-names
(reverse
(topological-sort
(map (lambda (lib)
(cons (library-name lib)
(library-dependencies impl cfg lib)))
(package-libraries pkg)))))
(ordered-libs
(filter-map
(lambda (lib-name)
(find (lambda (x) (equal? lib-name (library-name x)))
(package-libraries pkg)))
ordered-lib-names))
(_ (begin (write `(topo: ,(map library-name (package-libraries pkg)) -> ,ordered-lib-names -> ,ordered-libs)) (newline)))
(libs (filter-map (lambda (lib) (build-library impl cfg lib dir))
ordered-libs)))
(if (test-package impl cfg pkg dir)
(let* ((data-files
(append-map

View file

@ -1,4 +1,43 @@
;; (chibi io) utils
(define (port-fold kons knil . o)
(let ((read (if (pair? o) (car o) read))
(in (if (and (pair? o) (pair? (cdr o)))
(car (cdr o))
(current-input-port))))
(let lp ((acc knil))
(let ((x (read in)))
(if (eof-object? x) acc (lp (kons x acc)))))))
(define (port-map fn . o)
(reverse (apply port-fold (lambda (x ls) (cons (fn x) ls)) '() o)))
(define (port->list read in)
(port-map (lambda (x) x) read in))
(define (port->sexp-list in)
(port->list read in))
(define (port->bytevector in)
(let ((out (open-output-bytevector)))
(do ((c (read-u8 in) (read-u8 in)))
((eof-object? c) (get-output-bytevector out))
(write-u8 c out))))
(define (call-with-input-string str proc)
(let* ((in (open-input-string str))
(res (proc in)))
(close-input-port in)
res))
(define (call-with-output-string proc)
(let ((out (open-output-string)))
(proc out)
(let ((res (get-output-string out)))
(close-output-port out)
res)))
;; general utils
(define (read-from-string str)

View file

@ -28,15 +28,14 @@
(scheme read)
(scheme write)
(srfi 1)
(srfi 115)
(chibi snow interface)
(chibi bytevector)
(chibi config)
(chibi crypto md5)
(chibi crypto rsa)
(chibi crypto sha2)
(chibi io)
(chibi pathname)
(chibi regexp)
(chibi string)
(chibi tar)
(chibi uri)

View file

@ -76,3 +76,30 @@
(define (version>? a b) (> (version-compare a b) 0))
(define (version>=? a b) (>= (version-compare a b) 0))
;; graph is a list of ((vertex dep-vertices ...) ...)
(define (topological-sort graph . o)
(let ((eq (if (pair? o) (car o) equal?)))
(cdr
(let lp ((ls graph) (seen '()) (res '()))
(if (null? ls)
(cons seen res)
(let ((x (caar ls)))
(if (member x seen eq)
(lp (cdr ls) seen res)
(let lp2 ((ls2 (cdar ls))
(seen (cons x seen))
(res res))
(cond
((null? ls2)
(lp (cdr ls) seen (cons x res)))
((member (car ls2) seen eq)
(lp2 (cdr ls2) seen res))
((assoc (car ls2) graph eq)
=> (lambda (vertices)
(let ((tmp (lp (list vertices) seen res)))
(lp2 (cdr ls2) (car tmp) (cdr tmp)))))
(else
(lp2 (cdr ls2)
(cons (car ls2) seen)
(cons (car ls2) res))))))))))))

View file

@ -3,7 +3,8 @@
(export find-in-path find-sexp-in-path
write-to-string display-to-string
resource->bytevector uri-normalize uri-directory
version-split version-compare version>? version>=?)
version-split version-compare version>? version>=?
topological-sort)
(import (scheme base)
(scheme file)
(scheme read)