conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Added boolean=? and symbol=?

This commit is contained in:
Abdulaziz Ghuloum 2007-08-28 15:03:21 -04:00
parent 2b6a3ef715
commit e2ca2dffb2
4 changed files with 26 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

25
src/ikarus.predicates.ss
View File

@ -4,15 +4,15 @@
(export fixnum? flonum? bignum? ratnum? number? complex? real? rational? (export fixnum? flonum? bignum? ratnum? number? complex? real? rational?
integer? exact? eof-object? bwp-object? immediate? integer? exact? eof-object? bwp-object? immediate?
boolean? char? vector? bytevector? string? procedure? null? pair? boolean? char? vector? bytevector? string? procedure? null? pair?
symbol? code? not weak-pair? eq? eqv? equal?) symbol? code? not weak-pair? eq? eqv? equal? boolean=?
symbol=?)
(import (import
(except (ikarus) fixnum? flonum? bignum? ratnum? number? complex? real? (except (ikarus) fixnum? flonum? bignum? ratnum? number? complex? real?
rational? integer? exact? eof-object? bwp-object? rational? integer? exact? eof-object? bwp-object?
immediate? boolean? char? vector? bytevector? string? procedure? immediate? boolean? char? vector? bytevector? string? procedure?
null? pair? weak-pair? symbol? code? not eq? eqv? equal? null? pair? weak-pair? symbol? code? not eq? eqv? equal?
port? input-port? output-port?) port? input-port? output-port? boolean=? symbol=?)
(ikarus system $fx) (ikarus system $fx)
(ikarus system $flonums) (ikarus system $flonums)
(ikarus system $pairs) (ikarus system $pairs)
@ -128,8 +128,27 @@
(or (sys:eq? x y) (or (sys:eq? x y)
(and (number? x) (number? y) (= x y))))) (and (number? x) (number? y) (= x y)))))
(define boolean=?
(lambda (x y)
(if (sys:boolean? x)
(if (sys:eq? x y)
#t
(if (sys:boolean? y)
#f
(error 'boolean=? "~s is not a boolean" y)))
(error 'boolean=? "~s is not a boolean" x))))
(define symbol=?
(lambda (x y)
(if (sys:symbol? x)
(if (sys:eq? x y)
#t
(if (sys:symbol? y)
#f
(error 'symbol=? "~s is not a symbol" y)))
(error 'symbol=? "~s is not a symbol" x))))
(module (equal?) (module (equal?)
(define vector-loop (define vector-loop
(lambda (x y i n) (lambda (x y i n)

2
src/makefile.ss
View File

@ -244,6 +244,7 @@
'([void i] '([void i]
[not i r] [not i r]
[boolean? i r] [boolean? i r]
[boolean=? i r]
[null? i r] [null? i r]
[procedure? i r] [procedure? i r]
[eof-object? i r] [eof-object? i r]
@ -462,6 +463,7 @@
[exact->inexact i r] [exact->inexact i r]
[inexact->exact i r] [inexact->exact i r]
[symbol? i r symbols] [symbol? i r symbols]
[symbol=? i r symbols]
[gensym? i symbols] [gensym? i symbols]
[gensym i symbols] [gensym i symbols]
[getprop i symbols] [getprop i symbols]

4
src/todo-r6rs.ss
View File

@ -85,7 +85,7 @@
[assert S ba] [assert S ba]
[assertion-violation S ba] [assertion-violation S ba]
[atan S ba] [atan S ba]
[boolean=? S ba] [boolean=? C ba]
[boolean? C ba] [boolean? C ba]
[car C ba] [car C ba]
[cdr C ba] [cdr C ba]
@ -215,7 +215,7 @@
[string? C ba] [string? C ba]
[substring C ba] [substring C ba]
[symbol->string C ba] [symbol->string C ba]
[symbol=? S ba] [symbol=? C ba]
[symbol? C ba] [symbol? C ba]
[tan S ba] [tan S ba]
[truncate S ba] [truncate S ba]