[Chicken-hackers] [PATCH] types.db enhancements

[Felix]

The attached patch adds type-declarations and rewrite rules
for some internal procedures and "record-instance?" from the
lolevel unit.


cheers,
felix

>From 6e0c55a1b63e34dc126a13edc816a458bb91093e Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Sun, 23 Sep 2012 00:55:42 +0200
Subject: [PATCH] add type declaration for ##sys#size and specialization rule 
for record-instance?

---
 types.db |   10 +++++++++-
 1 files changed, 9 insertions(+), 1 deletions(-)

diff --git a/types.db b/types.db
index a9a8791..e18a256 100644
--- a/types.db
+++ b/types.db
@@ -1130,6 +1130,7 @@
                     ((procedure *) (let ((#(tmp) #(1))) '#t)))
 (##sys#setslot (#(procedure #:enforce) ##sys#setslot (* fixnum *) *)
               #;((* fixnum immediate) (##sys#setislot #(1) #(2) #(3)))) ; too 
dangerous
+(##sys#size (#(procedure #:pure) ##sys#size (*) fixnum))
 
 
 ;; data-structures
@@ -1495,7 +1496,14 @@
 
 (procedure-data (#(procedure #:clean #:enforce) procedure-data (procedure) *))
 (record->vector (#(procedure #:clean) record->vector (*) vector))
-(record-instance? (#(procedure #:clean) record-instance? (* #!optional symbol) 
boolean))
+
+(record-instance? (#(procedure #:clean) record-instance? (* #!optional symbol) 
boolean)
+                 ((* symbol) (##sys#structure? #(1) #(2)))
+                 ((*) (let ((#(tmp) #(1)))
+                        (if (##sys#immediate? #(tmp))
+                            '#f
+                            (##sys#generic-structure? #(tmp))))))
+
 (record-instance-length (#(procedure #:clean) record-instance-length (*) 
fixnum))
 (record-instance-slot (#(procedure #:clean #:enforce) record-instance-slot (* 
fixnum) *))
 (record-instance-slot-set! (#(procedure #:clean #:enforce) 
record-instance-slot-set! (* fixnum *) undefined))
-- 
1.7.0.4

>From a3e4cba27031c5f74b6636105fb9507030fadf5d Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Sun, 23 Sep 2012 01:14:58 +0200
Subject: [PATCH] add type-declarations and rewrite rules for some internal port 
routines and record-instance? from the lolevel unit

---
 types.db |   26 ++++++++++++++++++++++++++
 1 files changed, 26 insertions(+), 0 deletions(-)

diff --git a/types.db b/types.db
index a9a8791..0125b47 100644
--- a/types.db
+++ b/types.db
@@ -1128,9 +1128,35 @@
 (##sys#check-closure (#(procedure #:clean #:enforce) ##sys#check-closure 
(procedure #!optional *) *)
                     ((procedure) (let ((#(tmp) #(1))) '#t))
                     ((procedure *) (let ((#(tmp) #(1))) '#t)))
+
+(##sys#check-port 
+ (#(procedure #:clean #:enforce) ##sys#check-port ((or input-port output-port) 
#!optional *)
+  *)
+ (((or input-port output-port)) (let ((#(tmp) #(1))) '#t))
+ (((or input-port output-port) *) (let ((#(tmp) #(1))) '#t)))
+
+(##sys#check-input-port
+ (#(procedure #:clean #:enforce) ##sys#check-input-port (input-port * 
#!optional *) *)
+ ((* *) (##core#inline "C_i_check_port" #(1) '#t #(2)))
+ ((* * *) (##core#inline "C_i_check_port_2" #(1) '#t #(2) #(3))))
+
+(##sys#check-output-port
+ (#(procedure #:clean #:enforce) ##sys#check-output-port (output-port * 
#!optional *) *)
+ ((* *) (##core#inline "C_i_check_port" #(1) '#f #(2)))
+ ((* * *) (##core#inline "C_i_check_port_2" #(1) '#f #(2) #(3))))
+
+(##sys#check-open-port
+ (#(procedure #:clean #:enforce) ##sys#check-open-port ((or input-port 
output-port) #!optional *) *)
+ ((*) (##core#inline "C_i_check_port" #(1) '0 '#t))
+ ((* *) (##core#inline "C_i_check_port_2" #(1) '0 '#t #(2))))
+
 (##sys#setslot (#(procedure #:enforce) ##sys#setslot (* fixnum *) *)
               #;((* fixnum immediate) (##sys#setislot #(1) #(2) #(3)))) ; too 
dangerous
 
+(##sys#standard-input input-port)
+(##sys#standard-output output-port)
+(##sys#standard-error output-port)
+
 
 ;; data-structures
 
-- 
1.7.0.4