20071025 16:27:34 04:00



;;; Ikarus Scheme  A compiler for R6RS Scheme.

20080129 00:34:34 05:00



;;; Copyright (C) 2006,2007,2008 Abdulaziz Ghuloum

20071025 16:27:34 04:00



;;;




;;; This program is free software: you can redistribute it and/or modify




;;; it under the terms of the GNU General Public License version 3 as




;;; published by the Free Software Foundation.




;;;




;;; This program is distributed in the hope that it will be useful, but




;;; WITHOUT ANY WARRANTY; without even the implied warranty of




;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU




;;; General Public License for more details.




;;;




;;; You should have received a copy of the GNU General Public License




;;; along with this program. If not, see <http://www.gnu.org/licenses/>.





20070505 03:24:33 04:00







(library (ikarus predicates)

20070505 03:34:59 04:00




20080518 23:39:41 04:00



(export fixnum? flonum? bignum? ratnum? compnum?




number? complex? real? rational?

20070903 00:34:53 04:00



integer? exact? inexact? eofobject? bwpobject? immediate?

20070515 12:42:52 04:00



boolean? char? vector? bytevector? string? procedure? null? pair?

20070828 15:03:21 04:00



symbol? code? not weakpair? eq? eqv? equal? boolean=?

20070912 03:10:54 04:00



symbol=? finite? infinite? nan? realvalued?

20071210 07:28:03 05:00



rationalvalued? integervalued? transcoder?)

20070505 03:24:33 04:00



(import

20080518 23:39:41 04:00



(except (ikarus) fixnum? flonum? bignum? ratnum? compnum?




number? complex? real?

20070903 00:34:53 04:00



rational? integer? exact? inexact? eofobject? bwpobject?

20070515 12:42:52 04:00



immediate? boolean? char? vector? bytevector? string? procedure?

20070506 22:48:10 04:00



null? pair? weakpair? symbol? code? not eq? eqv? equal?

20071210 07:28:03 05:00



transcoder? boolean=? symbol=?

20070912 03:10:54 04:00



finite? infinite? nan? realvalued? rationalvalued?




integervalued?)

20070506 18:43:04 04:00



(ikarus system $fx)

20070613 02:03:30 04:00



(ikarus system $flonums)

20070506 18:43:04 04:00



(ikarus system $pairs)




(ikarus system $chars)




(ikarus system $strings)




(ikarus system $vectors)

20080518 23:39:41 04:00



;(ikarus system $compnums)




(rename (only (ikarus) fixnum? flonum? bignum? ratnum? compnum?




eofobject?

20070505 06:15:25 04:00



bwpobject? immediate? boolean? char? vector? string?

20070515 12:42:52 04:00



bytevector? procedure? null? pair? symbol? code? eq?

20071210 07:28:03 05:00



transcoder?)

20070505 03:24:33 04:00



(fixnum? sys:fixnum?)




(flonum? sys:flonum?)

20070505 03:27:53 04:00



(bignum? sys:bignum?)

20070520 23:23:54 04:00



(ratnum? sys:ratnum?)

20080518 23:39:41 04:00



(compnum? sys:compnum?)

20070505 03:27:53 04:00



(eofobject? sys:eofobject?)

20070505 06:15:25 04:00



(bwpobject? sys:bwpobject?)

20070505 03:34:59 04:00



(immediate? sys:immediate?)




(boolean? sys:boolean?)




(char? sys:char?)




(vector? sys:vector?)

20070515 12:42:52 04:00



(bytevector? sys:bytevector?)

20070505 03:34:59 04:00



(string? sys:string?)




(procedure? sys:procedure?)




(null? sys:null?)




(pair? sys:pair?)

20070505 05:09:15 04:00



(symbol? sys:symbol?)

20070506 22:48:10 04:00



(code? sys:code?)

20070505 17:44:24 04:00



(eq? sys:eq?)

20071206 05:05:26 05:00



(transcoder? sys:transcoder?)

20070505 17:44:24 04:00



))

20070505 03:24:33 04:00







(define fixnum?




(lambda (x) (sys:fixnum? x)))








(define bignum?




(lambda (x) (sys:bignum? x)))





20070520 23:23:54 04:00



(define ratnum?




(lambda (x) (sys:ratnum? x)))





20070505 03:24:33 04:00



(define flonum?




(lambda (x) (sys:flonum? x)))





20080518 23:39:41 04:00



(define compnum?




(lambda (x) (sys:compnum? x)))





20070505 03:24:33 04:00



(define number?




(lambda (x)




(or (sys:fixnum? x)




(sys:bignum? x)

20070520 23:23:54 04:00



(sys:flonum? x)

20080518 23:39:41 04:00



(sys:ratnum? x)




(sys:compnum? x))))

20070505 03:24:33 04:00







(define complex?




(lambda (x) (number? x)))








(define real?

20080518 23:39:41 04:00



(lambda (x)




(or (sys:fixnum? x)




(sys:bignum? x)




(sys:flonum? x)




(sys:ratnum? x))))

20070912 03:10:54 04:00







(define realvalued?

20080518 23:39:41 04:00



(lambda (x) (real? x)))

20070912 03:10:54 04:00




20070505 03:24:33 04:00



(define rational?




(lambda (x)




(cond




[(sys:fixnum? x) #t]




[(sys:bignum? x) #t]

20070520 23:23:54 04:00



[(sys:ratnum? x) #t]

20070613 02:03:30 04:00



[(sys:flonum? x) ($flonumrational? x)]

20070912 03:10:54 04:00



[else #f])))








(define rationalvalued?




(lambda (x) (rational? x)))

20070505 03:24:33 04:00







(define integer?




(lambda (x)




(cond




[(sys:fixnum? x) #t]




[(sys:bignum? x) #t]

20070520 23:23:54 04:00



[(sys:ratnum? x) #f]

20070613 02:03:30 04:00



[(sys:flonum? x) ($flonuminteger? x)]

20070505 03:24:33 04:00



[else #f])))





20070912 03:10:54 04:00



(define integervalued?




(lambda (x) (integer? x)))





20070505 03:24:33 04:00



(define exact?




(lambda (x)




(cond




[(sys:fixnum? x) #t]




[(sys:bignum? x) #t]

20070613 02:03:30 04:00



[(sys:ratnum? x) #t]

20070505 03:24:33 04:00



[(sys:flonum? x) #f]

20080518 23:39:41 04:00



[(sys:compnum? x) #t]

20070505 03:24:33 04:00



[else

20071215 08:22:49 05:00



(die 'exact? "not a number" x)])))

20070505 03:27:53 04:00




20070903 00:34:53 04:00







(define inexact?




(lambda (x)




(cond




[(sys:flonum? x) #t]




[(sys:fixnum? x) #f]




[(sys:bignum? x) #f]




[(sys:ratnum? x) #f]

20080518 23:39:41 04:00



[(sys:compnum? x) #f]

20070903 00:34:53 04:00



[else

20071215 08:22:49 05:00



(die 'inexact? "not a number" x)])))

20070903 00:34:53 04:00




20070912 02:44:19 04:00



(define finite?




(lambda (x)




(cond




[(sys:flonum? x) (flfinite? x)]




[(sys:fixnum? x) #t]




[(sys:bignum? x) #t]




[(sys:ratnum? x) #t]

20080518 23:39:41 04:00



[(sys:compnum? x) #t]

20070912 02:44:19 04:00



[else

20071215 08:22:49 05:00



(die 'finite? "not a number" x)])))

20070912 02:44:19 04:00







(define infinite?




(lambda (x)




(cond




[(sys:flonum? x) (flinfinite? x)]




[(sys:fixnum? x) #f]




[(sys:bignum? x) #f]




[(sys:ratnum? x) #f]

20080518 23:39:41 04:00



[(sys:compnum? x) #f]

20070912 02:44:19 04:00



[else

20071215 08:22:49 05:00



(die 'infinite? "not a number" x)])))

20070912 02:44:19 04:00







(define nan?




(lambda (x)




(cond




[(sys:flonum? x) (flnan? x)]




[(sys:fixnum? x) #f]




[(sys:bignum? x) #f]




[(sys:ratnum? x) #f]

20080518 23:39:41 04:00



[(sys:compnum? x) #f]

20070912 02:44:19 04:00



[else

20071215 08:22:49 05:00



(die 'nan? "not a number" x)])))

20070912 02:44:19 04:00
















20070505 03:34:59 04:00



(define eofobject? (lambda (x) (sys:eofobject? x)))

20070505 06:15:25 04:00



(define bwpobject? (lambda (x) (sys:bwpobject? x)))

20071206 05:05:26 05:00



(define transcoder? (lambda (x) (sys:transcoder? x)))

20070505 03:34:59 04:00



(define immediate? (lambda (x) (sys:immediate? x)))




(define boolean? (lambda (x) (sys:boolean? x)))




(define char? (lambda (x) (sys:char? x)))




(define vector? (lambda (x) (sys:vector? x)))

20070515 12:42:52 04:00



(define bytevector? (lambda (x) (sys:bytevector? x)))

20070505 03:34:59 04:00



(define string? (lambda (x) (sys:string? x)))




(define procedure? (lambda (x) (sys:procedure? x)))




(define null? (lambda (x) (sys:null? x)))




(define pair? (lambda (x) (sys:pair? x)))




(define symbol? (lambda (x) (sys:symbol? x)))

20070506 22:48:10 04:00



(define code? (lambda (x) (sys:code? x)))

20070505 06:18:29 04:00











(define weakpair?




(lambda (x)




(and (pair? x)




(foreigncall "ikrt_is_weak_pair" x))))





20070505 04:28:40 04:00



(define not (lambda (x) (if x #f #t)))

20070505 05:09:15 04:00







(define eq? (lambda (x y) (sys:eq? x y)))





20070505 05:10:38 04:00



(define eqv?




(lambda (x y)




(or (sys:eq? x y)




(and (number? x) (number? y) (= x y)))))

20070505 05:35:09 04:00




20070828 15:03:21 04:00



(define boolean=?




(lambda (x y)




(if (sys:boolean? x)




(if (sys:eq? x y)




#t




(if (sys:boolean? y)




#f

20071215 08:22:49 05:00



(die 'boolean=? "not a boolean" y)))




(die 'boolean=? "not a boolean" x))))

20070828 15:03:21 04:00




20070505 05:35:09 04:00




20070828 15:03:21 04:00



(define symbol=?




(lambda (x y)




(if (sys:symbol? x)




(if (sys:eq? x y)




#t




(if (sys:symbol? y)




#f

20071215 08:22:49 05:00



(die 'symbol=? "not a symbol" y)))




(die 'symbol=? "not a symbol" x))))

20070505 05:35:09 04:00







(module (equal?)




(define vectorloop




(lambda (x y i n)




(or ($fx= i n)




(and (equal? ($vectorref x i) ($vectorref y i))




(vectorloop x y ($fxadd1 i) n)))))




(define stringloop




(lambda (x y i n)




(or ($fx= i n)




(and ($char= ($stringref x i) ($stringref y i))




(stringloop x y ($fxadd1 i) n)))))




(define equal?




(lambda (x y)




(cond




[(sys:eq? x y) #t]




[(pair? x)




(and (pair? y)




(equal? ($car x) ($car y))




(equal? ($cdr x) ($cdr y)))]




[(vector? x)




(and (vector? y)




(let ([n ($vectorlength x)])




(and ($fx= n ($vectorlength y))




(vectorloop x y 0 n))))]




[(string? x)




(and (string? y)




(let ([n ($stringlength x)])




(and ($fx= n ($stringlength y))




(stringloop x y 0 n))))]




[(number? x) (and (number? y) (= x y))]

20070911 00:13:10 04:00



[(sys:bytevector? x)




(and (sys:bytevector? y) (bytevector=? x y))]

20070505 05:35:09 04:00



[else #f]))))





20070505 17:44:24 04:00




20070505 03:27:53 04:00



)
