hobbit.scm call-order.patch

[Doug Evans <devans@canuck.cygnus.com>]

I ran into a problem using a hobbit-compiled hobbit that I tracked
down to what I think is argument evaluation order problems in the
C version of hobbit.  Global variable *new-funs-list* gets built
in the wrong order.

The included testcase gets this error message when it shouldn't:

Starting to read hob-call-order-bug.scm

Bounded integer (fast) arithmetic assumed.

** Pass 1 completed **
analyzed & marked definitions file hob-call-order-bug.anl is built.
** Pass 2 completed **
closures-building file hob-call-order-bug.cls is built.
** Pass 3 completed **
lambda-lifted & normalized definitions file hob-call-order-bug.flt is built.
** Pass 4 completed **
statement-lifted definitions file hob-call-order-bug.stt is built.
** Pass 5 completed **
higher-order-&-dot-arglist corrected definitions file hob-call-order-bug.hod is built.
COMPILATION ERROR: 
In -pmacro-expand_fn5 interpreted function -pmacro-expand_fn7 occurs as an argument. Use lambdaterm!

---------

Test case:

(define (-pmacro-expand exp env)

  (define cep current-error-port)

  ; If the symbol is in `env', recurse on its value.
  ; Otherwise see if symbol is a macro.
  ; Otherwise return the symbol unchanged.
  (define (scan-symbol sym)
    (let ((val (-env-ref env sym)))
      (if val
	  (cdr val)
	  (let ((val (-pmacro-ref sym)))
	    (if val
		; Symbol is a macro (FIXME: ensure non-procedural macro).
		val
		; Return symbol unchanged.
		sym)))))

  (define (check-macro exp)
    (if -pmacro-trace?
	(begin
	  (display "macro?   " (cep))
	  (write exp (cep))
	  (newline (cep))))
    (-pmacro-ref (car exp)))

  ; See if a macro invocation.
  ; Otherwise scan each element.
  (define (scan-list exp)
    ; ??? Look up in env first?
    (let ((macro (check-macro exp)))
      (if macro
	  (apply macro (map scan (cdr exp)))
	  (map scan exp))))

  (define (scan exp)
    (let ((result (cond ((symbol? exp) (scan-symbol exp))
			((and (list? exp) (not (null? exp))) (scan-list exp))
			; Not a symbol or expression, return unchanged.
			(else exp))))
      ; If the result is a new macro invocation, recurse.
      ; FIXME: We don't recurse.
      (if (and (list? result) (not (null? result)))
	  (let ((macro (check-macro result)))
	    (if macro
		(apply macro (cdr result))
		result))
	  result)))

  (if -pmacro-trace?
      (begin
	; We use `write' to display `exp' to see strings quoted.
	(display "expand:  " (cep)) (write exp (cep)) (newline (cep))
	(display "environ: " (cep)) (display env (cep)) (newline (cep))))

  (let ((result (scan exp)))
    (if -pmacro-trace?
	(begin
	  (display "result:  " (cep)) (write result (cep)) (newline (cep))))
    result))


---------

patch:
[code is formatted to try to minimize size of patch]

Fri Oct  2 08:42:14 1998  Doug Evans  <devans@seba.cygnus.com>

	* hobbit.scm (make-new-funs-letrec): Avoid evaluation order
	dependencies in C version, build *new-funs-list* in proper order.

*** hobbit0.scm	Sat Sep 26 05:21:14 1998
--- hobbit.scm	Thu Oct  1 18:33:08 1998
***************
*** 4445,4452 ****
  	      new-names-args)))
      (for-each
        (lambda(b)
! 	  (set! *new-funs-list*
! 		(cons
  		  (list 'define
  			(cadr (assq (car b) new-names-args))
  			(cons (caadr b)
--- 4438,4444 ----
  	      new-names-args)))
      (for-each
        (lambda(b)
! 	(let ((tmp
  		  (list 'define
  			(cadr (assq (car b) new-names-args))
  			(cons (caadr b)
***************
*** 4459,4465 ****
  						  boundvars)
  						 new-names-args)))
  					 (cddadr b) ))))
! 		  *new-funs-list*)))
        fun-bindings)
     new-names-args))
  
--- 4451,4460 ----
  						  boundvars)
  						 new-names-args)))
  					 (cddadr b) ))))
! 		  ))
! 	  (set! *new-funs-list*
! 		(cons tmp
! 		  *new-funs-list*))))
        fun-bindings)
     new-names-args))