~ chicken-r7rs (master) 1c810fdd9dc4b6fcc52730f9354f36b39282217d
commit 1c810fdd9dc4b6fcc52730f9354f36b39282217d
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Jun 19 20:58:17 2013 +0000
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Wed Jun 19 20:58:17 2013 +0000
Added type declaration and exporting .types files
diff --git a/r7rs.setup b/r7rs.setup
index 9ba36d7..104477e 100644
--- a/r7rs.setup
+++ b/r7rs.setup
@@ -4,14 +4,14 @@
(use make srfi-1)
(define scheme-modules
- '("base" "process-context" "eval")) ;XXX
+ '("process-context" "eval")) ;XXX
(make (("r7rs-compile-time.so" ("r7rs-compile-time.scm" "r7rs-compile-time-module.scm")
(compile -s -O3 -d1 r7rs-compile-time-module.scm -J -o r7rs-compile-time.so)
(compile -s -O3 -d0 r7rs-compile-time.import.scm))
("scheme.base.so" ("scheme.base.scm" "scheme.base-interface.scm"
"synrules.scm")
- (compile -s -O3 -d1 scheme.base.scm -J)
+ (compile -s -O3 -d1 scheme.base.scm -J -emit-type-file scheme.base.types)
(compile -s -O3 -d0 scheme.base.import.scm)))
'("r7rs-compile-time.so" "scheme.base.so"))
@@ -22,7 +22,7 @@
(scm (string-append mname ".scm")))
(make/proc (list (list so (list scm)
(lambda ()
- (compile -s -O3 -d1 ,scm -J)
+ (compile -s -O3 -d1 ,scm -J -emit-type-file ,(string-append mname ".types"))
(compile -s -O3 -d0 ,(string-append mname ".import.scm")))))
(list so))))
scheme-modules)
@@ -35,9 +35,11 @@
'r7rs
`("r7rs.so" "r7rs.import.so"
"r7rs-compile-time.so" "r7rs-compile-time.import.so"
+ "scheme.base.so" "scheme.base.import.so" "scheme.base.types"
,@(append-map
(lambda (mod)
(list (string-append "scheme." mod ".so")
- (string-append "scheme." mod ".import.so")))
+ (string-append "scheme." mod ".import.so")
+ (string-append "scheme." mod ".types")))
scheme-modules))
'((version "0.0.1")))
diff --git a/scheme.base.scm b/scheme.base.scm
index 0eae03c..6f1ebc0 100644
--- a/scheme.base.scm
+++ b/scheme.base.scm
@@ -104,6 +104,10 @@
;;; 6.11. Exceptions
;;;
+(: with-exception-handler ((* -> . *) (-> . *) -> . *))
+(: raise (* -> noreturn))
+(: raise-continuable (* -> . *))
+
;; XXX TODO: This is not threadsafe!
(define-values (with-exception-handler raise raise-continuable)
(let ((exception-handlers
@@ -145,10 +149,17 @@
(lambda ()
((cadr exception-handlers) obj)))))))
+(: error-object? (* -> boolean : (struct condition)))
+(: error-object-message ((struct condition) -> string))
+(: error-object-irritants ((struct condition) -> list))
+
(define error-object? condition?)
(define error-object-message (condition-property-accessor 'exn 'message))
(define error-object-irritants (condition-property-accessor 'exn 'arguments))
+(: read-error? (* -> boolean))
+(: file-error? (* -> boolean))
+
(define-values (read-error? file-error?)
(let ((exn? (condition-predicate 'exn))
(i/o? (condition-predicate 'i/o))
@@ -170,6 +181,12 @@
;;; 6.13. Input and Output
;;;
+(: call-with-port (port (port -> . *) -> . *))
+(: close-port (port -> void))
+(: output-port-open? (output-port -> boolean))
+(: input-port-open? (input-port -> boolean))
+(: eof-object (-> eof))
+
(define (call-with-port port proc)
(receive ret
(proc port)
diff --git a/scheme.eval.scm b/scheme.eval.scm
index fc32f01..c25b0cc 100644
--- a/scheme.eval.scm
+++ b/scheme.eval.scm
@@ -8,6 +8,8 @@
;;; 6.12. Environments and evaluation
;;;
+ (: environment (list -> (struct environment)))
+
(define (environment . specs)
(let ((name (gensym "environment-module-")))
;; create module...
diff --git a/scheme.process-context.scm b/scheme.process-context.scm
index 887f938..2202cf0 100644
--- a/scheme.process-context.scm
+++ b/scheme.process-context.scm
@@ -14,6 +14,10 @@
;;; 6.14. System interface.
;;;
+(: command-line (-> (list-of string)))
+(: exit (* -> noreturn))
+(: emergency-exit (* -> noreturn))
+
(define command-line
(let ((command-line #f)
(arguments (command-line-arguments)))
Trap