mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +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

14
module/language/assembly/decompile-bytecode.scm
View file

@ -1,6 +1,6 @@
;;; Guile VM code converters
;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2009, 2010, 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
@ -43,7 +43,7 @@
(define (br-instruction? x)
(memq x '(br br-if br-if-not br-if-eq br-if-not-eq br-if-null br-if-not-null)))
(define (br-nargs-instruction? x)
(memq x '(br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt)))
(memq x '(br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt br-if-nargs-lt/non-kw)))
(define (bytes->s24 a b c)
(let ((x (+ (ash a 16) (ash b 8) c)))
@ -88,6 +88,16 @@
(lp (cons `(,br ,(ensure-label rel1 rel2 rel3)) out)))
((,br ,hi ,lo ,rel1 ,rel2 ,rel3) (guard (br-nargs-instruction? br))
(lp (cons `(,br ,hi ,lo ,(ensure-label rel1 rel2 rel3)) out)))
((bind-optionals/shuffle-or-br ,nreq-hi ,nreq-lo
,nreq-and-nopt-hi ,nreq-and-nopt-lo
,ntotal-hi ,ntotal-lo
,rel1 ,rel2 ,rel3)
(lp (cons `(bind-optionals/shuffle-or-br
,nreq-hi ,nreq-lo
,nreq-and-nopt-hi ,nreq-and-nopt-lo
,ntotal-hi ,ntotal-lo
,(ensure-label rel1 rel2 rel3))
out)))
((mv-call ,n ,rel1 ,rel2 ,rel3)
(lp (cons `(mv-call ,n ,(ensure-label rel1 rel2 rel3)) out)))
((prompt ,n0 ,rel1 ,rel2 ,rel3)