From 76211609ff829cfe0bb5d10ab23fac89efdc2022 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 26 Sep 2016 23:10:09 +0900 Subject: [PATCH] portability changes --- lib/chibi/filesystem.scm | 3 +++ lib/chibi/filesystem.sld | 3 ++- lib/chibi/log.scm | 4 +--- lib/chibi/log.sld | 21 +++++++++++++++++++-- lib/chibi/memoize-test.sld | 32 ++++++++++++++++---------------- lib/chibi/memoize.scm | 32 ++++++++++++++++++-------------- lib/chibi/memoize.sld | 15 ++++++++++----- lib/chibi/time.sld | 31 ++++++++++++++++++++++++++++--- 8 files changed, 97 insertions(+), 44 deletions(-) diff --git a/lib/chibi/filesystem.scm b/lib/chibi/filesystem.scm index 009175e0..c22f2a2a 100644 --- a/lib/chibi/filesystem.scm +++ b/lib/chibi/filesystem.scm @@ -127,6 +127,9 @@ (define (file-num-blocks x) (stat-blocks (if (stat? x) x (file-status x)))) (define (file-access-time x) (stat-atime (if (stat? x) x (file-status x)))) (define (file-modification-time x) (stat-mtime (if (stat? x) x (file-status x)))) +(define (file-modification-time/safe x) + (let ((status (if (stat? x) x (file-status x)))) + (and status (stat-mtime status)))) (define (file-change-time x) (stat-ctime (if (stat? x) x (file-status x)))) ;;> File status accessors. \var{x} should be a string indicating diff --git a/lib/chibi/filesystem.sld b/lib/chibi/filesystem.sld index f811470d..e3603a82 100644 --- a/lib/chibi/filesystem.sld +++ b/lib/chibi/filesystem.sld @@ -21,7 +21,8 @@ file-owner file-group file-represented-device file-size file-block-size file-num-blocks - file-access-time file-modification-time file-change-time + file-access-time file-change-time + file-modification-time file-modification-time/safe file-regular? file-directory? file-character? file-block? file-fifo? file-link? file-socket? file-exists? diff --git a/lib/chibi/log.scm b/lib/chibi/log.scm index 4768d7c1..f1a2fdbe 100644 --- a/lib/chibi/log.scm +++ b/lib/chibi/log.scm @@ -158,9 +158,7 @@ (if (pair? o) (logger-file-set! logger (car o))) (if (string? (logger-file logger)) - (let ((fd (open (logger-file logger) - (+ open/create open/write open/append open/non-block)))) - (logger-port-set! logger (open-output-file-descriptor fd))) + (logger-port-set! logger (open-output-file/append (logger-file logger))) (logger-port-set! logger (current-error-port)))) (define (log-close logger) diff --git a/lib/chibi/log.sld b/lib/chibi/log.sld index 08f7b11b..f0dfe760 100644 --- a/lib/chibi/log.sld +++ b/lib/chibi/log.sld @@ -21,6 +21,23 @@ ;; the default logger default-logger log-emergency log-alert log-critical log-error log-warn log-notice log-info log-debug) - (import (chibi) (srfi 9) (chibi time) (chibi process) (chibi system) - (chibi filesystem) (chibi string) (chibi show base)) + (import (chibi time) (chibi string) (chibi show base)) + (cond-expand + (chibi + (import (chibi) (chibi filesystem) (chibi process) (chibi system) (srfi 9)) + (begin + (define (open-output-file/append path) + (let ((fd (open path + (+ open/create open/write open/append open/non-block)))) + (open-output-file-descriptor fd))))) + (else + (import (scheme base)) + (begin + (define open-output-file/append open-output-file) + (define (file-lock port-or-fileno mode) 'unsupported) + (define lock/exclusive 'unsupported) + (define lock/unlock 'unsupported) + (define (current-process-id) -1) + (define (current-user-id) -1) + (define (current-group-id) -1)))) (include "log.scm")) diff --git a/lib/chibi/memoize-test.sld b/lib/chibi/memoize-test.sld index b151db68..14eb243a 100644 --- a/lib/chibi/memoize-test.sld +++ b/lib/chibi/memoize-test.sld @@ -1,26 +1,26 @@ (define-library (chibi memoize-test) (export run-tests) - (import (chibi) (chibi memoize) (chibi filesystem) (chibi test)) + (import (scheme base) (scheme file) (chibi memoize) (chibi test)) (begin (define (run-tests) (test-begin "memoize") - (define-memoized (fib n) - (if (<= n 1) - 1 - (+ (fib (- n 1)) (fib (- n 2))))) + (let () + (define-memoized (fib n) + (if (<= n 1) + 1 + (+ (fib (- n 1)) (fib (- n 2))))) + (test 1 (fib 1)) + (test 573147844013817084101 (fib 100))) - (test 1 (fib 1)) - (test 573147844013817084101 (fib 100)) - - (define-memoized (ack m n) - (cond - ((= m 0) (+ n 1)) - ((= n 0) (ack (- m 1) 1)) - (else (ack (- m 1) (ack m (- n 1)))))) - - (test 29 (ack 3 2)) - (test 61 (ack 3 3)) + (let () + (define-memoized (ack m n) + (cond + ((= m 0) (+ n 1)) + ((= n 0) (ack (- m 1) 1)) + (else (ack (- m 1) (ack m (- n 1)))))) + (test 29 (ack 3 2)) + (test 61 (ack 3 3))) (let ((n 0)) (let ((f (memoize (lambda (x) (set! n (+ n 1)) (* x x))))) diff --git a/lib/chibi/memoize.scm b/lib/chibi/memoize.scm index f9ba0769..81dd751b 100644 --- a/lib/chibi/memoize.scm +++ b/lib/chibi/memoize.scm @@ -120,7 +120,7 @@ (define (memoize-file-loader proc . o) (let* ((f (lambda (file . rest) - (let ((mtime (file-modification-time file))) + (let ((mtime (file-modification-time/safe file))) (cons mtime (apply proc file rest))))) (g (apply memoize f o)) (reloader? (cond ((memq 'reloader?: o) => cdr) (else #f)))) @@ -129,8 +129,10 @@ (let-syntax ((update! (syntax-rules () ((update! default) - (let ((mtime (file-modification-time file))) - (if (> mtime (car cell)) + (let ((mtime (file-modification-time/safe file))) + (if (and mtime + (or (not (car cell)) + (> mtime (car cell)))) (let ((res (apply proc file rest))) (set-car! cell mtime) (set-cdr! cell res) @@ -144,10 +146,11 @@ ;; persistent memoization (define (get-memo-directory proc-name) - (let ((uid (current-user-id))) - (if (zero? uid) - (make-path "/var/run/memo.d" proc-name) - (make-path (user-home (user-information uid)) ".memo.d" proc-name)))) + (or (get-environment-variable "MEMOIZE_DIR") + (if (i-am-root?) + (make-path "/var/run/memo.d" proc-name) + (make-path (or (get-environment-variable "HOME") ".") + ".memo.d" proc-name)))) (define (encode-file-name str) (define (file-name-safe-char? ch) @@ -163,10 +166,11 @@ (if (>= from to) res (cons (substring-cursor str from to) res))) - (let ((end (string-cursor-end str))) - (let lp ((from 0) (to 0) (res '())) + (let ((start (string-cursor-start str)) + (end (string-cursor-end str))) + (let lp ((from start) (to start) (res '())) (if (string-cursor>=? to end) - (if (zero? from) + (if (string-cursor=? from start) str (string-concatenate (reverse (collect str from to res)))) (let* ((ch (string-cursor-ref str to)) @@ -177,9 +181,9 @@ (collect str from to res))))))))) (define (default-args-encoder args) - (encode-file-name - (string-append (call-with-output-string (lambda (out) (write/ss args out))) - ".memo"))) + (let ((out (open-output-string))) + (write/ss args out) + (encode-file-name (string-append (get-output-string out) ".memo")))) ;;> Returns a memoized version of the procedure \var{proc} which ;;> stores the memoized results persistently in a file. Garbage @@ -235,7 +239,7 @@ (init-size init-size: 31) (compute-size compute-size: (lambda (k v) 1)) (size-limit size-limit: 1000)) - (let ((tab (make-hash-table equal hash init-size))) + (let ((tab (make-hash-table equal hash))) ; init-size (%make-lru-cache tab '() '() 0 size-limit compute-size)))) ;; add entry to the back of the queue diff --git a/lib/chibi/memoize.sld b/lib/chibi/memoize.sld index c205824e..a501cac3 100644 --- a/lib/chibi/memoize.sld +++ b/lib/chibi/memoize.sld @@ -1,13 +1,18 @@ (define-library (chibi memoize) - (import (chibi) (chibi optional) (chibi time) (chibi io) - (chibi pathname) (chibi filesystem) (chibi system) - (srfi 9) (srfi 38) (srfi 69)) + (import (chibi optional) (chibi pathname) (chibi string) + (srfi 9) (srfi 38) (srfi 69) (srfi 98)) (cond-expand (chibi - (import (chibi ast))) - (else + (import (chibi) (chibi ast) (chibi system) (chibi filesystem)) (begin + (define (i-am-root?) + (zero? (current-user-id))))) + (else + (import (scheme base) (scheme char) (scheme file)) + (begin + (define (i-am-root?) + (equal? "root" (get-environment-variable "USER"))) (define (procedure-name x) #f) (define (procedure-arity x) #f) (define (procedure-variadic? x) #f)))) diff --git a/lib/chibi/time.sld b/lib/chibi/time.sld index 9e16055a..aad8cc21 100644 --- a/lib/chibi/time.sld +++ b/lib/chibi/time.sld @@ -18,8 +18,31 @@ resource-usage-max-rss resource-usage/self resource-usage/children get-resource-usage)) (else)) - (import (chibi)) - (include-shared "time") + (cond-expand + (chibi + (import (chibi)) + (include-shared "time")) + (else + (import (scheme base) (scheme write) (scheme time) + (rename (srfi 19) (time-second srfi-19:time-second))) + (begin + ;; a SRFI-19 `date' is a datetime, which in C is a tm (time) struct + (define tm? date?) + (define time-second date-second) + (define time-minute date-minute) + (define time-hour date-hour) + (define time-day date-day) + (define time-month date-month) + (define time-year date-year) + (define time-day-of-week date-week-day) + (define time-day-of-year date-year-day) + (define (seconds->time seconds) + (time-tai->date (make-time time-tai 0 (exact (round seconds))))) + (define current-seconds current-second) + (define (get-time-of-day) + (list (current-time) time-utc)) + (define (timeval-seconds tv) (srfi-19:time-second tv)) + (define (timeval-microseconds tv) (/ (time-nanosecond tv) 1000))))) (begin (define (timeval->milliseconds tv) (quotient (+ (* 1000000 (timeval-seconds tv)) @@ -39,6 +62,8 @@ (define-syntax time (syntax-rules () ((time expr) - (time (call-with-output-string (lambda (out) (write 'expr out))) expr)) + (let ((out (open-output-string))) + (write 'expr out) + (time (get-output-string out) expr))) ((time name expr) (time* name (lambda () expr)))))))