mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 13:49:17 +02:00
sort libs within a package before installing,
plus other small fixes for (chibi iset) for chicken
This commit is contained in:
parent
374034d7e0
commit
7c12b0aaf3
8 changed files with 93 additions and 7 deletions
4
Makefile
4
Makefile
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))))))))))))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Reference in a new issue