bigtest

A very small LISP implementation with several packages and demo programs.

#!bin/picolisp lib.l
# 21sep07abu
# misc/bigtest <seed>

(load "lib/misc.l")

(seed (car (argv)))

(de rnd ()
   (let N
      (if (rand T)
         (hex
            (pack
               (make
                  (do (rand 1 5)
                     (link (if (rand T) "FFFFFFFF" "00000000")) ) ) ) )
         (let L
            (make
               (do (rand 1 60)
                  (link (char (+ 48 (rand 0 9)))) ) )
            (while (and (= "0" (car L)) (cdr L))
               (pop 'L) )
            (format (pack L)) ) )
      (if (rand T) N (- N)) ) )


(de test1 (S N1)
   (let (N (read)  X (eval (list S N1)))
      (unless (= N X)
         (prinl "^J" N ": (" S " " N1 ") -> " X)
         (bye) ) ) )

(de test2 (S N1 N2)
   (let (N (read)  X (eval (list S N1 N2)))
      (unless (= N X)
         (prinl "^J" N ": (" S " " N1 " " N2 ") -> " X)
         (bye) ) ) )

(de cmp2 (S N1 N2)
   (let (N (n0 (read))  X (eval (list S N1 N2)))
      (unless (== N X)
         (prinl "^J" N ": (" S " " N1 " " N2 ") -> " X)
         (bye) ) ) )


(sys "BC_LINE_LENGTH" "200")

(pipe
   (out '("/usr/bin/bc")
      (do 9600000
         (setq N1 (rnd))
         (while (=0 (setq N2 (rnd))))
         (prinl N1)
         (prinl N2)
         (prinl N1 " + " N2)
         (prinl N1 " + 1")
         (prinl N1 " + 1")
         (prinl N1 " - " N2)
         (prinl N1 " - 1")
         (prinl N1 " - 1")
         (prinl N1 " * " N2)
         (prinl N1 " * 2")
         (prinl N1 " % " N2)
         (prinl N1 " / " N2)
         (prinl N1 " / 2")
         (prinl N1 " >= " N2)
         (prinl N1 " > " N2)
         (prinl "sqrt(" (abs N1) ")") ) )
   (do 96
      (do 100000
         (setq
            N1 (read)
            N2 (read) )
         (test2 '+ N1 N2)
         (test2 '+ N1 1)
         (test1 'inc N1)
         (test2 '- N1 N2)
         (test2 '- N1 1)
         (test1 'dec N1)
         (test2 '* N1 N2)
         (test2 '* N1 2)
         (test2 '% N1 N2)
         (test2 '/ N1 N2)
         (test2 '/ N1 2)
         (cmp2 '>= N1 N2)
         (cmp2 '> N1 N2)
         (test1 'sqrt (abs N1)) )
      (prin '.)
      (flush) )
   (prinl) )

(bye)