Added (file-ctime filename) which returns the time of last change
(in nanoseconds)
This commit is contained in:
Abdulaziz Ghuloum
parent
e751c15bc4
commit
8a809e2f58
Binary file not shown.
|
|
@ -18,9 +18,40 @@
|
|||
(export load load-r6rs-top-level)
|
||||
(import
|
||||
(except (ikarus) load)
|
||||
(only (ikarus.compiler) compile-core-expr)
|
||||
(only (psyntax library-manager)
|
||||
serialize-all current-precompiled-library-loader)
|
||||
(only (psyntax expander) eval-top-level compile-r6rs-top-level)
|
||||
(only (ikarus reader) read-initial))
|
||||
|
||||
|
||||
(define-struct serialized-library (contents))
|
||||
|
||||
(define (load-serialized-library filename sk)
|
||||
;;; TODO: check file last-modified date
|
||||
(let ([ikfasl (string-append filename ".ikfasl")])
|
||||
(and (file-exists? ikfasl)
|
||||
(let ([x
|
||||
(let ([p (open-file-input-port ikfasl)])
|
||||
(let ([x (fasl-read p)])
|
||||
(close-input-port p)
|
||||
x))])
|
||||
(if (serialized-library? x)
|
||||
(apply sk (serialized-library-contents x))
|
||||
(begin
|
||||
(printf
|
||||
"WARNING: not using fasl file ~s because it was \
|
||||
compiled with a different version of ikarus.\n"
|
||||
ikfasl)
|
||||
#f))))))
|
||||
|
||||
(define (do-serialize-library filename contents)
|
||||
(let ([ikfasl (string-append filename ".ikfasl")])
|
||||
(printf "Serializing ~s\n" ikfasl)
|
||||
(let ([p (open-file-output-port ikfasl (file-options no-fail))])
|
||||
(fasl-write (make-serialized-library contents) p)
|
||||
(close-output-port p))))
|
||||
|
||||
(define load-handler
|
||||
(lambda (x)
|
||||
(eval-top-level x)))
|
||||
|
|
@ -63,6 +94,14 @@
|
|||
(let ([thunk (compile-r6rs-top-level prog)])
|
||||
(case how
|
||||
[(run) (thunk)]
|
||||
[(compile) (error 'load-r6rs "not yet")]
|
||||
[(compile)
|
||||
(serialize-all
|
||||
(lambda (file-name contents)
|
||||
(do-serialize-library file-name contents))
|
||||
(lambda (core-expr)
|
||||
(compile-core-expr core-expr)))]
|
||||
[else (error 'load-r6rs-top-level "invali argument" how)])))))
|
||||
|
||||
(current-precompiled-library-loader load-serialized-library)
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -90,14 +90,14 @@
|
|||
(die 'ikarus "--r6rs-script requires a script name")]
|
||||
[else
|
||||
(values '() (car d) 'r6rs-script (cdr d))]))]
|
||||
[(string=? (car args) "--compile-r6rs-script")
|
||||
[(string=? (car args) "--compile-dependencies")
|
||||
(let ([d (cdr args)])
|
||||
(cond
|
||||
[(null? d)
|
||||
(die 'ikarus
|
||||
"--compile-r6rs-script requires a script name")]
|
||||
[else
|
||||
(values '() (car d) 'compile-r6rs-script (cdr d))]))]
|
||||
(values '() (car d) 'compile (cdr d))]))]
|
||||
[else
|
||||
(let-values ([(f* script script-type a*) (f (cdr args))])
|
||||
(values (cons (car args) f*) script script-type a*))]))])
|
||||
|
|
@ -106,7 +106,7 @@
|
|||
(command-line-arguments (cons script args))
|
||||
(load-r6rs-top-level script 'run)
|
||||
(exit 0)]
|
||||
[(eq? script-type 'compile-r6rs-script)
|
||||
[(eq? script-type 'compile)
|
||||
(command-line-arguments (cons script args))
|
||||
(load-r6rs-top-level script 'compile)
|
||||
(exit 0)]
|
||||
|
|
|
|||
|
|
@ -16,12 +16,12 @@
|
|||
|
||||
(library (ikarus posix)
|
||||
(export posix-fork fork waitpid system file-exists? delete-file
|
||||
getenv env environ)
|
||||
getenv env environ file-ctime)
|
||||
(import
|
||||
(rnrs bytevectors)
|
||||
(except (ikarus)
|
||||
posix-fork fork waitpid system file-exists? delete-file
|
||||
getenv env environ))
|
||||
getenv env environ file-ctime))
|
||||
|
||||
(define posix-fork
|
||||
(lambda ()
|
||||
|
|
@ -102,6 +102,22 @@
|
|||
[else "Unknown error while deleting file"]))
|
||||
(make-i/o-filename-error x)))]))))
|
||||
|
||||
(define (file-ctime x)
|
||||
(define who 'file-ctime)
|
||||
(unless (string? x)
|
||||
(die who "not a string" x))
|
||||
(let ([p (cons #f #f)])
|
||||
(let ([v (foreign-call "ikrt_file_ctime" (string->utf8 x) p)])
|
||||
(case v
|
||||
[(0) (+ (* (car p) #e1e9) (cdr p))]
|
||||
[else
|
||||
(raise
|
||||
(condition
|
||||
(make-who-condition who)
|
||||
(make-message-condition "cannot stat a file")
|
||||
(make-i/o-filename-error x)))]))))
|
||||
|
||||
|
||||
(define ($getenv-bv key)
|
||||
(foreign-call "ikrt_getenv" key))
|
||||
(define ($getenv-str key)
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
1394
|
||||
1395
|
||||
|
|
|
|||
|
|
@ -1211,6 +1211,7 @@
|
|||
[vector-sort! i r sr]
|
||||
[file-exists? i r fi]
|
||||
[delete-file i r fi]
|
||||
[file-ctime i]
|
||||
[define-record-type i r rs]
|
||||
[fields i r rs]
|
||||
[immutable i r rs]
|
||||
|
|
|
|||
|
|
@ -23,7 +23,8 @@
|
|||
visit-library library-name library-version library-exists?
|
||||
find-library-by-name install-library library-spec invoke-library
|
||||
extend-library-subst! extend-library-env! current-library-expander
|
||||
current-library-collection library-path library-extensions)
|
||||
current-library-collection library-path library-extensions
|
||||
serialize-all current-precompiled-library-loader)
|
||||
(import (rnrs) (psyntax compat) (rnrs r5rs)
|
||||
(only (ikarus) printf))
|
||||
|
||||
|
|
@ -157,9 +158,33 @@
|
|||
f
|
||||
(assertion-violation 'file-locator "not a procedure" f)))))
|
||||
|
||||
(define (serialize-all serialize compile)
|
||||
(define (library-desc x)
|
||||
(list (library-id x) (library-name x)))
|
||||
(for-each
|
||||
(lambda (x)
|
||||
(when (library-source-file-name x)
|
||||
(serialize
|
||||
(library-source-file-name x)
|
||||
(list (library-id x)
|
||||
(library-name x)
|
||||
(library-version x)
|
||||
(map library-desc (library-imp* x))
|
||||
(map library-desc (library-vis* x))
|
||||
(map library-desc (library-inv* x))
|
||||
(library-subst x)
|
||||
(library-env x)
|
||||
(compile (library-visit-code x))
|
||||
(compile (library-invoke-code x))
|
||||
(library-visible? x)))))
|
||||
((current-library-collection))))
|
||||
|
||||
(define current-precompiled-library-loader
|
||||
(make-parameter (lambda (filename sk) #f)))
|
||||
|
||||
(define (try-load-from-file filename)
|
||||
(load-precompiled-library filename
|
||||
((current-precompiled-library-loader)
|
||||
filename
|
||||
(case-lambda
|
||||
[(id name ver imp* vis* inv* exp-subst exp-env
|
||||
visit-proc invoke-proc visible?)
|
||||
|
|
@ -172,7 +197,7 @@
|
|||
[(null? deps)
|
||||
(install-library id name ver imp* vis* inv*
|
||||
exp-subst exp-env visit-proc invoke-proc
|
||||
#f #f visible?)
|
||||
#f #f visible? #f)
|
||||
#t]
|
||||
[else
|
||||
(let ([d (car deps)])
|
||||
|
|
@ -288,13 +313,7 @@
|
|||
(let ((lib (make-library id name ver imp-lib* vis-lib* inv-lib*
|
||||
exp-subst exp-env visit-proc invoke-proc
|
||||
visit-code invoke-code visible? source-file-name)))
|
||||
(install-library-record lib)))]
|
||||
#;[(id name ver imp* vis* inv* exp-subst exp-env
|
||||
visit-proc invoke-proc visit-code invoke-code
|
||||
visible?)
|
||||
(install-library id name ver imp* vis* inv* exp-subst exp-env
|
||||
visit-proc invoke-proc visit-code invoke-code
|
||||
visible? #f)]))
|
||||
(install-library-record lib)))]))
|
||||
|
||||
(define extend-library-subst!
|
||||
(lambda (lib sym label)
|
||||
|
|
|
|||
|
|
@ -186,3 +186,15 @@ ikrt_tcp_connect_nonblocking(ikptr host, ikptr srvc, ikpcb* pcb){
|
|||
return fdptr;
|
||||
}
|
||||
|
||||
ikptr
|
||||
ikrt_file_ctime(ikptr filename, ikptr res){
|
||||
struct stat s;
|
||||
int err = stat((char*)(filename + off_bytevector_data), &s);
|
||||
if(err) {
|
||||
return fix(errno);
|
||||
}
|
||||
ref(res, off_car) = fix(s.st_ctimespec.tv_sec);
|
||||
ref(res, off_cdr) = fix(s.st_ctimespec.tv_nsec);
|
||||
return fix(0);
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue