~ chicken-core (chicken-5) a0cc040dc211cab324751920887894b88202ba91
commit a0cc040dc211cab324751920887894b88202ba91
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Fri Jan 22 13:18:05 2016 +1300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:34 2016 +1300
Move `cpu-time` and `current-[milli]seconds` to new chicken.time module
diff --git a/README b/README
index 3fcc9046..706ccf69 100644
--- a/README
+++ b/README
@@ -307,6 +307,7 @@
| | |-- chicken.repl.import.so
| | |-- chicken.read-syntax.import.so
| | |-- chicken.tcp.import.so
+ | | |-- chicken.time.import.so
| | |-- chicken.utils.import.so
| | |-- csi.import.so
| | |-- modules.db
diff --git a/batch-driver.scm b/batch-driver.scm
index 1c3f442c..253c4542 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -46,6 +46,7 @@
chicken.format
chicken.gc
chicken.pretty-print
+ chicken.time
chicken.compiler.support
chicken.compiler.compiler-syntax
chicken.compiler.core
diff --git a/c-backend.scm b/c-backend.scm
index eb93f46e..b2771e86 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -41,12 +41,13 @@
chicken.bitwise
chicken.data-structures
chicken.format
- chicken.compiler.core
- chicken.compiler.c-platform
- chicken.compiler.support
chicken.flonum
chicken.foreign
- chicken.internal)
+ chicken.internal
+ chicken.time
+ chicken.compiler.core
+ chicken.compiler.c-platform
+ chicken.compiler.support)
(include "mini-srfi-1.scm")
diff --git a/chicken-install.scm b/chicken-install.scm
index c8e4c97b..ddb277f0 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -70,6 +70,7 @@
"chicken.repl.import.so"
"chicken.read-syntax.import.so"
"chicken.tcp.import.so"
+ "chicken.time.import.so"
"chicken.utils.import.so"
"csi.import.so"
"setup-api.import.so"
diff --git a/chicken.import.scm b/chicken.import.scm
index 93b04037..8a97f85d 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -47,12 +47,9 @@
condition?
condition->list
cplxnum?
- cpu-time
current-error-port
current-exception-handler
- current-milliseconds
current-read-table
- current-seconds
delete-file
directory-exists?
(dynamic-load-libraries . chicken.eval#dynamic-load-libraries)
diff --git a/defaults.make b/defaults.make
index 22944694..e636c9fd 100644
--- a/defaults.make
+++ b/defaults.make
@@ -265,7 +265,7 @@ CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile)
PRIMITIVE_IMPORT_LIBRARIES = chicken csi chicken.foreign
DYNAMIC_IMPORT_LIBRARIES = setup-api setup-download srfi-4
DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise flonum format gc io keyword \
- locative posix pretty-print random
+ locative posix pretty-print random time
DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \
eval expand files internal irregex lolevel ports read-syntax \
repl tcp utils
diff --git a/distribution/manifest b/distribution/manifest
index 1f410116..3d9c63ba 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -290,6 +290,8 @@ chicken.repl.import.scm
chicken.repl.import.c
chicken.tcp.import.scm
chicken.tcp.import.c
+chicken.time.import.scm
+chicken.time.import.c
chicken.utils.import.scm
chicken.utils.import.c
srfi-4.import.scm
diff --git a/eval.scm b/eval.scm
index 25620448..d37ff0e1 100644
--- a/eval.scm
+++ b/eval.scm
@@ -73,6 +73,7 @@
(define-foreign-variable uses-soname? bool "C_USES_SONAME")
(define-foreign-variable install-lib-name c-string "C_INSTALL_LIB_NAME")
+;; TODO take these mappings from import files instead
(define-constant core-chicken-modules
'((chicken . chicken-syntax)
(chicken.bitwise . library)
@@ -95,6 +96,7 @@
(chicken.posix . posix)
(chicken.pretty-print . extras)
(chicken.tcp . tcp)
+ (chicken.time . library)
(chicken.repl . repl)
(chicken.read-syntax . read-syntax)
(chicken.utils . utils)))
diff --git a/extras.scm b/extras.scm
index 6a12683b..6f0455c1 100644
--- a/extras.scm
+++ b/extras.scm
@@ -648,7 +648,7 @@
(module chicken.random
(randomize random)
-(import scheme chicken)
+(import scheme chicken chicken.time)
(define (randomize . n)
(let ((nn (if (null? n)
diff --git a/library.scm b/library.scm
index 66d82b9a..2ebdc2d9 100644
--- a/library.scm
+++ b/library.scm
@@ -211,7 +211,6 @@ EOF
(define return-to-host (##core#primitive "C_return_to_host"))
(define ##sys#symbol-table-info (##core#primitive "C_get_symbol_table_info"))
(define ##sys#memory-info (##core#primitive "C_get_memory_info"))
-(define (current-milliseconds) (##core#inline_allocate ("C_a_i_current_milliseconds" 7) #f))
(define ##sys#decode-seconds (##core#primitive "C_decode_seconds"))
(define get-environment-variable (foreign-lambda c-string "C_getenv" c-string))
(define executable-pathname (foreign-lambda c-string* "C_executable_pathname"))
@@ -243,6 +242,15 @@ EOF
(##sys#check-range i 0 (##sys#size x) '##sys#block-set!)
(##sys#setslot x i y) )
+(module chicken.time
+ (cpu-time current-milliseconds current-seconds)
+
+(import scheme)
+(reexport (only chicken time))
+
+(define (current-milliseconds)
+ (##core#inline_allocate ("C_a_i_current_milliseconds" 7) #f))
+
(define (current-seconds)
(##core#inline_allocate ("C_a_get_current_seconds" 7) #f))
@@ -253,7 +261,7 @@ EOF
;; function entry and `buf' contents will have been extracted
;; before `values' gets called.
(##core#inline_allocate ("C_a_i_cpu_time" 8) buf)
- (values (##sys#slot buf 0) (##sys#slot buf 1)))))
+ (values (##sys#slot buf 0) (##sys#slot buf 1))))))
(define (##sys#check-structure x y . loc)
(if (pair? loc)
@@ -4096,7 +4104,7 @@ EOF
;; From SRFI-33
(module chicken.bitwise *
-(import scheme chicken)
+(import scheme)
(define bitwise-and (##core#primitive "C_bitwise_and"))
(define bitwise-ior (##core#primitive "C_bitwise_ior"))
(define bitwise-xor (##core#primitive "C_bitwise_xor"))
diff --git a/modules.scm b/modules.scm
index 62db6e99..d850756f 100644
--- a/modules.scm
+++ b/modules.scm
@@ -933,6 +933,8 @@
(##sys#register-primitive-module 'r5rs-null '() r4rs-syntax))
(##sys#register-module-alias 'r5rs 'scheme)
+
+;; NOTE these are just here for shorthand and can be dropped whenever
(##sys#register-module-alias 'bitwise 'chicken.bitwise)
(##sys#register-module-alias 'continuation 'chicken.continuation)
(##sys#register-module-alias 'data-structures 'chicken.data-structures)
@@ -954,6 +956,7 @@
(##sys#register-module-alias 'repl 'chicken.repl)
(##sys#register-module-alias 'read-syntax 'chicken.read-syntax)
(##sys#register-module-alias 'tcp 'chicken.tcp)
+(##sys#register-module-alias 'time 'chicken.time)
(##sys#register-module-alias 'utils 'chicken.utils)
(register-feature! 'module-environments)
diff --git a/posixunix.scm b/posixunix.scm
index 2e596202..058b8c2a 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -92,7 +92,8 @@
chicken.files
chicken.foreign
chicken.irregex
- chicken.ports)
+ chicken.ports
+ chicken.time)
(include "posix-common.scm")
diff --git a/posixwin.scm b/posixwin.scm
index 84849c1b..4e46662e 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -719,7 +719,8 @@ EOF
chicken.foreign
chicken.irregex
chicken.ports
- chicken.random)
+ chicken.random
+ chicken.time)
(include "posix-common.scm")
diff --git a/rules.make b/rules.make
index d7788e1f..a004bcab 100644
--- a/rules.make
+++ b/rules.make
@@ -522,6 +522,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.bitwise,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.flonum,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.gc,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.keyword,library))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.time,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.format,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.io,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.pretty-print,extras))
@@ -547,7 +548,8 @@ batch-driver.c: batch-driver.scm mini-srfi-1.scm \
chicken.files.import.scm \
chicken.format.import.scm \
chicken.gc.import.scm \
- chicken.pretty-print.import.scm
+ chicken.pretty-print.import.scm \
+ chicken.time.import.scm
c-platform.c: c-platform.scm mini-srfi-1.scm \
chicken.compiler.optimizer.import.scm \
chicken.compiler.support.import.scm \
@@ -563,7 +565,8 @@ c-backend.c: c-backend.scm mini-srfi-1.scm \
chicken.bitwise.import.scm \
chicken.data-structures.import.scm \
chicken.flonum.import.scm \
- chicken.format.import.scm
+ chicken.format.import.scm \
+ chicken.time.import.scm
core.c: core.scm mini-srfi-1.scm \
chicken.compiler.scrutinizer.import.scm \
chicken.compiler.support.import.scm \
@@ -611,7 +614,8 @@ support.c: support.scm mini-srfi-1.scm \
chicken.io.import.scm \
chicken.ports.import.scm \
chicken.pretty-print.import.scm \
- chicken.random.import.scm
+ chicken.random.import.scm \
+ chicken.time.import.scm
modules.c: modules.scm \
chicken.keyword.import.scm
csc.c: csc.scm \
@@ -705,19 +709,22 @@ posixunix.c: posixunix.scm \
chicken.files.import.scm \
chicken.foreign.import.scm \
chicken.irregex.import.scm \
- chicken.ports.import.scm
+ chicken.ports.import.scm \
+ chicken.time.import.scm
posixwin.c: posixwin.scm \
chicken.bitwise.import.scm \
chicken.files.import.scm \
chicken.foreign.import.scm \
chicken.irregex.import.scm \
- chicken.ports.import.scm
+ chicken.ports.import.scm \
+ chicken.time.import.scm
data-structures.c: data-structures.scm \
chicken.foreign.import.scm
expand.c: expand.scm \
chicken.keyword.import.scm
extras.c: extras.scm \
- chicken.data-structures.import.scm
+ chicken.data-structures.import.scm \
+ chicken.time.import.scm
eval.c: eval.scm \
chicken.expand.import.scm \
chicken.foreign.import.scm \
@@ -736,7 +743,8 @@ ports.c: ports.scm \
chicken.io.import.scm
tcp.c: tcp.scm \
chicken.foreign.import.scm \
- chicken.ports.import.scm
+ chicken.ports.import.scm \
+ chicken.time.import.scm
utils.c: utils.scm \
chicken.data-structures.import.scm \
chicken.io.import.scm \
@@ -757,7 +765,8 @@ library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations
-emit-import-library chicken.bitwise \
-emit-import-library chicken.flonum \
-emit-import-library chicken.gc \
- -emit-import-library chicken.keyword
+ -emit-import-library chicken.keyword \
+ -emit-import-library chicken.time
internal.c: $(SRCDIR)internal.scm $(SRCDIR)mini-srfi-1.scm
$(bootstrap-lib) -emit-import-library chicken.internal
eval.c: $(SRCDIR)eval.scm $(SRCDIR)common-declarations.scm $(SRCDIR)mini-srfi-1.scm
diff --git a/support.scm b/support.scm
index b9122536..9c61ded4 100644
--- a/support.scm
+++ b/support.scm
@@ -85,7 +85,8 @@
chicken.io
chicken.ports
chicken.pretty-print
- chicken.random)
+ chicken.random
+ chicken.time)
(include "tweaks")
(include "mini-srfi-1.scm")
diff --git a/tcp.scm b/tcp.scm
index f1c269d5..5f5e5196 100644
--- a/tcp.scm
+++ b/tcp.scm
@@ -145,7 +145,8 @@ EOF
(import scheme chicken)
(import chicken.foreign
- chicken.ports)
+ chicken.ports
+ chicken.time)
(include "common-declarations.scm")
diff --git a/tests/loopy-test.scm b/tests/loopy-test.scm
index 81e49b0f..855e06d2 100644
--- a/tests/loopy-test.scm
+++ b/tests/loopy-test.scm
@@ -1,4 +1,5 @@
-(use (only format printf))
+(use (only format printf)
+ (only time current-milliseconds))
(load-relative "loopy-loop.scm")
(load-relative "matchable.scm")
diff --git a/tests/runtests.sh b/tests/runtests.sh
index d8cd48a9..e1238d38 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -60,6 +60,7 @@ for x in \
chicken.repl.import.so \
chicken.read-syntax.import.so \
chicken.tcp.import.so \
+ chicken.time.import.so \
chicken.utils.import.so
do
cp ../$x test-repository
diff --git a/tests/scrutiny-tests.scm b/tests/scrutiny-tests.scm
index 95c9f22e..9413f075 100644
--- a/tests/scrutiny-tests.scm
+++ b/tests/scrutiny-tests.scm
@@ -20,7 +20,7 @@
(string?) ; expected 1 argument, got 0
-(print (cpu-time)) ; expected 1 result, got 2
+(print (values 1 2)) ; expected 1 result, got 2
(print (values)) ; expected 1 result, got 0
(let ((x 100))
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 490ece11..0182af96 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -25,7 +25,7 @@ Warning: at toplevel:
(scrutiny-tests.scm:21) in procedure call to `string?', expected 1 argument but was given 0 arguments
Warning: at toplevel:
- (scrutiny-tests.scm:23) expected a single result in argument #1 of procedure call `(print (cpu-time))', but received 2 results
+ (scrutiny-tests.scm:23) expected a single result in argument #1 of procedure call `(print (values 1 2))', but received 2 results
Warning: at toplevel:
(scrutiny-tests.scm:24) expected a single result in argument #1 of procedure call `(print (values))', but received zero results
diff --git a/tests/test.scm b/tests/test.scm
index 0db53d06..5c339330 100644
--- a/tests/test.scm
+++ b/tests/test.scm
@@ -2,7 +2,8 @@
;
; by Alex Shinn, lifted from match-test by felix
-(use data-structures) ; for "->string"
+(use data-structures) ; ->string
+(use time) ; current-milliseconds
(define *pass* 0)
(define *fail* 0)
diff --git a/types.db b/types.db
index 00b9c03d..b1a6e60d 100644
--- a/types.db
+++ b/types.db
@@ -971,8 +971,6 @@
(cplxnum? (#(procedure #:pure #:predicate cplxnum) cplxnum? (*) boolean))
-(cpu-time (#(procedure #:clean) cpu-time () fixnum fixnum))
-
(current-error-port
(#(procedure #:clean #:enforce) current-error-port (#!optional output-port) output-port)
((output-port) (let ((#(tmp1) #(1)))
@@ -987,12 +985,15 @@
#(tmp1))))
(() ##sys#current-exception-handler))
-(current-milliseconds (#(procedure #:clean) current-milliseconds () integer))
+;; time
+
+(chicken.time#cpu-time (#(procedure #:clean) chicken.time#cpu-time () fixnum fixnum))
+(chicken.time#current-seconds (#(procedure #:clean) chicken.time#current-seconds () integer))
+(chicken.time#current-milliseconds (#(procedure #:clean) chicken.time#current-milliseconds () integer))
(current-read-table
(#(procedure #:clean) current-read-table (#!optional (struct read-table)) (struct read-table)))
-(current-seconds (#(procedure #:clean) current-seconds () integer))
(delete-file (#(procedure #:clean #:enforce) delete-file (string) string))
(enable-warnings (#(procedure #:clean) enable-warnings (#!optional *) *))
Trap