mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

fix arity check for applicable structs

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2012-05-21 18:06:34 +02:00
parent 6ccc667896
commit 15bb587f45
1 changed files with 8 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

11
module/language/tree-il/analyze.scm
View file

@ -1008,10 +1008,14 @@ accurate information is missing from a given `tree-il' element."
(arity:allow-other-keys? a))) (arity:allow-other-keys? a)))
(program-arities proc)))) (program-arities proc))))
((procedure? proc) ((procedure? proc)
(if (struct? proc)
;; An applicable struct.
(arities (struct-ref proc 0))
;; An applicable smob.
(let ((arity (procedure-minimum-arity proc))) (let ((arity (procedure-minimum-arity proc)))
(values (procedure-name proc) (values (procedure-name proc)
(list (list (car arity) (cadr arity) (caddr arity) (list (list (car arity) (cadr arity) (caddr arity)
#f #f))))) #f #f))))))
(else (else
(let loop ((name #f) (let loop ((name #f)
(proc proc) (proc proc)
@ -1196,11 +1200,6 @@ accurate information is missing from a given `tree-il' element."
proc))) proc)))
(cond ((lambda? proc*) (cond ((lambda? proc*)
(validate-arity proc* application #t)) (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*) ((procedure? proc*)
(validate-arity proc* application #f))))) (validate-arity proc* application #f)))))
toplevel-calls))) toplevel-calls)))