diff options
| author | Andy Wingo <wingo@pobox.com> | 2013-03-02 19:04:47 +0100 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2013-03-09 11:16:31 +0100 |
| commit | 19113f1ca7a747de06d7b43c6c1eca4cd58d05e5 (patch) | |
| tree | af7f198811ab1457763280792f10526db6ae4129 /module/language/scheme | |
| parent | 9ddf06dceee3a2bf5480a3e261ec01aaa91a1f67 (diff) | |
| download | guile-19113f1ca7a747de06d7b43c6c1eca4cd58d05e5.tar.gz | |
allow case-lambda expressions with no clauses
* 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.
Diffstat (limited to 'module/language/scheme')
| -rw-r--r-- | module/language/scheme/decompile-tree-il.scm | 35 |
1 files changed, 19 insertions, 16 deletions
diff --git a/module/language/scheme/decompile-tree-il.scm b/module/language/scheme/decompile-tree-il.scm index 9191b2f96..f94661da4 100644 --- a/module/language/scheme/decompile-tree-il.scm +++ b/module/language/scheme/decompile-tree-il.scm @@ -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) |