(unit/sig stepper:cogen-utils^
  (import [z : zodiac:system^]
          [e : zodiac:interface^])
  
  
  ; check whether the supplied id is a keyword. if the id is a syntax or
  ; macro keyword, issue an error.  If disallow-procedures? is true, then
  ; we issue an error for _any_ use of a keyword. These procedures are used
  ; to prevent the program from redefining keywords.
  
  (define check-for-keyword/both
    (lambda (disallow-procedures?)
      (lambda (id)
	(let ([real-id
	       (cond
		 [(z:binding? id) (z:binding-orig-name id)]
		 [(z:top-level-varref? id) (z:varref-var id)]
		 [(z:bound-varref? id)
		  (z:binding-orig-name (z:bound-varref-binding id))]
		 [(z:symbol? id)
		  (z:read-object id)]
		 [else
		  (e:internal-error id "Given in check-for-keyword")])])
	  (when (and (keyword-name? real-id)
		     (or disallow-procedures?
			 (let ([gdv (global-defined-value real-id)])
			   (or (syntax? gdv)
			       (macro? gdv)))))
	    (e:static-error "keyword" 'term:keyword-out-of-context
                            id "invalid use of keyword ~s" real-id))))))
  
  (define check-for-keyword (check-for-keyword/both #t))
  (define check-for-syntax-or-macro-keyword (check-for-keyword/both #f))
    
  (define the-undefined-value (letrec ((x x)) x))
  
  (define-struct (undefined struct:exn) (id))
  (define signal-undefined (make-parameter #t))
  (define undefined-error-format
    "Variable ~s referenced before definition or initialization")
  
  (define-struct (not-boolean struct:exn) (val))
  (define signal-not-boolean (make-parameter #f))
  (define not-boolean-error-format "Condition value is neither true nor false: ~e")
  
  ; there is a problem with Zodiac.  The problem is that Zodiac has not been
  ; distinguishing between top-level variables and those bound by unit clauses.
  ; this is an important distinction to make, because the variables bound by 
  ; unit clauses may take on the `undefined' value, whereas those bound as
  ; top-level variables will never require this check.  (If used before defined,
  ; these values are simply considered unbound.  To this end, Matthew has modified
  ; Zodiac to add a bit of information which aries can use to distinguish these 
  ; fields.  Currently, this information is stored in the `unit?' field of a 
  ; `top-level-varref/bind/unit' structure.  There are cleaner solutions, but
  ; this one fits well into the current state of the world.  This may change at
  ; some point in the future.  For the moment, here is the function which 
  ; distinguishes between these two types of binding:
  
  (define (is-unit-bound? varref)
    (and (z:top-level-varref/bind/unit? varref)
	 (z:top-level-varref/bind/unit-unit? varref)))
  
  ; Objects that are passed to eval get quoted by M3.  These objects
  ; do not belong in the `read' structure framework.  Hence, if they
  ; are passed to z:sexp->raw, they will error.  Thus, we first check
  ; before sending things there.
  
  ; jbc additional comments, including elucidation from shriram:
  ; there are three `levels' of parsed stuff:
  ; raw: simple, unannotated scheme values
  ; sexp: simple scheme values with attached zodiac information
  ; parsed: fully parsed into zodiac structures
  
  (define read->raw
    (lambda (read)
      (if (z:zodiac? read)
	  (z:sexp->raw read)
	  read)))
    
  ; divined notes about the structure of an arglist.  Evidently, an arglist can
  ; take one of three forms:
  ; list-arglist : this arglist represents a simple list of arguments
  ; ilist-arglist : this arglist represents a list of arguments which uses 
  ;   `dot-notation' to separate the last element of the list
  ; sym-arglist : this arglist represents the `single argument with no 
  ;   parens' style of argument list.
  
  (define arglist->ilist
    (lambda (arglist)
      (cond
	((z:list-arglist? arglist)
	 (z:arglist-vars arglist))
	((z:ilist-arglist? arglist)
	 (let loop ((vars (z:arglist-vars arglist)))
	   (if (null? (cddr vars))
	       (cons (car vars) (cadr vars))
	       (cons (car vars) (loop (cdr vars))))))
	((z:sym-arglist? arglist)
	 (car (z:arglist-vars arglist)))
	(else
	 (e:internal-error arglist
                           "Given to arglist->ilist")))))
  
  (define make-improper
    (lambda (combine)
      (rec improper ;; `rec' is for the name in error messages
	   (lambda (f list)
	     (let improper-loop ([list list])
	       (cond
		 ((null? list) list)
		 ((pair? list) (combine (f (car list))
					(improper-loop (cdr list))))
		 (else (f list))))))))
  (define improper-map (make-improper cons))
  (define improper-foreach (make-improper (lambda (x y) y))))