klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

booleans.k (5104B)


      1 ;; check.k & test-helpers.k should be loaded
      2 
      3 ;;;
      4 ;;; Basic Functionality
      5 ;;;
      6 
      7 ;; boolean?
      8 ($check-predicate (applicative? boolean?))
      9 ($check-predicate (boolean?))
     10 ($check-predicate (boolean? #t))
     11 ($check-predicate (boolean? #f))
     12 ($check-predicate (boolean? #t #t #f #f))
     13 ($check-predicate (boolean? #f . #0=(#t . #0#)))
     14 
     15 ($check-not-predicate (boolean? ((unwrap list) . symbol)))
     16 ($check-not-predicate (boolean? ()))
     17 ($check-not-predicate (boolean? (cons () ())))
     18 ($check-not-predicate (boolean? #ignore))
     19 ($check-not-predicate (boolean? (make-environment)))
     20 ($check-not-predicate (boolean? #inert))
     21 ($check-not-predicate (boolean? $vau))
     22 ($check-not-predicate (boolean? wrap))
     23 ($check-not-predicate (boolean? (call/cc ($lambda (c) c))))
     24 ($check-not-predicate (boolean? ($let (((enc . #ignore) 
     25                                         (make-encapsulation-type)))
     26                                   (enc #inert))))
     27 ($check-not-predicate (boolean? (memoize #inert)))
     28 ($check-not-predicate (boolean? 1))
     29 ($check-not-predicate (boolean? -1/2))
     30 ($check-not-predicate (boolean? 1.0))
     31 ($check-not-predicate (boolean? #e+infinity))
     32 ($check-not-predicate (boolean? #i+infinity))
     33 ($check-not-predicate (boolean? #undefined))
     34 ($check-not-predicate (boolean? #real))
     35 ($check-not-predicate (boolean? "string"))
     36 ($check-not-predicate (boolean? #\a))
     37 ($check-not-predicate (boolean? (get-current-input-port)))
     38 
     39 ;; basic eq?-ness and not?
     40 ($check-predicate (applicative? not?))
     41 
     42 ($check eq? #t #t)
     43 ($check eq? #f #f)
     44 ($check not-eq? #t #f)
     45 ($check not-eq? #f #t)
     46 ($check eq? (not? #t) #f)
     47 ($check eq? (not? #f) #t)
     48 
     49 ;; basic equal?-ness and not?
     50 ($check equal? #t #t)
     51 ($check equal? #f #f)
     52 ($check not-equal? #t #f)
     53 ($check not-equal? #f #t)
     54 ($check equal? (not? #t) #f)
     55 ($check equal? (not? #f) #t)
     56 
     57 ;; and? & or?
     58 ($check-predicate (applicative? and?))
     59 ($check-predicate (and?))
     60 ($check-predicate (and? #t))
     61 ($check-predicate (and? #t #t))
     62 ($check-predicate (and? #t #t #t))
     63 ($check-predicate (and? #t . #0=(#t . #0#)))
     64 ($check-not-predicate (and? #f))
     65 ($check-not-predicate (and? #t #t #f))
     66 
     67 ($check-predicate (applicative? or?))
     68 ($check-predicate (or? #t))
     69 ($check-predicate (or? #f #t))
     70 ($check-predicate (or? #f #f #t))
     71 ($check-predicate (or? #f . #0=(#t . #0#)))
     72 ($check-not-predicate (or?))
     73 ($check-not-predicate (or? #f))
     74 ($check-not-predicate (or? #f #f #f))
     75 
     76 ;; $and? & $or?
     77 ($check-predicate (operative? $and?))
     78 ($check-predicate ($and?))
     79 ($check-predicate ($and? #t))
     80 ($check-predicate ($and? (eq? #t #t) #t)) ;; test some evaluation too!
     81 ($check-predicate ($and? #t (eq? #f #f) #t))
     82 ($check-not-predicate ($and? #t . #0=((eq? #t #f) . #0#)))
     83 ($check-not-predicate ($and? #f))
     84 ($check-not-predicate ($and? #t #t #f))
     85 ($check-not-predicate ($and? #f (/ 1 0))) ;; test conditional evaluation
     86 
     87 ;; check tail recursiveness
     88 ($let ((p (cons 1 2)))
     89   ($check-predicate ($sequence ($and? ($let/cc cont1
     90                                         (set-car! p cont1)
     91                                         ($and? ($let/cc cont2
     92                                                  (set-cdr! p cont2)
     93                                                  #t))))
     94                                (eq? (car p) (cdr p)))))
     95 
     96 ($check-predicate (operative? $or?))
     97 ($check-predicate ($or? #t))
     98 ($check-predicate ($or? #f (eq? #t #t) #t)) ;; test some evaluation too!
     99 ($check-predicate ($or? #f #f #t))
    100 ($check-predicate ($or? #t (/ 1 0)))
    101 ($check-predicate ($or? #f . #0=(#t . #0#)))
    102 ($check-not-predicate ($or? #f))
    103 ($check-not-predicate ($or?))
    104 
    105 ($let ((p (cons 1 2)))
    106   ($check-predicate ($sequence ($or? ($let/cc cont1
    107                                        (set-car! p cont1)
    108                                        ($or? ($let/cc cont2
    109                                                (set-cdr! p cont2)
    110                                                #t))))
    111                                (eq? (car p) (cdr p)))))
    112 
    113 ($let ((p (cons 1 2)))
    114   ($check-predicate ($sequence ($and? ($let/cc cont1
    115                                         (set-car! p cont1)
    116                                         ($or? ($let/cc cont2
    117                                                 (set-cdr! p cont2)
    118                                                 #t))))
    119                                (eq? (car p) (cdr p)))))
    120 
    121 ($let ((p (cons 1 2)))
    122   ($check-predicate ($sequence ($or? ($let/cc cont1
    123                                        (set-car! p cont1)
    124                                        ($and? ($let/cc cont2
    125                                                 (set-cdr! p cont2)
    126                                                 #t))))
    127                                (eq? (car p) (cdr p)))))
    128 
    129 ;;;
    130 ;;; Error Checking and Robustness
    131 ;;;
    132 
    133 ;; boolean?
    134 ($check-error (boolean? #t . #f))
    135 
    136 ;; not?
    137 ($check-error (not?))
    138 ($check-error (not? 1))
    139 ($check-error (not? #inert))
    140 ($check-error (not? #t #f))
    141 
    142 ;; and? & or?
    143 ($check-error (and? #t #f 0))
    144 ($check-error (or? #f #t 0))
    145 ($check-error (and? #t . #f))
    146 
    147 ;; $and? & $or?
    148 ($check-error ($and? #t 0 #t))
    149 ($check-error ($or? #f 0 #f))
    150 
    151 ;; check boolean in last operand
    152 ($check-error ($and? #t 0))
    153 ($check-error ($or? #f 0))
    154