1 files changed, 38 insertions, 0 deletions
diff --git a/type/pattern-binding.scm b/type/pattern-binding.scm
new file mode 100644
index 0000000..769e155
--- /dev/null
+++ b/type/pattern-binding.scm
@@ -0,0 +1,38 @@
+;;; 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))))))
+
+
+