From cf069c725613ad8d9070d8672248a1d4f089881b Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Mon, 10 Aug 2015 20:57:44 +0200 Subject: [PATCH] Restore type definitions for pure R5RS versions of SRFI-1 and SRFI-13 extended procedures --- data-structures.scm | 1 + types.db | 7 ++++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/data-structures.scm b/data-structures.scm index faa448f..65fdad7 100644 --- a/data-structures.scm +++ b/data-structures.scm @@ -270,6 +270,7 @@ (##sys#slot item 1) default) ) ) +;; TODO: Make inlineable in C without "tst", to be more like assoc? (define (rassoc x lst . tst) (##sys#check-list lst 'rassoc) (let ([tst (if (pair? tst) (car tst) eqv?)]) diff --git a/types.db b/types.db index 54113bc..b169722 100644 --- a/types.db +++ b/types.db @@ -193,7 +193,7 @@ (##core#inline "C_u_i_memq" #(1) #(2)))) (member (forall (a b) (#(procedure #:clean #:foldable) member - (a (list-of b) #!optional (procedure (b a) *)) ; sic + (a (list-of b)) (or false (list-of b)))) ((* null) (let ((#(tmp) #(1))) '#f)) (((or symbol procedure immediate) list) @@ -217,7 +217,7 @@ (##core#inline "C_u_i_assq" #(1) #(2)))) (assoc (forall (a b c) (#(procedure #:clean #:foldable) assoc - (a (list-of (pair b c)) #!optional (procedure (b a) *)) ; sic + (a (list-of (pair b c))) (or false (pair b c)))) ((* null) (let ((#(tmp) #(1))) '#f)) (((or symbol procedure immediate) (list-of pair)) @@ -677,7 +677,7 @@ (string->list (#(procedure #:clean #:enforce) string->list (string) (list-of char))) (list->string (#(procedure #:clean #:enforce) list->string ((list-of char)) string)) (substring (#(procedure #:clean #:enforce) substring (string fixnum #!optional fixnum) string)) -;(string-fill! (#(procedure #:clean #:enforce) string-fill! (string char) string)) - s.a. +(string-fill! (#(procedure #:enforce) string-fill! (string char) string)) (string (#(procedure #:clean #:enforce) string (#!rest char) string)) (vector? (#(procedure #:pure #:predicate vector) vector? (*) boolean)) @@ -1441,6 +1441,7 @@ (chicken.data-structures#o (#(procedure #:clean #:enforce) chicken.data-structures#o (#!rest (procedure (*) *)) (procedure (*) *))) +;; TODO: Should this accept a test procedure? (chicken.data-structures#rassoc (#(procedure #:clean #:enforce #:foldable) chicken.data-structures#rassoc (* (list-of pair) #!optional (procedure (* *) *)) *)) (chicken.data-structures#reverse-string-append (#(procedure #:clean #:enforce) chicken.data-structures#reverse-string-append ((list-of string)) string)) -- 2.1.4