mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

fix compilation of elisp forms with empty bodies

Browse source 
* module/language/elisp/compile-tree-il.scm (generate-let)
  (generate-let*, compile-lambda, compile-with-added-symbols)
  (compile-progn, compile-if): Return nil if the form's body is empty.
* test-suite/tests/elisp-compiler.test ("Sequencing")["empty progn"]:
  New test.
  ("Conditionals")["if with no else"]: New test.
  ("Let and Let*")["empty let, empty let*"]: New test.
  ("Lambda Expressions")["empty lambda"]: New test.
This commit is contained in:
BT Templeton 2011-06-20 23:04:45 -04:00
parent b652e2b93f
commit d5ac6923c3
2 changed files with 24 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

23
module/language/elisp/compile-tree-il.scm
View file

@ -283,8 +283,7 @@
(let ((make-values (lambda (for)
(map (lambda (el) (compile-expr (cdr el)))
for)))
(make-body (lambda ()
(make-sequence loc (map compile-expr body)))))
(make-body (lambda () (compile-expr `(progn ,@body)))))
(if (null? lexical)
(let-dynamic loc (map car dynamic) module
(make-values dynamic) (make-body))
@ -328,7 +327,7 @@
(map car bind))
(let iterate ((tail bind))
(if (null? tail)
(make-sequence loc (map compile-expr body))
(compile-expr `(progn ,@body))
(let ((sym (caar tail))
(value (compile-expr (cdar tail))))
(if (bind-lexically? sym module)
@ -435,8 +434,6 @@
(define (compile-lambda loc args body)
(if (not (list? args))
(report-error loc "expected list for argument-list" args))
(if (null? body)
(report-error loc "function body must not be empty"))
(receive (required optional rest lexical dynamic)
(split-lambda-arguments loc args)
(define (process-args args)
@ -497,8 +494,7 @@
#f
(map (lambda (x) (nil-value loc)) optional)
all-syms
(let ((compiled-body
(make-sequence loc (map compile-expr body))))
(let ((compiled-body (compile-expr `(progn ,@body))))
(make-sequence
loc
(list
@ -618,8 +614,7 @@
(and (list? syms) (and-map symbol? syms))))
(report-error loc "invalid symbol list" syms))
(let ((old (fluid-ref fluid))
(make-body (lambda ()
(make-sequence loc (map compile-expr body)))))
(make-body (lambda () (compile-expr `(progn ,@body)))))
(if (eq? old 'all)
(make-body)
(let ((new (if (eq? syms 'all)
@ -631,7 +626,10 @@
;;; Special operators
(defspecial progn (loc args)
(make-sequence loc (map compile-expr args)))
(make-sequence loc
(if (null? args)
(list (nil-value loc))
(map compile-expr args))))
(defspecial eval-when-compile (loc args)
(make-const loc (compile `(progn ,@args) #:from 'elisp #:to 'value)))
@ -644,10 +642,7 @@
(call-primitive loc 'not
(call-primitive loc 'nil? (compile-expr cond)))
(compile-expr then)
(if (null? else)
(nil-value loc)
(make-sequence loc
(map compile-expr else)))))))
(compile-expr `(progn ,@else))))))
(defspecial defconst (loc args)
(pmatch args

16
test-suite/tests/elisp-compiler.test
View file

@ -54,6 +54,9 @@
(setq a (1+ a))
a))
(pass-if-equal "empty progn" #nil
(progn))
(pass-if "prog1"
(progn (setq a 0)
(setq b (prog1 a (setq a (1+ a))))
@ -77,6 +80,9 @@
3)
(equal (if nil 1) nil)))
(pass-if-equal "if with no else" #nil
(if nil t))
(pass-if-equal "empty cond" nil-value
(cond))
(pass-if-equal "all failing cond" nil-value
@ -214,6 +220,8 @@
(b a))
b)))
(pass-if-equal "empty let" #nil (let ()))
(pass-if "let*"
(progn (setq a 0)
(and (let* ((a 1)
@ -225,6 +233,9 @@
(= a 0)
(not (boundp 'b)))))
(pass-if-equal "empty let*" #nil
(let* ()))
(pass-if "local scope"
(progn (setq a 0)
(setq b (let (a)
@ -397,7 +408,10 @@
(pass-if-equal "rest argument" '(3 4 5)
((lambda (a b &rest c) c) 1 2 3 4 5))
(pass-if-equal "rest missing" nil-value
((lambda (a b &rest c) c) 1 2)))
((lambda (a b &rest c) c) 1 2))
(pass-if-equal "empty lambda" #nil
((lambda ()))))
(with-test-prefix/compile "Function Definitions"