;; %make-vector % make-closure %svref %set-svref tester


(setf *test-a3*
      '(let ((a (%make-vector 10))
             (c (%make-closure 100 111)))

         (defun consx (x y)

           (let ((p (%reserve-space 8)))
             (set-word p 0 x)
             (set-word p 4 y)
             (tag-set p 1)))

         (%print (get-word (consx 22 33) 4))

         (%print -1)

         (set-word 32 -4 123)
         (%print (get-word 32 -4))

         (%print -2)

         (%print (get-word c 8))
         (%print (get-word c 12))
         (do ((i 0 (%+ i 1)))
             ((%>= i 10))
           (%set-svref a i (%+ i 17))
           (%print (%svref a i)))
         (%print (%closure-ref c 0))
         (%print (%closure-ref c 1))))


;; closures sharing a write variable test
;; helped to uncover compiler bug related to argument x of consx having the same name x as x in let ((x 1)(ff nil))
;;

(setf *test-a4* 
      '(let ((www 12))


         (let ((x 1)(ff nil)) 

         (defun consx (x y)

           (let ((p (%reserve-space 8)))
             (set-word p 0 x)
             (set-word p 4 y)
             (tag-set p 1)))


           (let ((i 0) (ff1 nil))
             (setq ff1 (do-until ((%> i 5) ff)
                                 (let ((y 1))
                                   (setq i (%+ i 1))
                                   (setq ff (consx #'(lambda (z)
                                                       (cond ((%= z 0) x)
                                                             (1 (setq x z)))) ff)))))
             (%print 12)
             (%print ff1)
             (%print 33)
             (%print (funcall (car (cdr ff)) 22))
             (%print (funcall (car ff) 0))
             (%print (funcall (car (cdr (cdr ff))) 57))
             (%print (funcall (car (cdr ff)) 0))))))


;; a simple test of correctness of consx = cons implementation
;; should be run in emu

 (setf *test-a5* 
      '(let ((www 12))
         (defun consx (x y)

           (let ((p (%reserve-space 8)))
             (set-word p 0 x)
             (set-word p 4 y)
             (tag-set p 1)))

         (do ((i 0 (%+ i 1)))
             ((%>= i 10))
           (setq www (consx i www)))

         (%print www)))