diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 2372aa6c..988f632f 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -3,24 +3,6 @@ ;; This code was written by Alex Shinn in 2014 and placed in the ;; Public Domain. All warranties are disclaimed. -(define (find-in-path file . o) - (any (lambda (dir) - (let ((path (make-path dir file))) - (and (file-exists? path) path))) - (if (pair? o) - (car o) - (string-split (get-environment-variable "PATH") #\:)))) - -(define (find-sexp-in-path file dirs . o) - (let ((pred (if (pair? o) (car o) (lambda (x) #t)))) - (any (lambda (dir) - (let ((path (make-path dir file))) - (and (file-exists? path) - (guard (exn (else #f)) - (let ((x (call-with-input-file path read))) - (and (pred x) x)))))) - dirs))) - (define known-implementations '((chibi "chibi-scheme") (chicken "chicken") @@ -72,52 +54,6 @@ (define (conf-for-implementation cfg 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) - (call-with-output-string (lambda (out) (write x out)))) - -(define (resource->bytevector uri) - (let ((uri (if (uri? uri) uri (string->path-uri 'http uri)))) - (if (uri-host uri) - (call-with-input-url uri port->bytevector) - (file->bytevector (uri-path uri))))) - -(define (file->sexp-list file) - (call-with-input-file file - (lambda (in) - (let lp ((res '())) - (let ((x (read in))) - (if (eof-object? x) - (reverse res) - (lp (cons x res)))))))) - -(define (version-split str) - (if str - (map (lambda (x) (or (string->number x) x)) - (string-split str #\.)) - '())) - -(define (version-compare a b) - (define (less? x y) - (cond ((number? x) (if (number? y) (< x y) 1)) - ((number? y) -1) - (else (string? a b) (> (version-compare a b) 0)) -(define (version>=? a b) (>= (version-compare a b) 0)) - ;; Hack to evaluate an expression in a separate process with a larger ;; default heap. The expression and result must be serializable with ;; write, and imports should be an argument list for environment. diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index a0f43a84..576e1ea7 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -1,10 +1,50 @@ -;;> Copies the file \var{from} to \var{to}. +(define (find-in-path file . o) + (any (lambda (dir) + (let ((path (make-path dir file))) + (and (file-exists? path) path))) + (if (pair? o) + (car o) + (string-split (get-environment-variable "PATH") #\:)))) -(define (copy-file from to) - (let ((in (open-binary-input-file from)) - (out (open-binary-output-file to))) - (let lp () - (let ((n (read-u8 in))) - (cond ((eof-object? n) (close-input-port in) (close-output-port out)) - (else (write-u8 n out) (lp))))))) +(define (find-sexp-in-path file dirs . o) + (let ((pred (if (pair? o) (car o) (lambda (x) #t)))) + (any (lambda (dir) + (let ((path (make-path dir file))) + (and (file-exists? path) + (guard (exn (else #f)) + (let ((x (call-with-input-file path read))) + (and (pred x) x)))))) + dirs))) + +(define (write-to-string x) + (call-with-output-string (lambda (out) (write x out)))) + +(define (resource->bytevector uri) + (let ((uri (if (uri? uri) uri (string->path-uri 'http uri)))) + (if (uri-host uri) + (call-with-input-url uri port->bytevector) + (file->bytevector (uri-path uri))))) + +(define (version-split str) + (if str + (map (lambda (x) (or (string->number x) x)) + (string-split str #\.)) + '())) + +(define (version-compare a b) + (define (less? x y) + (cond ((number? x) (if (number? y) (< x y) 1)) + ((number? y) -1) + (else (string? a b) (> (version-compare a b) 0)) +(define (version>=? a b) (>= (version-compare a b) 0)) diff --git a/lib/chibi/snow/utils.sld b/lib/chibi/snow/utils.sld index fdb8ffcd..a906a94b 100644 --- a/lib/chibi/snow/utils.sld +++ b/lib/chibi/snow/utils.sld @@ -1,12 +1,17 @@ (define-library (chibi snow utils) - (export copy-file) + (export find-in-path find-sexp-in-path + write-to-string resource->bytevector + version-split version-compare version>? version>=?) (import (scheme base) (scheme file) - (scheme time) - (srfi 33) - (chibi filesystem) + (scheme read) + (scheme write) + (scheme process-context) + (srfi 1) + (chibi io) + (chibi net http) (chibi pathname) - (chibi process) - (chibi snow interface)) + (chibi string) + (chibi uri)) (include "utils.scm"))