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

Remove redundant function.

Browse source
This commit is contained in:
jgarcia 2006-06-12 08:51:47 +00:00
parent 1666ae1468
commit f36f53a933
4 changed files with 14 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/compiler.d
View file

@ -425,6 +425,8 @@ c_new_env(struct cl_compiler_env *new_c_env, cl_object env)
for (env = ENV->variables; !Null(env); env = CDR(env)) {
cl_object record = CAR(env);
if (SYMBOLP(CAR(record)) && CADR(record) != @'si::symbol-macro') {
continue;
} else {
ENV->lexical_level = 1;
break;
}

6
src/cmp/cmpeval.lsp
View file

@ -48,7 +48,7 @@
(cond ((setq fd (get-sysprop fname 'c1special)) (funcall fd args))
((c1call-local fname args))
((setq fd (sch-local-macro fname))
(c1expr (cmp-expand-macro fd fname args)))
(c1expr (cmp-expand-macro fd (list* fname args))))
((and (setq fd (get-sysprop fname 'C1))
(inline-possible fname))
(funcall fd args))
@ -59,11 +59,11 @@
(inline-possible fname)
(let ((success nil))
(multiple-value-setq (fd success)
(cmp-expand-compiler-macro fd fname args))
(cmp-expand-macro fd (list* fname args)))
success))
(c1expr fd))
((setq fd (macro-function fname))
(c1expr (cmp-expand-macro fd fname args)))
(c1expr (cmp-expand-macro fd (list* fname args))))
((and (setq fd (get-sysprop fname 'SYS::STRUCTURE-ACCESS))
(inline-possible fname)
;;; Structure hack.

6
src/cmp/cmptop.lsp
View file

@ -44,14 +44,14 @@
(inline-possible fun)
(let ((success nil))
(multiple-value-setq (fd success)
(cmp-expand-compiler-macro fd fun args))
(cmp-expand-macro fd form))
success))
(t1expr* fd))
((setq fd (macro-function fun))
(t1expr* (cmp-expand-macro fd fun (cdr form))))
(t1expr* (cmp-expand-macro fd form)))
((and (setq fd (assoc fun *funs*))
(eq (second fd) 'MACRO))
(t1expr* (cmp-expand-macro (third fd) fun (cdr form))))
(t1expr* (cmp-expand-macro (third fd) form)))
(t (t1ordinary form))
)))))

29
src/cmp/cmputil.lsp
View file

@ -144,14 +144,13 @@
~%;;; You are recommended to compile again.~%"
form))))))
(defun cmp-expand-macro (fd fname args)
(let ((env (and *funs* (cons nil *funs*)))
(throw-flag t))
(defun cmp-expand-macro (fd form &optional (env (and *funs* (cons nil *funs*))))
(let ((throw-flag t))
(unwind-protect
(prog1
(cmp-toplevel-eval
`(funcall *macroexpand-hook* ',fd ',(cons fname args) ',env))
(setq throw-flag nil))
(let ((new-form (cmp-toplevel-eval
`(funcall *macroexpand-hook* ',fd ',form ',env))))
(setq throw-flag nil)
(values new-form (not (eql new-form form))))
(if throw-flag
(let ((*print-case* :upcase))
(print-current-form)
@ -160,22 +159,6 @@
~%;;; You are recommended to compile again.~%"
fname))))))
(defun cmp-expand-compiler-macro (fd fname args)
(let ((env (and *funs* (cons nil *funs*)))
(throw-flag t)
(form (cons fname args)))
(unwind-protect
(let ((new-form (cmp-toplevel-eval `(funcall *macroexpand-hook* ',fd ',form ',env))))
(setq throw-flag nil)
(values new-form (not (eql new-form form))))
(when throw-flag
(let ((*print-case* :upcase))
(print-current-form)
(format t
"~&;;; The macro form (~s ...) was not expanded successfully.~
~%;;; You are recommended to compile again.~%"
fname))))))
(defun cmp-toplevel-eval (form)
(let*
#-:CCL