sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

cmp: fix bug in inlining local functions which are closures

Browse source 
See added test case for explanations.
This commit is contained in:
Marius Gerbershagen 2021-01-16 16:12:13 +01:00
parent ba31f58784
commit 194a9e0eab
2 changed files with 38 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
src/cmp/cmpflet.lsp
View file

@ -276,8 +276,9 @@
;; we introduce a variable to hold the funob
(let ((var (fun-var fun)))
(when (and cfb build-object)
(setf (var-ref-clb var) t
(var-kind var) 'LEXICAL))))
(setf (var-ref-clb var) t)
(when (not (eq (var-kind var) 'CLOSURE))
(setf (var-kind var) 'LEXICAL)))))
fun))
(defun c2call-local (c1form fun args)

35
src/tests/normal-tests/compiler.lsp
View file

@ -1967,3 +1967,38 @@
(block nil
(progv '(*s*) (list 0) (return 1) *s*)))))))
(is (not (boundp '*s*)))))
;;; Date 2021-01-16
;;; Description
;;;
;;; Compiling a local function of type CLOSURE can lead to an
;;; internal compiler error if the function is later inlined
;;; because the compiler would indiscriminantly change the closure
;;; type to LEXICAL during inlining.
(ext:with-clean-symbols (some-global-fun another-global-fun)
(defun some-global-fun (fun)
(funcall fun))
(defun another-global-fun (x)
x)
(test cmp.0084.inline-local-closure-type
(let ((fun '(lambda (arg)
(declare (optimize speed))
(labels
((a ()
(some-global-fun #'b)
(c))
(b ()
(c))
(c ()
;; c is of type CLOSURE (arg is passed to
;; a global function). This "infects" a
;; and b to be of type CLOSURE too.
(incf arg)
(another-global-fun arg)))
(declare (inline a))
(a))))
compiled-fun warnings-p errors-p)
(finishes (multiple-value-setq (compiled-fun warnings-p error-p)
(compile nil fun)))
(is (null errors-p))
(is (= (funcall compiled-fun 0) 2)))))