~ 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