~ chicken-core (chicken-5) ad9f40cb36dea53260059dc091aec88530e9ab4a
commit ad9f40cb36dea53260059dc091aec88530e9ab4a
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Wed May 11 05:21:57 2011 -0400
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Wed May 11 05:21:57 2011 -0400
types.db entries for internal type-checking routines
diff --git a/types.db b/types.db
index 01e85f2d..331cd97a 100644
--- a/types.db
+++ b/types.db
@@ -853,6 +853,61 @@
(warning (procedure warning (#!rest) . *))
(with-exception-handler (procedure! with-exception-handler (procedure procedure) . *))
+;; chicken (internal)
+
+(##sys#foreign-char-argument (procedure! ##sys#foreign-char-argument (char) char)
+ ((char) #(1)))
+(##sys#foreign-fixnum-argument (procedure! ##sys#foreign-fixnum-argument (fixnum) fixnum)
+ ((fixnum) #(1)))
+(##sys#foreign-flonum-argument (procedure! ##sys#foreign-flonum-argument (number) number)
+ ((float) #(1)))
+(##sys#foreign-string-argument (procedure! ##sys#foreign-string-argument (string) string)
+ ((string) #(1)))
+(##sys#foreign-symbol-argument (procedure! ##sys#foreign-symbol-argument (symbol) symbol)
+ ((symbol) #(1)))
+(##sys#foreign-pointer-argument (procedure! ##sys#foreign-pointer-argument (pointer) pointer)
+ ((pointer) #(1)))
+
+(##sys#check-blob (procedure! ##sys#check-blob (blob #!optional *) *)
+ ((blob) (let ((#:tmp #(1))) '#t))
+ ((blob *) (let ((#:tmp #(1))) '#t)))
+(##sys#check-pair (procedure! ##sys#check-pair (pair #!optional *) *)
+ ((pair) (let ((#:tmp #(1))) '#t))
+ ((pair *) (let ((#:tmp #(1))) '#t)))
+(##sys#check-list (procedure! ##sys#check-list (list #!optional *) *)
+ (((or null pair list)) (let ((#:tmp #(1))) '#t))
+ (((or null pair list) *) (let ((#:tmp #(1))) '#t)))
+(##sys#check-string (procedure! ##sys#check-string (string #!optional *) *)
+ ((string) (let ((#:tmp #(1))) '#t))
+ ((string) * (let ((#:tmp #(1))) '#t)))
+(##sys#check-number (procedure! ##sys#check-number (number) *)
+ ((number) (let ((#:tmp #(1))) '#t))
+ ((number *) (let ((#:tmp #(1))) '#t)))
+(##sys#check-exact (procedure! ##sys#check-exact (fixnum #!optional *) *)
+ ((fixnum) (let ((#:tmp #(1))) '#t))
+ ((fixnum *) (let ((#:tmp #(1))) '#t)))
+(##sys#check-inexact (procedure! ##sys#check-inexact (float #!optional *) *)
+ ((float) (let ((#:tmp #(1))) '#t))
+ ((float *) (let ((#:tmp #(1))) '#t)))
+(##sys#check-symbol (procedure! ##sys#check-symbol (symbol #!optional *) *)
+ ((symbol) (let ((#:tmp #(1))) '#t))
+ ((symbol *) (let ((#:tmp #(1))) '#t)))
+(##sys#check-vector (procedure! ##sys#check-vector (vector #!optional *) *)
+ ((vector) (let ((#:tmp #(1))) '#t))
+ ((vector *) (let ((#:tmp #(1))) '#t)))
+(##sys#check-char (procedure! ##sys#check-char (char #!optional *) *)
+ ((char) (let ((#:tmp #(1))) '#t))
+ ((char *) (let ((#:tmp #(1))) '#t)))
+(##sys#check-boolean (procedure! ##sys#check-boolean (boolean #!optional *) *)
+ ((boolean) (let ((#:tmp #(1))) '#t))
+ ((boolean *) (let ((#:tmp #(1))) '#t)))
+(##sys#check-locative (procedure! ##sys#check-locative (locative #!optional *) *)
+ ((locative) (let ((#:tmp #(1))) '#t))
+ ((locative *) (let ((#:tmp #(1))) '#t)))
+(##sys#check-closure (procedure! ##sys#check-closure (procedure #!optional *) *)
+ ((procedure) (let ((#:tmp #(1))) '#t))
+ ((procedure *) (let ((#:tmp #(1))) '#t)))
+
;; data-structures
(->string (procedure ->string (*) string)
Trap