Menu
▾
▴
[Maxima-commits] CVS: maxima/src mlisp.lisp,1.91,1.92
|
From: Dieter K. <cra...@us...> - 2010-09-15 18:15:51
|
Update of /cvsroot/maxima/maxima/src In directory sfp-cvsdas-4.v30.ch3.sourceforge.com:/tmp/cvs-serv17215/src Modified Files: mlisp.lisp Log Message: Cutting out unused functionality from the file mlisp.lisp: 1. Cutting out the use of $subsrcmap from meval1 The functionality of $subsrcmap is broken and it is not documented. 2. Cutting out checks of the following function types: fsubr lsubr mfexpr*s t-mfexpr expr fexpr Maxima has no code, which generates functions or macros of one of the above types. No problems with the testsuite and share_testsuite. Index: mlisp.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/src/mlisp.lisp,v retrieving revision 1.91 retrieving revision 1.92 diff -u -d -r1.91 -r1.92 --- mlisp.lisp 15 Sep 2010 00:10:38 -0000 1.91 +++ mlisp.lisp 15 Sep 2010 18:15:40 -0000 1.92 @@ -70,7 +70,6 @@ (defmvar $%enumer nil) (defmvar $float nil) (defmvar $refcheck nil) -(defmvar $subscrmap nil) (defmvar $translate nil) (defmvar $transrun t) (defmvar $savedef t) @@ -324,11 +323,6 @@ do (*break-points* form) (loop-finish)))) nil))) - ((and $subscrmap aryp - (do ((x (margs form) (cdr x))) - ((or (null x) (mxorlistp (car x))) x))) - (setq noevalargs nil) - (return (subgen form))) ((eq (caar form) 'mqapply) (return (mqapply1 form)))) (badfunchk (caar form) (caar form) nil) a @@ -336,15 +330,14 @@ (or (safe-getl (caar form) '(noun)) (and *nounsflag* (eq (getcharn (caar form) 1) #\%) - (not (or (getl-lm-fcn-prop (caar form) '(subr fsubr lsubr)) - (safe-getl (caar form) '(mfexpr* mfexpr*s)))) + (not (or (getl-lm-fcn-prop (caar form) '(subr)) + (safe-getl (caar form) '(mfexpr*)))) (prog2 ($verbify (caar form)) (safe-getl (caar form) '(noun)))) (and (not aryp) $transrun (setq transp - (or (safe-mgetl (caar form) '(t-mfexpr)) - (safe-getl (caar form) '(translated-mmacro))))) + (safe-getl (caar form) '(translated-mmacro)))) (and (not aryp) (setq u (or (safe-mget (caar form) 'trace) @@ -353,27 +346,17 @@ (not (safe-mget (caar form) 'local-fun)) (setq transp t) (caar form)))) - (getl-lm-fcn-prop u '(expr subr lsubr))) + (getl-lm-fcn-prop u '(subr))) (cond (aryp (safe-mgetl (caar form) '(hashar array))) ((safe-mgetl (caar form) '(mexpr mmacro))) - ((safe-mgetl (caar form) '(t-mfexpr))) (t - (or (safe-getl (caar form) '(mfexpr* mfexpr*s)) - (getl-lm-fcn-prop (caar form) - '(subr fsubr expr fexpr macro lsubr))))))) + (or (safe-getl (caar form) '(mfexpr*)) + (getl-lm-fcn-prop (caar form) '(subr macro))))))) (when (null u) (go b)) (return (cond ((eq (car u) 'hashar) (harrfind (cons (car form) (mevalargs (cdr form))))) - ((member (car u) '(fexpr fsubr) :test #'eq) - (if fexprerrp - ;; UNREACHABLE MESSAGE: FEXPRERRP IS ALWAYS NIL - (merror "Attempt to call ~A ~A from Maxima level.~ - ~%Send a bug note." - (car u) (caar form))) - (setq noevalargs nil) (apply (caar form) (cdr form))) - ((or (eq (car u) 'subr) - (eq (car u) 'lsubr)) + ((eq (car u) 'subr) (apply (caar form) (mevalargs (cdr form)))) ((eq (car u) 'noun) (cond ((or (member (caar form) *nounl* :test #'eq) *nounsflag*) @@ -399,8 +382,6 @@ (setq noevalargs nil) (setq form (cons(caar form) (cdr form))) (eval form)) - ((eq (car u) 't-mfexpr) - (apply (cadr u) (cdr form))) (t (apply (cadr u) (mevalargs (cdr form)))))) b @@ -1048,7 +1029,8 @@ (if (atom (cadar l)) (setq bndvars (cons (cadar l) bndvars) bndvals (cons (meval (specrepcheck (caddar l))) bndvals)))) - (t (setq l (append (car l) (cdr l)))))))) + (t (setq l (append (car l) (cdr l)))))))) + (defmfun mevalatoms (exp) (cond ((atom exp) (meval1 exp)) ((member 'array (cdar exp) :test #'eq) @@ -1073,15 +1055,12 @@ ((and (eq (caar exp) '$%th) (eq (ml-typep (simplify (cadr exp))) 'fixnum)) (meval1 exp)) ((prog2 (autoldchk (caar exp)) - (and (or (getl-lm-fcn-prop (caar exp) '(fsubr fexpr)) - (getl (caar exp) '(mfexpr* mfexpr*s))) + (and (getl (caar exp) '(mfexpr*)) (not (get (caar exp) 'evok)))) exp) - ((mgetl (caar exp) '(mfexprp t-mfexpr)) + ((mgetl (caar exp) '(mfexprp)) (cons (car exp) - (do ((a (or (cdr (mget (caar exp) 't-mfexpr)) - (cdadr (mget (caar exp) 'mexpr))) - (cdr a)) + (do ((a (cdadr (mget (caar exp) 'mexpr)) (cdr a)) (b (cdr exp) (cdr b)) (l)) ((not (and a b)) (nreverse l)) (cond ((mdeflistp a) @@ -1562,7 +1541,6 @@ (when (and (get fun 'translated) (not (eq $savedef '$all))) (fmakunbound fun) (zl-remprop fun 'translated-mmacro) - (mremprop fun 't-mfexpr) (zl-remprop fun 'function-mode) (when (not (getl fun '(a-expr a-subr))) (zl-remprop fun 'once-translated) @@ -1580,7 +1558,7 @@ (not (symbolp var)) (and (not (mgetl var '($nonscalar $scalar $mainvar $numer - matchdeclare $atomgrad atvalues t-mfexpr))) + matchdeclare $atomgrad atvalues))) (not (getl var '(evfun evflag translated nonarray bindtest sp2 operators opers special data autoload mode))))) (not (member var *builtin-$props* :test #'equal))) @@ -2062,8 +2040,7 @@ (defun mredef-check (fnname) (when (and (not (mget fnname 'mexpr)) (or (and (or (get fnname 'autoload) - (getl-lm-fcn-prop fnname '(subr fsubr lsubr)) - (get fnname 'mfexpr*s)) + (getl-lm-fcn-prop fnname '(subr))) (not (get fnname 'translated))) (mopp fnname))) (format t (intl:gettext "define: warning: redefining the built-in ~:[function~;operator~] ~a~%") @@ -2084,8 +2061,8 @@ (mputprop fun (mdefine1 subs (mdefine1 args body)) 'aexpr)))) (defmfun mspecfunp (fun) - (and (or (getl-lm-fcn-prop fun '(fsubr fexpr macro)) - (getl fun '(mfexpr* mfexpr*s)) + (and (or (getl-lm-fcn-prop fun '(macro)) + (getl fun '(mfexpr*)) (and $transrun (get fun 'translated-mmacro)) (mget fun 'mmacro)) (not (get fun 'evok)))) @@ -2220,8 +2197,7 @@ (defun meval-atoms (form) (cond ((atom form) (meval1 form)) ((eq (caar form) 'mquote) (cadr form)) - ((and (or (getl-lm-fcn-prop (caar form) '(fsubr fexpr)) - (getl (caar form) '(mfexpr* mfexpr*s))) + ((and (getl (caar form) '(mfexpr*)) (not (member (caar form) '(mcond mand mor mnot mprogn mdo mdoin) :test #'eq))) form) (t (recur-apply #'meval-atoms form)))) |