mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 17:50:29 +02:00
Code Activity

case-lambda* clauses fail to match if too many positionals

Browse source 
* doc/ref/api-procedures.texi (Case-lambda): Expand case-lambda*
  documentation.

* module/ice-9/eval.scm (primitive-eval):
* libguile/eval.c (prepare_boot_closure_env_for_apply): Dispatch to the
  next case-lambda clause if there are too many positionals.

* doc/ref/vm.texi (Function Prologue Instructions):
* libguile/vm-i-system.c (bind-optionals/shuffle-or-br): New
  instruction, like bind-optionals/shuffle but can dispatch to the next
  clause if there are too many positionals.

* module/language/assembly/disassemble.scm (code-annotation):
* module/language/assembly/decompile-bytecode.scm (decode-load-program):
* module/language/assembly/compile-bytecode.scm (compile-bytecode): Add
  case for bind-optionals/shuffle-or-br.
* module/language/glil/compile-assembly.scm (glil->assembly): If there
  is an alternate, use bind-optionals/shuffle-or-br instead of
  bind-optionals/shuffle.

* test-suite/tests/optargs.test ("case-lambda*"): Add tests.
This commit is contained in:
Andy Wingo 2013-01-14 11:38:09 +01:00
parent 18c5bffe96
commit 581f410fbd
10 changed files with 308 additions and 80 deletions
Download patch file Download diff file Expand all files Collapse all files

11
module/language/glil/compile-assembly.scm
View file

@ -1,6 +1,6 @@
;;; Guile VM assembler
;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -486,13 +486,18 @@
,(modulo nreq 256)))))
(ntotal (apply max (+ nreq nopt) (map 1+ (map cdr kw))))
(bind-optionals-and-shuffle
`((bind-optionals/shuffle
`((,(if (and else-label (not rest))
'bind-optionals/shuffle-or-br
'bind-optionals/shuffle)
,(quotient nreq 256)
,(modulo nreq 256)
,(quotient (+ nreq nopt) 256)
,(modulo (+ nreq nopt) 256)
,(quotient ntotal 256)
,(modulo ntotal 256))))
,(modulo ntotal 256)
,@(if (and else-label (not rest))
`(,else-label)
'()))))
(bind-kw
;; when this code gets called, all optionals are filled
;; in, space has been made for kwargs, and the kwargs