blob: 769e155a379468d341982ee0816b685bf1df2521 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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))))))
|