~ chicken-core (chicken-5) 782c15b91bc088bebe1636bced3bd02e87baa0dc
commit 782c15b91bc088bebe1636bced3bd02e87baa0dc
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Wed Jan 13 09:05:46 2016 +1300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:33 2016 +1300
Move continuations API to new chicken.continuation module
diff --git a/README b/README
index 3a1146bc..7fb57d91 100644
--- a/README
+++ b/README
@@ -286,6 +286,7 @@
| |-- chicken
| | `-- 8
| | |-- chicken.import.so
+ | | |-- chicken.continuation.import.so
| | |-- chicken.data-structures.import.so
| | |-- chicken.eval.import.so
| | |-- chicken.expand.import.so
diff --git a/c-platform.scm b/c-platform.scm
index 1419de4b..1bccf350 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -210,7 +210,8 @@
##sys#check-char ##sys#check-vector ##sys#check-byte-vector ##sys#list ##sys#cons
##sys#call-with-values ##sys#flonum-in-fixnum-range?
##sys#fudge ##sys#immediate? ##sys#context-switch
- ##sys#make-structure ##sys#apply ##sys#apply-values ##sys#continuation-graft
+ ##sys#make-structure ##sys#apply ##sys#apply-values
+ chicken.continuation#continuation-graft
##sys#bytevector? ##sys#make-vector ##sys#setter ##sys#car ##sys#cdr ##sys#pair?
##sys#eq? ##sys#list? ##sys#vector? ##sys#eqv? ##sys#get-keyword
##sys#foreign-char-argument ##sys#foreign-fixnum-argument ##sys#foreign-flonum-argument
@@ -410,7 +411,7 @@
(rewrite '##sys#call-with-values 13 2 "C_u_call_with_values" #f)
(rewrite '##sys#call-with-values 13 2 "C_call_with_values" #t)
(rewrite 'chicken.lolevel#locative-ref 13 1 "C_locative_ref" #t)
-(rewrite '##sys#continuation-graft 13 2 "C_continuation_graft" #t)
+(rewrite 'chicken.continuation#continuation-graft 13 2 "C_continuation_graft" #t)
(rewrite 'caar 2 1 "C_u_i_caar" #f)
(rewrite 'cdar 2 1 "C_u_i_cdar" #f)
diff --git a/chicken-install.scm b/chicken-install.scm
index 35302baf..d1924685 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -45,7 +45,8 @@
(define +default-repository-files+
;;XXX keep this up-to-date!
- '("chicken.data-structures.import.so"
+ '("chicken.continuation.import.so"
+ "chicken.data-structures.import.so"
"chicken.eval.import.so"
"chicken.expand.import.so"
"chicken.extras.import.so"
diff --git a/chicken.import.scm b/chicken.import.scm
index 39dad630..b8408c34 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -52,10 +52,6 @@
condition-property-accessor
condition?
condition->list
- continuation-capture
- continuation-graft
- continuation-return
- continuation?
copy-read-table
cplxnum?
cpu-time
diff --git a/continuation.scm b/continuation.scm
new file mode 100644
index 00000000..78aa2544
--- /dev/null
+++ b/continuation.scm
@@ -0,0 +1,65 @@
+;;;; continuation.scm - A better API for continuations
+;
+; Copyright (c) 2008-2016, The CHICKEN Team
+; Copyright (c) 2000-2007, Felix L. Winkelmann
+; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
+; conditions are met:
+;
+; Redistributions of source code must retain the above copyright notice, this list of conditions and the following
+; disclaimer.
+; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
+; disclaimer in the documentation and/or other materials provided with the distribution.
+; Neither the name of the author nor the names of its contributors may be used to endorse or promote
+; products derived from this software without specific prior written permission.
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
+; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+; POSSIBILITY OF SUCH DAMAGE.
+
+(declare
+ (unit continuation)
+ (disable-interrupts))
+
+(foreign-declare "#define C_direct_continuation(dummy) t1")
+
+;; XXX Is this still used anywhere?
+(define (##sys#call-with-direct-continuation k)
+ (##core#app k (##core#inline "C_direct_continuation" #f)))
+
+(module chicken.continuation
+ (continuation?
+ continuation-capture
+ continuation-graft
+ continuation-return)
+
+(import scheme chicken)
+
+(include "common-declarations.scm")
+
+(define (continuation-capture proc)
+ (let ((winds ##sys#dynamic-winds)
+ (k (##core#inline "C_direct_continuation" #f)))
+ (proc (##sys#make-structure 'continuation k winds))))
+
+(define (continuation? x)
+ (##sys#structure? x 'continuation))
+
+(define (continuation-graft k thunk)
+ (##sys#check-structure k 'continuation 'continuation-graft)
+ (let ([winds (##sys#slot k 2)])
+ (unless (eq? ##sys#dynamic-winds winds)
+ (##sys#dynamic-unwind winds (fx- (length ##sys#dynamic-winds) (length winds))))
+ ((##core#primitive "C_continuation_graft") k thunk)))
+
+(define continuation-return
+ (lambda (k . vals)
+ (##sys#check-structure k 'continuation 'continuation-return)
+ ((##core#primitive "C_continuation_graft") k (lambda () (apply values vals))))))
diff --git a/defaults.make b/defaults.make
index 41a5212d..65ccce10 100644
--- a/defaults.make
+++ b/defaults.make
@@ -266,7 +266,7 @@ PRIMITIVE_IMPORT_LIBRARIES = chicken csi chicken.foreign
POSIX_IMPORT_LIBRARY = chicken.posix
DYNAMIC_IMPORT_LIBRARIES = setup-api setup-download srfi-4
DYNAMIC_CHICKEN_IMPORT_LIBRARIES = data-structures eval repl expand \
- extras files internal irregex lolevel ports tcp utils
+ continuation extras files internal irregex lolevel ports tcp utils
# targets
diff --git a/distribution/manifest b/distribution/manifest
index d3cd94c5..51c4f6ba 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -19,6 +19,7 @@ chicken.compiler.core.import.scm
csc.c
csi.c
eval.c
+continuation.c
data-structures.c
ports.c
files.c
@@ -74,6 +75,7 @@ files.scm
chicken-bug.1
chicken-bug.scm
chicken-bug.c
+continuation.scm
library.scm
lolevel.scm
optimizer.scm
@@ -242,6 +244,8 @@ chicken-syntax.c
common-declarations.scm
chicken.import.scm
chicken.import.c
+chicken.continuation.import.scm
+chicken.continuation.import.c
chicken.data-structures.import.scm
chicken.data-structures.import.c
chicken.eval.import.scm
@@ -334,6 +338,7 @@ manual-html/Supported language.html
manual-html/The R5RS standard.html
manual-html/The User's Manual.html
manual-html/Types.html
+manual-html/Unit continuation.html
manual-html/Unit data-structures.html
manual-html/Unit eval.html
manual-html/Unit expand.html
diff --git a/eval.scm b/eval.scm
index a9b090ad..7bb00ae8 100644
--- a/eval.scm
+++ b/eval.scm
@@ -74,6 +74,7 @@
(define-constant core-chicken-modules
'((chicken . chicken-syntax)
+ (chicken.continuation . continuation)
(chicken.data-structures . data-structures)
(chicken.eval . eval)
(chicken.expand . expand)
diff --git a/library.scm b/library.scm
index 2f35b7af..49688678 100644
--- a/library.scm
+++ b/library.scm
@@ -62,8 +62,6 @@
#define C_free_mptr(p, i) (C_free((void *)C_block_item(p, C_unfix(i))), C_SCHEME_UNDEFINED)
#define C_free_sptr(p, i) (C_free((void *)(((C_char **)C_block_item(p, 0))[ C_unfix(i) ])), C_SCHEME_UNDEFINED)
-#define C_direct_continuation(dummy) t1
-
#define C_a_get_current_seconds(ptr, c, dummy) C_int64_to_num(ptr, time(NULL))
#define C_peek_c_string_at(ptr, i) ((C_char *)(((C_char **)ptr)[ i ]))
@@ -2333,7 +2331,6 @@ EOF
(define (procedure? x) (##core#inline "C_i_closurep" x))
(define apply (##core#primitive "C_apply"))
(define ##sys#call-with-current-continuation (##core#primitive "C_call_cc"))
-(define (##sys#call-with-direct-continuation k) (##core#app k (##core#inline "C_direct_continuation" #f)))
(define ##sys#call-with-cthulhu (##core#primitive "C_call_with_cthulhu"))
(define values (##core#primitive "C_values"))
(define call-with-values (##core#primitive "C_call_with_values"))
@@ -2450,28 +2447,6 @@ EOF
(after)
(##sys#dynamic-unwind winds (fx- n 1)) ) ] ) )
-(define (continuation-capture proc)
- (let ([winds ##sys#dynamic-winds]
- [k (##core#inline "C_direct_continuation" #f)] )
- (proc (##sys#make-structure 'continuation k winds))) )
-
-(define (continuation? x)
- (##sys#structure? x 'continuation) )
-
-(define ##sys#continuation-graft (##core#primitive "C_continuation_graft"))
-
-(define (continuation-graft k thunk)
- (##sys#check-structure k 'continuation 'continuation-graft)
- (let ([winds (##sys#slot k 2)])
- (unless (eq? ##sys#dynamic-winds winds)
- (##sys#dynamic-unwind winds (fx- (length ##sys#dynamic-winds) (length winds))) )
- (##sys#continuation-graft k thunk) ) )
-
-(define continuation-return
- (lambda (k . vals)
- (##sys#check-structure k 'continuation 'continuation-return)
- (continuation-graft k (lambda () (apply values vals))) ) )
-
;;; Ports:
diff --git a/manual/Supported language b/manual/Supported language
index 0c5eadfe..20d0128c 100644
--- a/manual/Supported language
+++ b/manual/Supported language
@@ -27,6 +27,7 @@
* [[Unit utils]] Shell scripting and file operations
* [[Unit tcp]] Basic TCP-sockets
* [[Unit lolevel]] Low-level operations
+* [[Unit continuation]] Continuations
---
Previous: [[Using the interpreter]]
diff --git a/manual/Unit continuation b/manual/Unit continuation
new file mode 100644
index 00000000..3ac54c9b
--- /dev/null
+++ b/manual/Unit continuation
@@ -0,0 +1,62 @@
+[[tags: manual]]
+[[toc:]]
+
+== Unit continuation
+
+This unit provides a more powerful interface for continuations than that
+provided by {{call/cc}}.
+
+More information about this continuation API can be found in the paper
+[[http://repository.readscheme.org/ftp/papers/sw2001/feeley.pdf]] ''A Better
+API for first class Continuations'' by Marc Feeley.
+
+
+=== Continuations API
+
+==== continuation-capture
+
+<procedure>(continuation-capture PROCEDURE)</procedure>
+
+Creates a continuation object representing the current continuation and
+tail-calls {{PROCEDURE}} with this continuation as the single argument.
+
+
+
+==== continuation?
+
+<procedure>(continuation? X)</procedure>
+
+Returns {{#t}} if {{X}} is a continuation object, or {{#f}} otherwise. Please
+note that this applies only to continuations created by the Continuation API,
+but not by call/cc, i.e.: {{(call-with-current-continuation continuation?)}}
+returns {{#f}}, whereas {{(continuation-capture continuation?)}} returns
+{{#t}}.
+
+
+==== continuation-graft
+
+<procedure>(continuation-graft CONT THUNK)</procedure>
+
+Calls the procedure {{THUNK}} with no arguments and the implicit continuation
+{{CONT}}.
+
+
+==== continuation-return
+
+<procedure>(continuation-return CONT VALUE ...)</procedure>
+
+Returns the value(s) to the continuation {{CONT}}. {{continuation-return}} could
+be implemented like this:
+
+<enscript highlight=scheme>
+(define (continuation-return k . vals)
+ (continuation-graft
+ k
+ (lambda () (apply values vals))))
+</enscript>
+
+
+----
+Previous: [[Unit lolevel]]
+
+Next: [[Interface to external functions and variables]]
diff --git a/manual/Unit library b/manual/Unit library
index 0c65ef4b..e915cc3e 100644
--- a/manual/Unit library
+++ b/manual/Unit library
@@ -1227,53 +1227,6 @@ Ignores {{ARGUMENT ...}} and returns an unspecified value.
An alias for {{call-with-current-continuation}}.
-==== continuation-capture
-
-<procedure>(continuation-capture PROCEDURE)</procedure>
-
-Creates a continuation object representing the current continuation and
-tail-calls {{PROCEDURE}} with this continuation as the single argument.
-
-More information about this continuation API can be found in the paper
-[[http://repository.readscheme.org/ftp/papers/sw2001/feeley.pdf]] ''A Better
-API for first class Continuations'' by Marc Feeley.
-
-
-==== continuation?
-
-<procedure>(continuation? X)</procedure>
-
-Returns {{#t}} if {{X}} is a continuation object, or {{#f}} otherwise. Please
-note that this applies only to continuations created by the Continuation API,
-but not by call/cc, i.e.: {{(call-with-current-continuation continuation?)}}
-returns {{#f}}, whereas {{(continuation-capture continuation?)}} returns
-{{#t}}.
-
-
-==== continuation-graft
-
-<procedure>(continuation-graft CONT THUNK)</procedure>
-
-Calls the procedure {{THUNK}} with no arguments and the implicit continuation
-{{CONT}}.
-
-
-==== continuation-return
-
-<procedure>(continuation-return CONT VALUE ...)</procedure>
-
-Returns the value(s) to the continuation {{CONT}}. {{continuation-return}} could
-be implemented like this:
-
-<enscript highlight=scheme>
-(define (continuation-return k . vals)
- (continuation-graft
- k
- (lambda () (apply values vals)) ) )
-</enscript>
-
-
-
=== Setters
SRFI-17 is fully implemented. For more information see:
diff --git a/manual/Unit lolevel b/manual/Unit lolevel
index 9c8b3a9e..28d2b063 100644
--- a/manual/Unit lolevel
+++ b/manual/Unit lolevel
@@ -687,4 +687,4 @@ identical in behaviour to the result of {{OLD}}:
---
Previous: [[Unit tcp]]
-Next: [[Interface to external functions and variables]]
+Next: [[Unit continuation]]
diff --git a/modules.scm b/modules.scm
index 9f906453..32a66a40 100644
--- a/modules.scm
+++ b/modules.scm
@@ -931,6 +931,7 @@
(##sys#register-primitive-module 'r5rs-null '() r4rs-syntax))
(##sys#register-module-alias 'r5rs 'scheme)
+(##sys#register-module-alias 'continuation 'chicken.continuation)
(##sys#register-module-alias 'data-structures 'chicken.data-structures)
(##sys#register-module-alias 'extras 'chicken.extras)
(##sys#register-module-alias 'expand 'chicken.expand)
diff --git a/rules.make b/rules.make
index ad8b8d02..fa77c327 100644
--- a/rules.make
+++ b/rules.make
@@ -37,7 +37,7 @@ SETUP_API_OBJECTS_1 = setup-api setup-download
LIBCHICKEN_SCHEME_OBJECTS_1 = \
library eval repl data-structures ports files extras lolevel utils tcp srfi-4 \
- $(POSIXFILE) internal irregex scheduler debugger-client \
+ continuation $(POSIXFILE) internal irregex scheduler debugger-client \
profiler stub expand modules chicken-syntax chicken-ffi-syntax build-version
LIBCHICKEN_OBJECTS_1 = $(LIBCHICKEN_SCHEME_OBJECTS_1) runtime
LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O))
@@ -729,6 +729,8 @@ chicken-syntax.c: $(SRCDIR)chicken-syntax.scm $(SRCDIR)common-declarations.scm $
$(bootstrap-lib)
chicken-ffi-syntax.c: $(SRCDIR)chicken-ffi-syntax.scm $(SRCDIR)common-declarations.scm $(SRCDIR)mini-srfi-1.scm
$(bootstrap-lib)
+continuation.c: $(SRCDIR)continuation.scm $(SRCDIR)common-declarations.scm
+ $(bootstrap-lib) -emit-import-library chicken.continuation
data-structures.c: $(SRCDIR)data-structures.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -emit-import-library chicken.data-structures
ports.c: $(SRCDIR)ports.scm $(SRCDIR)common-declarations.scm
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 4756fafe..b279ae88 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -39,6 +39,7 @@ for x in \
chicken.import.so csi.import.so types.db \
setup-api.so setup-api.import.so srfi-4.import.so \
setup-download.so setup-download.import.so \
+ chicken.continuation.import.so \
chicken.data-structures.import.so \
chicken.extras.import.so \
chicken.files.import.so \
diff --git a/types.db b/types.db
index dad70c1b..93cd59f5 100644
--- a/types.db
+++ b/types.db
@@ -935,11 +935,11 @@
(condition? (#(procedure #:pure #:predicate (struct condition)) condition? (*) boolean))
(condition->list (#(procedure #:clean #:enforce) condition->list ((struct condition)) (list-of (pair symbol *))))
-(continuation-capture (#(procedure #:enforce) continuation-capture ((procedure ((struct continuation)) . *)) *))
-(continuation-graft (#(procedure #:clean #:enforce) continuation-graft ((struct continuation) (procedure () . *)) *))
-(continuation-return (#(procedure #:enforce) continuation-return ((struct continuation) #!rest) . *)) ;XXX make return type more specific?
-(continuation? (#(procedure #:pure #:predicate (struct continuation)) continuation? (*) boolean))
+(chicken.continuation#continuation-capture (#(procedure #:enforce) chicken.continuation#continuation-capture ((procedure ((struct continuation)) . *)) *))
+(chicken.continuation#continuation-graft (#(procedure #:clean #:enforce) chicken.continuation#continuation-graft ((struct continuation) (procedure () . *)) *))
+(chicken.continuation#continuation-return (#(procedure #:enforce) chicken.continuation#continuation-return ((struct continuation) #!rest) . *)) ;XXX make return type more specific?
+(chicken.continuation#continuation? (#(procedure #:pure #:predicate (struct continuation)) chicken.continuation#continuation? (*) boolean))
(copy-read-table (#(procedure #:clean #:enforce) copy-read-table ((struct read-table)) (struct read-table)))
Trap