"Fossies" - the Fresh Open Source Software Archive

Member "snd-20.9/tools/tset.scm" (12 Feb 2020, 1258 Bytes) of package /linux/misc/snd-20.9.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Lisp source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 (require reactive.scm)
    2 
    3 (define (t)
    4   (let ((x 0))
    5     (do ((i 0 (+ i 1)))
    6     ((= i 500))
    7       (let ((a 1))
    8     (reactive-set! x (* 2 a))
    9     (set! a 2)
   10     (if (not (= x 4))
   11         (format *stderr* "x: ~D ~D~%" x a)))
   12       (let ((a 1))
   13     (reactive-set! a (* 2 x))
   14     (set! x 2)
   15     (if (not (= a 4))
   16         (format *stderr* "a: ~D ~D~%" a x)))
   17       (let ((a 3))
   18     (set! a 2))
   19       (if (not (= x 2))
   20       (format *stderr* "x: ~D~%" x))
   21       (let ((a 1))
   22     (do ((k 0 (+ k 1)))
   23         ((= k 1))
   24       (let ((b 2))
   25         (do ((j 0 (+ j 1)))
   26         ((= j 10))
   27           (let ((c 3))
   28         (reactive-set! x (+ a b c))
   29         (set! c 2)
   30         (if (not (= x 5))
   31             (format *stderr* "set: ~S ~S ~S ~S~%" x a b c))))
   32         (set! b 3)
   33         (if (not (= x 6))
   34         (format *stderr* "set: ~S ~S ~S~%" x a b))))
   35     (set! a 4)
   36     (if (not (= x 9))
   37         (format *stderr* "set: ~S ~S~%" x a)))
   38       (reactive-let ((y (* x 2))
   39              (z (+ (* x 3) 1)))
   40     (set! x 1)
   41     (if (or (not (= y 2))
   42         (not (= z 4)))
   43         (format *stderr* "let: ~D ~D ~D~%" x y z)))
   44       (reactive-let* ((y (* x 2))
   45               (z (+ (* x 3) y)))
   46     (set! x 1)
   47     (if (or (not (= y 2))
   48         (not (= z 5)))
   49         (format *stderr* "let*: ~D ~D ~D~%" x y z)))
   50       
   51       (if (zero? (modulo i 9)) (gc)))))
   52 
   53 (t)
   54 
   55 (when (> (*s7* 'profile) 0)
   56   (show-profile 200))
   57 (exit)