~ 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