klisp

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

promises.k (3452B)

      1 ;; check.k & test-helpers.k should be loaded
      2 ;;
      3 ;; Tests of promises - lazy evaluation features.
      4 ;;
      5 
      6 ;; 9.1.1 promise?
      7 
      8 ($check-predicate (promise?))
      9 ($check-predicate (promise? ($lazy 0) (memoize 0)))
     10 ($check-not-predicate (promise? 0))
     11 ($check-not-predicate (promise? ()))
     12 ($check-not-predicate (promise? #inert))
     13 
     14 ;; 9.1.2 force
     15 
     16 ($check equal? (force 0) 0)
     17 ($check equal? (force (force 1)) 1)
     18 ($check equal? (force ($lazy 2)) 2)
     19 ($check equal? (force (force ($lazy 3))) 3)
     20 ($check equal? (force ($lazy ($lazy 4))) 4)
     21 ($check-error (force))
     22 ($check-error (force "too" "many"))
     23 
     24 ;; 9.1.3 $lazy
     25 
     26 ($check-error ($lazy))
     27 ($check-error ($lazy "too" "many"))
     28 ($check equal? (force ($lazy (get-current-environment))) 
     29         (get-current-environment))
     30 
     31 ;; Test cases from R(-1)RK
     32 ($define! lazy-test-1
     33   ($let ()
     34     ($provide! (get-count p)
     35       ($define! count 5)
     36       ($define! get-count ($lambda () count))
     37       ($define! p
     38         ($let ((self (get-current-environment)))
     39           ($lazy
     40            ($if (<=? count 0)
     41                 count
     42                 ($sequence
     43                   ($set! self count (- count 1))
     44                   (force p)
     45                   ($set! self count (+ count 2))
     46                   count))))))
     47     ($check equal? (get-count) 5)
     48     ($check equal? (force p) 0)
     49     ($check equal? (get-count) 10)))
     50 
     51 ($define! lazy-test-2
     52   ($let
     53       ((temp-file "klisp-ports-test.txt"))
     54     (with-output-to-file temp-file
     55                          ($lambda ()
     56                            ($define! p1 ($lazy (display "*")))
     57                            ($define! p2 ($lazy p1))
     58                            (force p2)
     59                            (force p1)))
     60     ($let
     61         ((result (with-input-from-file temp-file read)))
     62       (delete-file temp-file)
     63       result)))
     64 
     65 ($check equal? lazy-test-2 ($quote *))
     66 
     67 ;; The third test constructs infinite lazy list
     68 ;; and forces first 100 elements. The Kernel Report
     69 ;; version forces 10^10 elements.
     70 ;;
     71 ;; TODO: Test the original version in separate script
     72 ;; as a benchmark.
     73 ;;
     74 ($define! lazy-test-3
     75   ($sequence
     76     ($define! stream-filter
     77       ($lambda (p? s)
     78         ($lazy
     79          ($let ((v (force s)))
     80            ($if (null? v)
     81                 v
     82                 ($let ((s (stream-filter p? (cdr v))))
     83                   ($if (p? (car v))
     84                        (cons (car v) s)
     85                        s)))))))
     86     ($define! from
     87       ($lambda (n)
     88         ($lazy (cons n (from (+ n 1))))))
     89     (force
     90      (stream-filter ($lambda (n) (=? n 100))
     91                     (from 0)))))
     92 
     93 ($check equal? (car lazy-test-3) 100)
     94 
     95 ;; 9.1.4 memoize
     96 
     97 ($check-error (memoize))
     98 ($check-error (memoize "too" "many"))
     99 
    100 ($check equal? (force (memoize 0)) 0)
    101 ($check equal? (force (force (memoize 0))) 0)
    102 ($check-predicate (promise? (force (memoize (memoize 0)))))
    103 ($check equal? (force (force (memoize (memoize 0)))) 0)
    104 ($check-predicate (promise? (force (memoize ($lazy 0)))))
    105 ($check equal? (force (force (memoize ($lazy 0)))) 0)
    106 ($check equal? (force ($lazy (memoize 0))) 0)
    107 ($check equal? (force (force ($lazy (memoize 0)))) 0)
    108 
    109 ;; 9.1.5? $delay
    110 
    111 ($check-error (memoize))
    112 ($check-error (memoize "too" "many"))
    113 
    114 ($check equal? (force ($delay 0)) 0)
    115 ($check equal? (force (force ($delay 0))) 0)
    116 ($check equal? (force ($delay (get-current-environment))) 
    117         (get-current-environment))
    118 ($check-predicate (promise? (force ($delay (memoize 0)))))
    119 ($check equal? (force (force ($delay (memoize 0)))) 0)