(another?) VerifyError with kawa-1.6.70

[John Kozak]

The appended code produces this:

java.lang.VerifyError: atInteractiveLevel$lambda
	at source unknown
	at atInteractiveLevel.apply2(Unknown Source)
	at gnu.expr.ModuleBody.applyN(ModuleBody.java:97)
	at gnu.expr.ModuleMethod.applyN(ModuleMethod.java:61)
	at gnu.expr.ApplyExp.eval(ApplyExp.java:38)
	at gnu.expr.SetExp.eval(SetExp.java:88)
	at gnu.expr.ModuleExp.evalModule(ModuleExp.java:38)
	at kawa.Shell.run(Shell.java:85)
	at kawa.standard.load.loadSource(load.java:124)
	at kawa.standard.load.loadSource(load.java:102)
	at kawa.standard.load.apply(load.java:173)
	at kawa.standard.load.apply2(load.java:149)
	at kawa.standard.load.apply1(load.java:140)
	at gnu.mapping.Procedure1.applyN(Procedure1.java:49)
	at gnu.expr.ApplyExp.eval(ApplyExp.java:38)
	at gnu.expr.ModuleExp.evalModule(ModuleExp.java:38)
	at kawa.Shell.run(Shell.java:85)
	at kawa.Shell.run(Shell.java:35)
	at kawa.Shell.run(Shell.java:19)
	at kawa.repl.main(repl.java:356)

under IBM JDK 1.1.8 (and slightly more informative msgs under later
JDKs).  Seems to provoked by the find-trans! code.  Is this a repeat
of Brian Carlstrom's earlier bug?

John

-------------------------------------code-----------------------------
(define (and? . rest) 
  (cond ((null? rest)     #t)
	((not (car rest)) #f)
	(else             (apply and? (cdr rest)))))

(define (or? . rest) 
  (cond ((null? rest)     #f)
	((car rest)       #t)
	(else             (apply or? (cdr rest)))))

(define (filter p? l)
  (if (null? l)
      '()
      (if (p? (car l))
          (cons (car l) (filter p? (cdr l)))
          (filter p? (cdr l)))))

(define id (lambda (x) x))

(define (set-cadr!  x v) (set-car! (cdr x) v))
(define (set-caddr! x v) (set-car! (cddr x) v))

(define (make-petri places transitions) 
  (letrec ((find-place (lambda (p) 
			 (cond ((assq p places))
			       (else (error (format #f "can't find place: ~a" p))) ) ))
	   
	   (find-trans (lambda (t) 
			 (cond ((assq t transitions))
			       (else (error (format #f "can't find transition: ~a" t))) ) ))

	   (place-name car)
	   (place-count cadr)
	   (set-place-count! (lambda (p v) (set-car! (cdr p) v)))
	   (trans-name car)
	   (trans-inputs cadr)
	   (trans-outputs caddr)

	   (ready-trans (lambda ()
			  (filter 
			   (lambda (t) 
			     (apply and?
				    (map (lambda (p) (> (place-count (find-place p)) 0))
					 (trans-inputs t)) ) )
			   transitions) ))

	   (fire-trans! (lambda (t)
			  (let ((trans (find-trans t)))
			    (for-each (lambda (p)
					(let ((place (find-place p)))
					  (set-place-count! place (- (place-count place) 1)) ) )
				      (trans-inputs trans) )
			    (for-each (lambda (p)
					(let ((place (find-place p)))
					  (set-place-count! place (+ (place-count place) 1)) ) )
				      (trans-outputs trans) ) 
			  )) )

	   (self       (lambda (op)	;user interface
			 (case op
			   ((go)
 			    (let loop ((ready (map trans-name (ready-trans))))
 			      (format #t "~a: " ready)
 			      (let ((ans (string->symbol (read-line))))
 				(cond ((not (memq ans ready))
 				       (format #t "***bzzt!\n")
 				       (loop ready) )
 				      (else
 				       (fire-trans! ans) 
 				       (format #t "places: ~a\n" places) 
 				       (loop (map trans-name (ready-trans))) ) ) ) ) )
			   (else
			    (format #t "??") ) ) ) ) )
    self) )


;;; playpen

(define pn (make-petri			;from "Network Algebra" p. 308
	    '((p 1) (q 0) (r 0))
	    '((a (p)    (q p))
	      (b (p q)  (r q))
	      (c (q r)  (r))
	      (d (r)    (p)) ) ) )

------------------------------------end----------------------------------------