Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 22:59:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixing some missing imports.

Browse source
This commit is contained in:
Alex Shinn 2014-06-11 22:27:33 +09:00
parent b6fc0247a0
commit 7d663dd316
2 changed files with 11 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
lib/chibi/snow/commands.scm
View file

@ -37,6 +37,11 @@
(define (conf-for-implementation cfg impl) (define (conf-for-implementation cfg impl)
(conf-specialize cfg 'implementation impl)) (conf-specialize cfg 'implementation impl))
(define (call-with-output-string proc)
(let ((out (open-output-string)))
(proc out)
(get-output-string out)))
(define (write-to-string x) (define (write-to-string x)
(call-with-output-string (lambda (out) (write x out)))) (call-with-output-string (lambda (out) (write x out))))
@ -116,10 +121,10 @@
(equal? "." (path-directory (path-directory x))))) (equal? "." (path-directory (path-directory x)))))
(tar-files unzipped-file)))) (tar-files unzipped-file))))
(and package-file (and package-file
(guard (exn (else (print-exception exn) #f)) (guard (exn (else #f))
(let* ((str (utf8->string (let* ((str (utf8->string
(tar-extract-file unzipped-file package-file))) (tar-extract-file unzipped-file package-file)))
(package (call-with-input-string str read))) (package (read (open-input-string str))))
(and (pair? package) (and (pair? package)
(eq? 'package (car package)) (eq? 'package (car package))
package))))))) package)))))))
@ -219,7 +224,7 @@
(let lp ((ls (if version (append (cadr name) (list version)) (cadr name))) (let lp ((ls (if version (append (cadr name) (list version)) (cadr name)))
(res '())) (res '()))
(if (null? ls) (if (null? ls)
(string-concatenate (reverse (cons ".tgz" res))) (string-join (reverse (cons ".tgz" res)))
(lp (cdr ls) (lp (cdr ls)
(cons (x->string (car ls)) (cons (x->string (car ls))
(if (null? res) res (cons "-" res)))))))))) (if (null? res) res (cons "-" res))))))))))
@ -663,7 +668,7 @@
(repo-uri (remote-uri cfg "/s/repo.scm")) (repo-uri (remote-uri cfg "/s/repo.scm"))
(repo-str (call-with-input-url repo-uri port->string)) (repo-str (call-with-input-url repo-uri port->string))
(repo (guard (exn (else #f)) (repo (guard (exn (else #f))
(let ((repo (call-with-input-string repo-str read))) (let ((repo (read (open-input-string repo-str))))
`(,(car repo) (url ,repo-uri) ,@(cdr repo)))))) `(,(car repo) (url ,repo-uri) ,@(cdr repo))))))
(cond (cond
((not (valid-repository? repo)) ((not (valid-repository? repo))
@ -725,7 +730,7 @@
(process->sexp `(guile -c ,(write-to-string `(write ,expr)))))) (process->sexp `(guile -c ,(write-to-string `(write ,expr))))))
(case impl (case impl
((chibi) ((chibi)
(let* ((dirs (reverse (current-module-path))) (let* ((dirs (reverse (fast-eval '(current-module-path) '((chibi)))))
(share-dir (find (lambda (d) (string-contains d "/share/")) dirs))) (share-dir (find (lambda (d) (string-contains d "/share/")) dirs)))
(if share-dir (if share-dir
(cons share-dir (delete share-dir dirs)) (cons share-dir (delete share-dir dirs))

1
lib/chibi/snow/commands.sld
View file

@ -18,6 +18,7 @@
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(scheme time) (scheme time)
(scheme read)
(scheme write) (scheme write)
(srfi 1) (srfi 1)
(srfi 27) (srfi 27)