klisp

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

keyed-variables.k (2732B)

      1 ;; check.k & test-helpers.k should be loaded
      2 ;;
      3 ;; Tests of features related to keyed variables.
      4 ;;
      5 
      6 ;; 10.1.1 make-keyed-dynamic-variable
      7 
      8 ($check-error (make-keyed-dynamic-variable #f))
      9 
     10 ($let*
     11     ( ((b1 a1) (make-keyed-dynamic-variable))
     12       ((b2 a2) (make-keyed-dynamic-variable))
     13       (r1 ($lambda () (a1)))
     14       (r2 ($lambda () (a2))))
     15   ($check-predicate (applicative? b1))
     16   ($check-predicate (applicative? a1))
     17   ($check-error (b1 1 "not-a-combiner"))
     18   ($check-error (b1 1 ($lambda ()) "extra-argument"))
     19   ($check-error (b1 1))
     20   ($check-error (a1 "extra-argument"))
     21 
     22   ($check-not-predicate (equal? b1 b2))
     23   ($check-not-predicate (equal? a1 a2))
     24   ($check-predicate
     25    (b1 1 ($vau () denv (not? ($binds? denv +)))))
     26   ($check-not-predicate
     27    (b1 1 ($vau () e1 (b2 2 ($vau () e2 (equal? e1 e2))))))
     28 
     29   ($check equal? (b1 "value" ($lambda () "result")) "result")
     30   ($check equal? (b1 0 r1) 0)
     31   ($check equal? (b1 1 ($lambda () (b1 2 r1))) 2)
     32   ($check equal? (b1 1 ($lambda () (b2 2 r1))) 1)
     33   ($check equal? (b1 1 ($lambda () (b2 2 r2))) 2)
     34 
     35   ($check-error (a1))
     36   ($check-error (b1 0 r2)))
     37 
     38 ;; 11.1.1 make-keyed-static-variable
     39 
     40 ($check-error (make-keyed-static-variable #f))
     41 
     42 ($let*
     43     ( ((b1 a1) (make-keyed-static-variable))
     44       ((b2 a2) (make-keyed-static-variable))
     45       (e11 (b1 1 (get-current-environment)))
     46       (e12 (b1 2 (get-current-environment)))
     47       (e21 (b2 1 (get-current-environment)))
     48       (e22 (b2 2 (get-current-environment)))
     49       (e11* (b1 1 (get-current-environment)))
     50       (r11 (eval ($quote ($lambda (a) (a))) e11))
     51       (r12 (eval ($quote ($lambda (a) (a))) e12))
     52       (r11_13
     53        (eval
     54         ($quote
     55          ($let ((e13 (b1 3 (get-current-environment))))
     56            (eval ($quote ($lambda (a) (a))) e13)))
     57         e11))
     58       (r11_22
     59        (eval
     60         ($quote
     61          ($let ((e22 (b2 2 (get-current-environment))))
     62            (eval ($quote ($lambda (a) (a))) e22)))
     63         e11)))
     64   ($check-predicate (applicative? b1))
     65   ($check-predicate (applicative? a1))
     66   ($check-error (b1 1 "not-an-environment"))
     67   ($check-error (b1 1 (get-current-environment) "extra"))
     68   ($check-error (b1 1))
     69   ($check-error (a1 "extra-argument"))
     70 
     71   ($check-not-predicate (equal? b1 b2))
     72   ($check-not-predicate (equal? a1 a2))
     73   ($check-predicate (environment? e11))
     74   ($check-not-predicate (equal? e11 e12))
     75   ($check-not-predicate (equal? e11 e21))
     76   ($check-not-predicate (equal? e11 e11*))
     77 
     78   ($check equal? (eval (list a1) e11) 1)
     79   ($check equal? (eval (list a1) e12) 2)
     80   ($check equal? (r11 a1) 1)
     81   ($check equal? (r12 a1) 2)
     82   ($check equal? (r11_13 a1) 3)
     83   ($check equal? (r11_22 a1) 1)
     84   ($check equal? (r11_22 a2) 2)
     85 
     86   ($check-error (a1))
     87   ($check-error (r11_13 a2)))