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

allow case-lambda expressions with no clauses

Browse source 
* module/ice-9/psyntax-pp.scm:
* module/ice-9/psyntax.scm (case-lambda, case-lambda*): Allow 0
  clauses.

* module/language/scheme/decompile-tree-il.scm (do-decompile):
  (choose-output-names):
* module/language/tree-il.scm (unparse-tree-il):
  (tree-il-fold, post-order!, pre-order!):
* module/language/tree-il/effects.scm (make-effects-analyzer):
* module/language/tree-il/cse.scm (cse):
* module/language/tree-il/debug.scm (verify-tree-il):
* module/language/tree-il/peval.scm (peval): Allow for lambda-body to be
  #f.

* libguile/memoize.c (memoize):
* module/language/tree-il/canonicalize.scm (canonicalize!): Give a body
  to empty case-lambda before evaluating it or compiling it,
  respectively.

* test-suite/tests/optargs.test ("case-lambda", "case-lambda*"): Add
  tests.
This commit is contained in:
Andy Wingo 2013-03-02 19:04:47 +01:00
parent 9ddf06dcee
commit 19113f1ca7
11 changed files with 120 additions and 58 deletions
Download patch file Download diff file Expand all files Collapse all files

35
module/language/scheme/decompile-tree-il.scm
View file

@ -1,6 +1,6 @@
;;; Guile VM code converters
;; Copyright (C) 2001, 2009, 2012 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2009, 2012, 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
@ -256,20 +256,22 @@
(build-define name (recurse exp)))
((<lambda> meta body)
(let ((body (recurse body))
(doc (assq-ref meta 'documentation)))
(if (not doc)
body
(match body
(('lambda formals body ...)
`(lambda ,formals ,doc ,@body))
(('lambda* formals body ...)
`(lambda* ,formals ,doc ,@body))
(('case-lambda (formals body ...) clauses ...)
`(case-lambda (,formals ,doc ,@body) ,@clauses))
(('case-lambda* (formals body ...) clauses ...)
`(case-lambda* (,formals ,doc ,@body) ,@clauses))
(e e)))))
(if body
(let ((body (recurse body))
(doc (assq-ref meta 'documentation)))
(if (not doc)
body
(match body
(('lambda formals body ...)
`(lambda ,formals ,doc ,@body))
(('lambda* formals body ...)
`(lambda* ,formals ,doc ,@body))
(('case-lambda (formals body ...) clauses ...)
`(case-lambda (,formals ,doc ,@body) ,@clauses))
(('case-lambda* (formals body ...) clauses ...)
`(case-lambda* (,formals ,doc ,@body) ,@clauses))
(e e))))
'(case-lambda)))
((<lambda-case> req opt rest kw inits gensyms body alternate)
(let ((names (map output-name gensyms)))
@ -694,7 +696,8 @@
(recurse test) (recurse consequent) (recurse alternate))
((<sequence> exps) (primitive 'begin) (for-each recurse exps))
((<lambda> body) (recurse body))
((<lambda> body)
(if body (recurse body)))
((<lambda-case> req opt rest kw inits gensyms body alternate)
(primitive 'lambda)