pattern-binding.scm

;;; This implements the pattern binding rule.

(define (apply-pattern-binding-rule? decls)
 (not
  (every (lambda (decl)
	   (or (function-binding? decl)
	       (simple-pattern-binding-with-signature? decl)))
	 decls)))

(define (function-binding? decl)
  (let ((defs (valdef-definitions decl)))
    (not (null? (single-fun-def-args (car defs))))))

(define (simple-pattern-binding-with-signature? decl)
  (let ((lhs (valdef-lhs decl))
	(defs (valdef-definitions decl)))
    (and (is-type? 'var-pat lhs)
	 (null? (single-fun-def-args (car defs)))
	 (not (eq? (var-signature (var-ref-var (var-pat-var lhs))) '#f)))))

(define (do-pattern-binding-rule decls necessary-tyvars ng-list)
  (setf ng-list (append necessary-tyvars ng-list))
  (find-exported-pattern-bindings decls)
  ng-list)

(define (find-exported-pattern-bindings decls)
  (dolist (decl decls)
    (dolist (var-ref (collect-pattern-vars (valdef-lhs decl)))
     (let ((var (var-ref-var var-ref)))
      (when (def-exported? var)
	(recoverable-error 'exported-pattern-binding
           "Can't export pattern binding of ~A~%" var-ref))
      (when (not (eq? (var-signature var) '#f))
         (recoverable-error 'entire-group-needs-signature
           "Variable ~A signature declaration ignored~%" var-ref))))))