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/tree-il.scm | |
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/tree-il.scm')
-rw-r--r-- | module/language/tree-il.scm | 22 |
1 files changed, 16 insertions, 6 deletions
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index 1ac1809fb..aa00b381e 100644 --- a/module/language/tree-il.scm +++ b/module/language/tree-il.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011, 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 @@ -287,7 +287,9 @@ `(define ,name ,(unparse-tree-il exp))) ((<lambda> meta body) - `(lambda ,meta ,(unparse-tree-il body))) + (if body + `(lambda ,meta ,(unparse-tree-il body)) + `(lambda ,meta (lambda-case)))) ((<lambda-case> req opt rest kw inits gensyms body alternate) `(lambda-case ((,req ,opt ,rest ,kw ,(map unparse-tree-il inits) ,gensyms) @@ -370,7 +372,11 @@ This is an implementation of `foldts' as described by Andy Wingo in ((<sequence> exps) (up tree (loop exps (down tree result)))) ((<lambda> body) - (up tree (loop body (down tree result)))) + (let ((result (down tree result))) + (up tree + (if body + (loop body result) + result)))) ((<lambda-case> inits body alternate) (up tree (if alternate (loop alternate @@ -442,7 +448,9 @@ This is an implementation of `foldts' as described by Andy Wingo in ((<sequence> exps) (fold-values foldts exps seed ...)) ((<lambda> body) - (foldts body seed ...)) + (if body + (foldts body seed ...) + (values seed ...))) ((<lambda-case> inits body alternate) (let-values (((seed ...) (fold-values foldts inits seed ...))) (if alternate @@ -511,7 +519,8 @@ This is an implementation of `foldts' as described by Andy Wingo in (set! (toplevel-define-exp x) (lp exp))) ((<lambda> body) - (set! (lambda-body x) (lp body))) + (if body + (set! (lambda-body x) (lp body)))) ((<lambda-case> inits body alternate) (set! inits (map lp inits)) @@ -595,7 +604,8 @@ This is an implementation of `foldts' as described by Andy Wingo in (set! (toplevel-define-exp x) (lp exp))) ((<lambda> body) - (set! (lambda-body x) (lp body))) + (if body + (set! (lambda-body x) (lp body)))) ((<lambda-case> inits body alternate) (set! inits (map lp inits)) |