summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-05-21 18:06:34 +0200
committerAndy Wingo <wingo@pobox.com>2012-05-21 18:06:34 +0200
commit15bb587f45b718f08756993fec9274212cc7df58 (patch)
tree82ab2fe92b73629c332ce8e324086996a4448f7f
parent6ccc66789695b5a09ce9b16c8c121f521df296e6 (diff)
downloadguile-15bb587f45b718f08756993fec9274212cc7df58.tar.gz
fix arity check for applicable structs
* module/language/tree-il/analyze.scm (validate-arity): Fix for applicable structs. Applicable structs are procedures, but not every struct has a first slot, and not every struct with a procedure in its first slot is applicable. Besides, the approach in this patch gives better errors.
-rw-r--r--module/language/tree-il/analyze.scm17
1 files changed, 8 insertions, 9 deletions
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index c3ff9e2a5..88f81f3d5 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -1008,10 +1008,14 @@ accurate information is missing from a given `tree-il' element."
(arity:allow-other-keys? a)))
(program-arities proc))))
((procedure? proc)
- (let ((arity (procedure-minimum-arity proc)))
- (values (procedure-name proc)
- (list (list (car arity) (cadr arity) (caddr arity)
- #f #f)))))
+ (if (struct? proc)
+ ;; An applicable struct.
+ (arities (struct-ref proc 0))
+ ;; An applicable smob.
+ (let ((arity (procedure-minimum-arity proc)))
+ (values (procedure-name proc)
+ (list (list (car arity) (cadr arity) (caddr arity)
+ #f #f))))))
(else
(let loop ((name #f)
(proc proc)
@@ -1196,11 +1200,6 @@ accurate information is missing from a given `tree-il' element."
proc)))
(cond ((lambda? proc*)
(validate-arity proc* application #t))
- ((struct? proc*)
- ;; An applicable struct.
- (let ((p (struct-ref proc* 0)))
- (and (procedure? p)
- (validate-arity p application #f))))
((procedure? proc*)
(validate-arity proc* application #f)))))
toplevel-calls)))