mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 23:32:17 -08:00
Code Issues Projects Releases Packages Wiki Activity

cmp: simplify the ast node CL:FUNCTION

Browse source 
The old AST node for CL:FUNCTION accounted for a possibility that a lambda is
passed, although c1function (the only function that produces this node),
discarded that possibility in favor expanding lambda to explicit FLET.
This commit is contained in:
Daniel Kochmański 2023-07-04 11:16:54 +02:00
parent 8e3f1f0a36
commit c9ced2504d
3 changed files with 14 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

13
src/cmp/cmpbackend-cxx/cmppass2-special.lsp
View file

@ -18,16 +18,9 @@
(declare (ignore c1form))
(progv symbols values (c2expr body)))
(defun c2function (c1form kind funob fun)
(declare (ignore c1form funob))
(case kind
(GLOBAL
(unwind-exit `(FDEFINITION ,fun)))
(CLOSURE
;; XXX: we have some code after baboon – is CLOSURE legal or not?
(baboon :format-control "c2function: c1form is of unexpected kind.")
(new-local fun)
(unwind-exit `(MAKE-CCLOSURE ,fun)))))
(defun c2function (c1form fname)
(declare (ignore c1form))
(unwind-exit `(FDEFINITION ,fname)))
;;; Mechanism for sharing code.
(defun new-local (fun)

21
src/cmp/cmppass1-special.lsp
View file

@ -64,17 +64,16 @@
(defun c1function (args)
(check-args-number 'FUNCTION args 1 1)
(let ((fun (car args)))
(cond ((si::valid-function-name-p fun)
(let ((funob (local-function-ref fun t)))
(if funob
(let* ((var (fun-var funob)))
(add-to-read-nodes var (make-c1form* 'VAR :args var nil)))
(make-c1form* 'FUNCTION
:type 'FUNCTION
:sp-change (not (and (symbolp fun)
(si:get-sysprop fun 'NO-SP-CHANGE)))
:args 'GLOBAL nil fun))))
((and (consp fun) (member (car fun) '(LAMBDA EXT::LAMBDA-BLOCK)))
(cond ((si:valid-function-name-p fun)
(ext:if-let ((funob (local-function-ref fun t)))
(let ((var (fun-var funob)))
(add-to-read-nodes var (make-c1form* 'VAR :args var nil)))
(make-c1form* 'FUNCTION
:type 'FUNCTION
:sp-change (not (and (symbolp fun)
(si:get-sysprop fun 'NO-SP-CHANGE)))
:args fun)))
((and (consp fun) (member (car fun) '(LAMBDA EXT:LAMBDA-BLOCK)))
(cmpck (endp (cdr fun))
"The lambda expression ~s is illegal." fun)
(let (name body)

2
src/cmp/cmptables.lsp
View file

@ -62,7 +62,7 @@
(CL:MULTIPLE-VALUE-SETQ vars-list values-c1form-list :side-effects)
(CL:MULTIPLE-VALUE-BIND vars-list init-c1form body :pure)
(CL:FUNCTION (GLOBAL/CLOSURE) lambda-form fun-object :single-valued)
(CL:FUNCTION fname :single-valued)
(CL:RPLACD (dest-c1form value-c1form) :side-effects)
(SI:STRUCTURE-REF struct-c1form type-name slot-index (:UNSAFE/NIL) :pure)