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 <[email protected]> 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 <[email protected]> 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
_______________________________________________ Chicken-hackers mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-hackers
