From b58b020bb61e628c3b0dc9ebbd56bbc197c0ec58 Mon Sep 17 00:00:00 2001 From: Tim Daly Date: Mon, 25 May 2015 20:02:03 -0400 Subject: [PATCH] src/interp/vmlisp.lisp remove KAR, KDR, KAAR, KADR macros move closer to common lisp. --- books/bookvol5.pamphlet | 55 ++++++++++++--------------------- books/bookvol9.pamphlet | 28 ++++++----------- changelog | 20 ++++++++++++ patch | 46 +-------------------------- src/axiom-website/patches.html | 2 + src/interp/br-con.lisp.pamphlet | 62 ++++++++++++++++++------------------ src/interp/c-util.lisp.pamphlet | 2 +- src/interp/cattable.lisp.pamphlet | 2 +- src/interp/format.lisp.pamphlet | 2 +- src/interp/functor.lisp.pamphlet | 4 +- src/interp/i-coerfn.lisp.pamphlet | 2 +- src/interp/i-output.lisp.pamphlet | 20 ++++++------ src/interp/i-resolv.lisp.pamphlet | 2 +- src/interp/interop.lisp.pamphlet | 2 +- src/interp/lisplib.lisp.pamphlet | 2 +- src/interp/nruncomp.lisp.pamphlet | 6 ++-- src/interp/nrunfast.lisp.pamphlet | 10 +++--- src/interp/nrungo.lisp.pamphlet | 2 +- src/interp/nrunopt.lisp.pamphlet | 10 +++--- src/interp/profile.lisp.pamphlet | 2 +- src/interp/record.lisp.pamphlet | 8 ++-- src/interp/vmlisp.lisp.pamphlet | 21 +++++------- 22 files changed, 132 insertions(+), 178 deletions(-) diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 14ff8eb..0d7b468 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -2492,7 +2492,6 @@ Properties of r :: \calls{spadTrace}{removeOption} \calls{spadTrace}{opOf} \calls{spadTrace}{assoc} -\calls{spadTrace}{kdr} \calls{spadTrace}{flattenOperationAlist} \calls{spadTrace}{getOperationAlistFromLisplib} \calls{spadTrace}{spadTrace,isTraceable} @@ -2549,7 +2548,7 @@ Properties of r :: (setq anyiftrue (null listofoperations)) (setq domainid (|opOf| (elt domain 0))) (setq currententry (|assoc| domain /tracenames)) - (setq currentalist (kdr currententry)) + (setq currentalist (ifcdr currententry)) (setq opstructurelist (|flattenOperationAlist| (|getOperationAlistFromLisplib| domainid))) (setq sigslotnumberalist @@ -2749,7 +2748,6 @@ untraceDomainConstructor,keepTraced?} \calls{untraceDomainConstructor,keepTraced?}{qcar} \calls{untraceDomainConstructor,keepTraced?}{isDomainOrPackage} \calls{untraceDomainConstructor,keepTraced?}{boot-equal} -\calls{untraceDomainConstructor,keepTraced?}{kar} \calls{untraceDomainConstructor,keepTraced?}{devaluate} \calls{untraceDomainConstructor,keepTraced?}{exit} \calls{untraceDomainConstructor,keepTraced?}{/untrace,0} @@ -2762,7 +2760,7 @@ untraceDomainConstructor,keepTraced?} (and (and (consp df) (progn (setq dc (qcar df)) t)) (|isDomainOrPackage| dc)) - (boot-equal (kar (|devaluate| dc)) domainConstructor)) + (boot-equal (ifcar (|devaluate| dc)) domainConstructor)) (exit (seq (|/UNTRACE,0| (cons dc nil)) (exit nil)))) (exit t))))) @@ -25630,7 +25628,6 @@ then the substitution sl is augmented, or the result is 'failed \calls{hasCaty}{hasAtt} \calls{hasCaty}{hasCat} \calls{hasCaty}{opOf} -\calls{hasCaty}{kdr} \calls{hasCaty}{mkDomPvar} \calls{hasCaty}{domArg} \calls{hasCaty}{augmentSub} @@ -25653,7 +25650,7 @@ then the substitution sl is augmented, or the result is 'failed (|hasAtt| d (|subCopy| (qcadr cat) (|constructSubst| d)) sl)) ((setq x (|hasCat| (|opOf| d) (|opOf| cat))) (cond - ((setq y (kdr cat)) + ((setq y (ifcdr cat)) (setq s (|constructSubst| d)) (do ((next x (cdr next)) (endtest nil (null (eq s1 '|failed|)))) ((or (atom next) endtest) nil) @@ -38654,7 +38651,6 @@ printLoadMessages, which gets called with \verb|%describe%| \calls{set1}{sayKeyedMsg} \calls{set1}{poundsign} \calls{set1}{displaySetOptionInformation} -\calls{set1}{kdr} \calls{set1}{sayMSG} \calls{set1}{sayMessage} \calls{set1}{bright} @@ -38696,7 +38692,7 @@ printLoadMessages, which gets called with \verb|%describe%| (setq setfunarg (if (eq (elt l 1) 'default) '|%initialize%| - (kdr l))) + (ifcdr l))) (if (canFuncall? (fifth setdata)) (funcall (fifth setdata) setfunarg) (|sayMSG| (concatenate 'string " Function not implemented. " @@ -38766,7 +38762,7 @@ printLoadMessages, which gets called with \verb|%describe%| (append (|bright| (|object2String| (elt l 1))) (cons "is not among the valid choices." nil))))) (t nil))) - (tree (|set1| (kdr l) (sixth setdata)) nil) + (tree (|set1| (ifcdr l) (sixth setdata)) nil) (t (|sayMessage| `("Cannot handle set tree node type" ,@(|bright| st) |yet|)) @@ -39072,7 +39068,7 @@ o )what \calls{reportOpsFromLisplib}{constructor?} \calls{reportOpsFromLisplib}{sayKeyedMsg} \calls{reportOpsFromLisplib}{getConstructorSignature} -\calls{reportOpsFromLisplib}{kdr} +\calls{reportOpsFromLisplib}{ifcdr} \calls{reportOpsFromLisplib}{getdatabase} %\calls{reportOpsFromLisplib}{#} \calls{reportOpsFromLisplib}{eqsubstlist} @@ -39106,10 +39102,10 @@ o )what (if (null (setq fn (|constructor?| op))) (|sayKeyedMsg| "%1 is unknown, so no information is available." (list u)) (progn - (setq argml (when (setq s (|getConstructorSignature| op)) (kdr s))) + (setq argml (when (setq s (|getConstructorSignature| op)) (ifcdr s))) (setq typ (getdatabase op 'constructorkind)) (setq nArgs (|#| argml)) - (setq argList (kdr (getdatabase op 'constructorform))) + (setq argList (ifcdr (getdatabase op 'constructorform))) (setq functorForm (cons op argList)) (setq argml (eqsubstlist argList |$FormalMapVariableList| argml)) (mapcar #'(lambda (a m) (push (list '|:| a m) tmp1)) argList argml) @@ -41392,7 +41388,6 @@ Calls evaluateType on a signature. \end{chunk} \defun{recordFrame}{recordFrame} -\calls{recordFrame}{kar} \calls{recordFrame}{diffAlist} \calls{recordFrame}{seq} \calls{recordFrame}{exit} @@ -41405,7 +41400,7 @@ Calls evaluateType on a signature. (declare (special |$frameRecord| |$InteractiveFrame| |$previousBindings|)) (return (seq - (setq currentAlist (kar |$frameRecord|)) + (setq currentAlist (ifcar |$frameRecord|)) (setq delta (|diffAlist| (caar |$InteractiveFrame|) |$previousBindings|)) (cond ((eq systemNormal 'system) @@ -42374,7 +42369,6 @@ searchCurrentEnv(x,currentEnv) == KDR signal \end{verbatim} \calls{searchCurrentEnv}{assq} -\calls{searchCurrentEnv}{kdr} \begin{chunk}{defun searchCurrentEnv} (defun |searchCurrentEnv| (x currentEnv) (prog (u signal) @@ -42388,7 +42382,7 @@ searchCurrentEnv(x,currentEnv) == (cond ((setq u (assq x contour)) (return (setq signal u))) (t nil))))) - (kdr signal)))))) + (ifcdr signal)))))) \end{chunk} @@ -42403,7 +42397,6 @@ searchCurrentEnv(x,currentEnv) == ; KDR signal \end{verbatim} \calls{searchTailEnv}{assq} -\calls{searchTailEnv}{kdr} \begin{chunk}{defun searchTailEnv} (defun |searchTailEnv| (x e) (prog (u signal) @@ -42427,7 +42420,7 @@ searchCurrentEnv(x,currentEnv) == (cond (signal (return signal)) (t nil))))))) - (kdr signal)))))) + (ifcdr signal)))))) \end{chunk} @@ -56921,7 +56914,6 @@ There are 8 parts of an htPage: \calls{kPage}{capitalize} \calls{kPage}{ncParseFromString} \calls{kPage}{dbSourceFile} -\calls{kPage}{kdr} \calls{kPage}{dbConformGenUnder} \calls{kPage}{strconc} \calls{kPage}{isExposedConstructor} @@ -56962,7 +56954,7 @@ There are 8 parts of an htPage: (setq signature (|ncParseFromString| sig)) (setq sourceFileName (|dbSourceFile| (intern name))) (setq constrings - (if (kdr form) + (if (ifcdr form) (|dbConformGenUnder| form) (list (strconc name args)))) (setq emString (cons "{\\sf " (append constrings (list "}")))) @@ -57122,7 +57114,6 @@ There are 8 parts of an htPage: \calls{conSpecialString?}{ncParseFromString} \calls{conSpecialString?}{member} \calls{conSpecialString?}{conLowerCaseConTran} -\calls{conSpecialString?}{kar} \calls{conSpecialString?}{contained} \calls{conSpecialString?}{kisValidType} \calls{conSpecialString?}{strconc} @@ -57147,7 +57138,7 @@ There are 8 parts of an htPage: (t (setq form (|conLowerCaseConTran| parse)) (cond - ((or (member (kar form) '(|and| |or| |not|)) (contained '* form)) nil) + ((or (member (ifcar form) '(|and| |or| |not|)) (contained '* form)) nil) ((equal filter "Mapping") nil) ((setq u (|kisValidType| form)) u) (secondTime nil) @@ -58034,7 +58025,6 @@ There are 8 parts of an htPage: \defun{augmentHasArgs}{augmentHasArgs} \calls{augmentHasArgs}{opOf} -\calls{augmentHasArgs}{kdr} \calls{augmentHasArgs}{length} \calls{augmentHasArgs}{nreverse0} \calls{augmentHasArgs}{extractHasArgs} @@ -58043,7 +58033,7 @@ There are 8 parts of an htPage: (defun |augmentHasArgs| (alist conform) (let (conname args n name p result pred) (setq conname (|opOf| conform)) - (setq args (kdr conform)) + (setq args (ifcdr conform)) (cond (args (setq n (|#| args)) @@ -58055,7 +58045,7 @@ There are 8 parts of an htPage: p (|quickAnd| p (cons '|hasArgs| - (take n (kdr (|getConstructorForm| (|opOf| name)))))))) + (take n (ifcdr (|getConstructorForm| (|opOf| name)))))))) (setq result (cons (cons name pred) result)))) (t alist)))) @@ -58234,7 +58224,6 @@ There are 8 parts of an htPage: \calls{kDomainName}{htpLabelInputString} \calls{kDomainName}{getdatabase} \calls{kDomainName}{kArgumentCheck} -\calls{kDomainName}{kdr} \calls{kDomainName}{concat} \calls{kDomainName}{unabbrev} \calls{kDomainName}{mkConform} @@ -58272,7 +58261,7 @@ There are 8 parts of an htPage: (t (setq argTailPart (apply #'concat - (loop for x in (kdr args) collect (concat (cons "," x))))) + (loop for x in (ifcdr args) collect (concat (cons "," x))))) (apply #'concat (list "(" (car args) argTailPart ")"))))) (setq typeForm (or (catch 'spad_reader (|unabbrev| (|mkConform| kind name argString))) @@ -58285,7 +58274,6 @@ There are 8 parts of an htPage: \defun{kArgumentCheck}{kArgumentCheck} \calls{kArgumentCheck}{conSpecialString?} -\calls{kArgumentCheck}{kdr} \calls{kArgumentCheck}{opOf} \calls{kArgumentCheck}{form2String} \begin{chunk}{defun kArgumentCheck} @@ -58294,7 +58282,7 @@ There are 8 parts of an htPage: (cond ((string= s "") nil) ((and domain? (setq form (|conSpecialString?| s))) - (if (null (kdr form)) + (if (null (ifcdr form)) (list (princ-to-string (|opOf| form))) (|form2String| form))) (t (list s))))) @@ -58350,7 +58338,6 @@ There are 8 parts of an htPage: \end{chunk} \defun{kCheckArgumentNumbers}{kCheckArgumentNumbers} -\calls{kCheckArgumentNumbers}{kdr} \calls{kCheckArgumentNumbers}{getdatabase} \calls{kCheckArgumentNumbers}{kCheckArgumentNumber} \begin{chunk}{defun kCheckArgumentNumbers} @@ -58358,7 +58345,7 @@ There are 8 parts of an htPage: (let (conname args cosig) (setq conname (car tt)) (setq args (cdr tt)) - (setq cosig (kdr (getdatabase conname 'cosig))) + (setq cosig (ifcdr (getdatabase conname 'cosig))) (every #'identity (loop for domain? in cosig for x in args collect (if domain? (|kCheckArgumentNumbers| x) t))))) @@ -58524,12 +58511,11 @@ There are 8 parts of an htPage: \end{chunk} \defun{dbExtractUnderlyingDomain}{dbExtractUnderlyingDomain} -\calls{dbExtractUnderlyingDomain}{kdr} \calls{dbExtractUnderlyingDomain}{isValidType} \begin{chunk}{defun dbExtractUnderlyingDomain} (defun |dbExtractUnderlyingDomain| (domain) (some #'identity - (loop for x in (kdr domain) when (|isValidType| x) collect x))) + (loop for x in (ifcdr domain) when (|isValidType| x) collect x))) \end{chunk} @@ -58776,7 +58762,6 @@ There are 8 parts of an htPage: \defun{dbGetDocTable,hn}{dbGetDocTable,hn} \calls{dbGetDocTable,hn}{sublislis} -\calls{dbGetDocTable,hn}{kdr} \calls{dbGetDocTable,hn}{qcdr} \calls{dbGetDocTable,hn}{qcar} \usesdollar{dbGetDocTable,hn}{which} @@ -58797,7 +58782,7 @@ There are 8 parts of an htPage: (and (eql (|#| |$sig|) (|#| sig)) (setq alteredSig - (sublislis (kdr |$conform|) |$FormalMapVariableList| sig)) + (sublislis (ifcdr |$conform|) |$FormalMapVariableList| sig)) (equal alteredSig |$sig|))) (when (and pred doc (and (consp doc) (eq (qcar doc) '|constant|)) (qcdr doc) doc) diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index f3f458f..1d663cb 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -7218,7 +7218,6 @@ The compDefine function expects three arguments: \calls{compile}{userError} \calls{compile}{encodeItem} \calls{compile}{strconc} -\calls{compile}{kar} \calls{compile}{encodeFunctionName} \calls{compile}{splitEncodedFunctionName} \calls{compile}{sayBrightly} @@ -7379,12 +7378,11 @@ which will walk the structure $Y$ looking for this constant. \end{chunk} \defun{addEmptyCapsuleIfNecessary}{addEmptyCapsuleIfNecessary} -\calls{addEmptyCapsuleIfNecessary}{kar} \usesdollar{addEmptyCapsuleIfNecessary}{SpecialDomainNames} \begin{chunk}{defun addEmptyCapsuleIfNecessary} (defun |addEmptyCapsuleIfNecessary| (target rhs) (declare (special |$SpecialDomainNames|) (ignore target)) - (if (member (kar rhs) |$SpecialDomainNames|) + (if (member (ifcar rhs) |$SpecialDomainNames|) rhs (list '|add| rhs (list 'capsule)))) @@ -9845,7 +9843,6 @@ optPackageCall. \defun{optCallSpecially}{optCallSpecially} \calls{optCallSpecially}{lassoc} -\calls{optCallSpecially}{kar} \calls{optCallSpecially}{get} \calls{optCallSpecially}{opOf} \calls{optCallSpecially}{optSpecialCall} @@ -9872,7 +9869,7 @@ optPackageCall. (cond ((setq y (lassoc r |$specialCaseKeyList|)) (|optSpecialCall| x y n)) - ((member (kar r) |$optimizableConstructorNames|) + ((member (ifcar r) |$optimizableConstructorNames|) (|optSpecialCall| x r n)) ((and (setq y (|get| r '|value| |$e|)) (member (|opOf| (car y)) |$optimizableConstructorNames|)) @@ -9911,7 +9908,7 @@ optPackageCall. (cond ((eq (caaar x) 'const) (cond - ((equal (kar (elt yval n)) #'|Undef|) + ((equal (ifcar (elt yval n)) #'|Undef|) (|keyedSystemError| "Unexpected error or improper call to system function %1: %2" (list "optSpecialCall" "invalid constant"))) @@ -10670,7 +10667,6 @@ The way XLAMs work: \defun{augModemapsFromDomain}{augModemapsFromDomain} \calls{augModemapsFromDomain}{member} -\calls{augModemapsFromDomain}{kar} \calls{augModemapsFromDomain}{getDomainsInScope} \calls{augModemapsFromDomain}{getdatabase} \calls{augModemapsFromDomain}{opOf} @@ -10685,7 +10681,7 @@ The way XLAMs work: (let (curDomainsInScope u innerDom) (declare (special |$Category| |$DummyFunctorNames|)) (cond - ((|member| (or (kar name) name) |$DummyFunctorNames|) + ((|member| (or (ifcar name) name) |$DummyFunctorNames|) env) ((or (equal name |$Category|) (|isCategoryForm| name env)) env) @@ -10705,7 +10701,6 @@ The way XLAMs work: \defun{augModemapsFromDomain1}{augModemapsFromDomain1} \calls{augModemapsFromDomain1}{getl} -\calls{augModemapsFromDomain1}{kar} \calls{augModemapsFromDomain1}{addConstructorModemaps} \calls{augModemapsFromDomain1}{getmode} \calls{augModemapsFromDomain1}{augModemapsFromCategory} @@ -10716,11 +10711,11 @@ The way XLAMs work: (defun |augModemapsFromDomain1| (name functorForm env) (let (mappingForm categoryForm functArgTypes catform) (cond - ((getl (kar functorForm) '|makeFunctionList|) + ((getl (ifcar functorForm) '|makeFunctionList|) (|addConstructorModemaps| name functorForm env)) ((and (atom functorForm) (setq catform (|getmode| functorForm env))) (|augModemapsFromCategory| name functorForm catform env)) - ((setq mappingForm (|getmodeOrMapping| (kar functorForm) env)) + ((setq mappingForm (|getmodeOrMapping| (ifcar functorForm) env)) (when (eq (car mappingForm) '|Mapping|) (car mappingForm)) (setq categoryForm (cadr mappingForm)) (setq functArgTypes (cddr mappingForm)) @@ -11281,7 +11276,7 @@ add flag identifiers as literals in the environment ; following calls to SUBSTQ must copy to save RPLAC's in ; putInLocalDomainReferences (dolist (term - (eqsubstlist (kdr functorForm) |$FormalMapVariableList| opalist) + (eqsubstlist (ifcdr functorForm) |$FormalMapVariableList| opalist) (nreverse0 tmp0)) (setq tmp1 (reverse term)) (setq sel (caar tmp1)) @@ -11697,7 +11692,6 @@ Since we can't be sure we take the least disruptive course of action. \calls{doIt}{stackSemanticError} \calls{doIt}{bright} \calls{doIt}{member} -\calls{doIt}{kar} \calls{doIt}{|isFunctor} \calls{doIt}{insert} \calls{doIt}{opOf} @@ -11800,7 +11794,7 @@ Since we can't be sure we take the least disruptive course of action. (t (setq lhs lhsp) (cond - ((and (null (|member| (kar rhs) |$NonMentionableDomainNames|)) + ((and (null (|member| (ifcar rhs) |$NonMentionableDomainNames|)) (null (member lhs |$functorLocalParameters|))) (setq |$functorLocalParameters| (append |$functorLocalParameters| (list lhs))))) @@ -14567,7 +14561,6 @@ This function returns the index of domain entry x in the association list \end{chunk} \defun{isDomainForm}{isDomainForm} -\calls{isDomainForm}{kar} \calls{isDomainForm}{isFunctor} \calls{isDomainForm}{isCategoryForm} \calls{isDomainForm}{isDomainConstructorForm} @@ -14576,7 +14569,7 @@ This function returns the index of domain entry x in the association list (defun |isDomainForm| (d env) (let (tmp1) (declare (special |$SpecialDomainNames|)) - (or (member (kar d) |$SpecialDomainNames|) (|isFunctor| d) + (or (member (ifcar d) |$SpecialDomainNames|) (|isFunctor| d) (and (progn (setq tmp1 (|getmode| d env)) (and (consp tmp1) (eq (qfirst tmp1) '|Mapping|) (consp (qrest tmp1)))) @@ -16956,11 +16949,10 @@ of the symbol being parsed. The original list read: \end{chunk} \defun{hackforis1}{hackforis1} -\calls{hackforis1}{kar} \calls{hackforis1}{eqcar} \begin{chunk}{defun hackforis1} (defun hackforis1 (x) - (if (and (member (kar x) '(in on)) (eqcar (second x) 'is)) + (if (and (member (ifcar x) '(in on)) (eqcar (second x) 'is)) (cons (first x) (cons (cons 'setq (cdadr x)) (cddr x))) x)) diff --git a/changelog b/changelog index 3687caf..dfd2366 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,23 @@ +20150525 tpd src/axiom-website/patches.html 20150525.01.tpd.patch +20150525 tpd books/bookvol5 remove KAR, KDR, KADR, KADDR macros +20150525 tpd books/bookvol9 remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/br-con.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/c-util.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/cattable.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/format.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/functor.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/i-coerfn.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/i-output.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/i-resolv.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/interop.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/lisplib.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/nruncomp.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/nrunfast.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/nrungo.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/nrunopt.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/profile.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/record.lisp remove KAR, KDR, KADR, KADDR macros +20150525 tpd src/interp/vmlisp.lisp remove KAR, KDR, KADR, KADDR macros 20150519 tpd src/axiom-website/patches.html 20150519.06.tpd.patch 20150519 tpd books/bookvolbib add Thie15 reference 20150519 tpd src/axiom-website/patches.html 20150519.05.tpd.patch diff --git a/patch b/patch index 6a178d7..415524d 100644 --- a/patch +++ b/patch @@ -1,45 +1,3 @@ -books/bookvolbib add Thie15 reference +src/interp/vmlisp.lisp remove KAR, KDR, KAAR, KADR macros -@misc{Thie15, - author = "Thiery, Nicolas M.", - title = "Open Digital Research Environment Toolkit for the Advancement of Mathematics", - year = "2015", - url = "http://opendreamkit.org", - paper = "Thie15.pdf", - abstract = - "OpenDreamKit will deliver a flexible toolkit enabling research groups - to set up Virtual Research Environments, customised to meet the varied - needs of research projects in pure mathematics and applications, and - supporting the full research life-cycle from exploration, through - proof and publication, to archival and sharing of data and code. - - OpenDreamKit will be built out of a sustainable ecosystem of - community-developed open software, databases, and ser- vices, - including popular tools such as LINBOX, MPIR, SAGE (sagemath.org), - GAP, PARI/GP, LMFDB, and SINGULAR. We will extend the JUPYTER Notebook - environment to provide a flexible user interface. By improving and - unifying existing build- ing blocks, OpenDreamKit will maximise both - sustainability and impact, with beneficiaries extending to scientific - computing, physics, chemistry, biology and more, and including - researchers, teachers, and industrial practitioners. - - We will define a novel component-based VRE architecture and adapt - existing mathematical software, databases, and user interface - components to work well within it on varied platforms. Interfaces to - standard HPC and grid services will be built in. Our architecture will - be informed by recent research into the sociology of mathematical - collaboration, so as to properly support actual research practice. The - ease of set up, adaptability and global impact will be demonstrated in - a variety of demonstrator VREs. - - We will ourselves study the social challenges associated with - large-scale open source code development and publications based on - executable documents, to ensure sustainability. - - OpenDreamKit will be conducted by a Europe-wide steered by demand - collaboration, including leading mathematicians, computational - researchers, and software developers with a long track record of - delivering innovative open source software solutions for their - respective communities. All produced code and tools will be open - source." -} +move closer to common lisp. \ No newline at end of file diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index a67d131..5aa994d 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -5074,6 +5074,8 @@ src/interp/vmlisp.lisp rewrite character handling functions
src/interp/c-doc.lisp merge c-doc functions, removed
20150519.06.tpd.patch books/bookvolbib add Thie15 reference
+20150525.01.tpd.patch +src/interp/vmlisp.lisp remove KAR, KDR, KADR, KADDR macros
diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index ee5700d..f71007f 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -1913,14 +1913,14 @@ ((HAS_SHARP_VAR |args|) (BOOT-EQUAL |domargs| (|sublisFormal| - (KDR |domname|) |args|))) + (IFCDR |domname|) |args|))) ('T NIL))) (COND ((NULL |match?|) '|skip|) ('T (setq |npred| (|sublisFormal| - (KDR |leftForm|) |pred|)) + (IFCDR |leftForm|) |pred|)) (setq |acc| (CONS (CONS |leftForm| |npred|) @@ -1939,12 +1939,12 @@ (|systemError| NIL))) (RPLACA |pair| |leftForm|) (RPLACD |pair| - (|sublisFormal| (KDR |leftForm|) + (|sublisFormal| (IFCDR |leftForm|) (CDR |pair|))))))) |s|))) ('T (setq |acc| NIL) (COND - ((KDR |conform|) + ((IFCDR |conform|) (setq |farglist| (TAKE (|#| (CDR |conform|)) |$FormalMapVariableList|)) @@ -1976,12 +1976,12 @@ (NEQUAL |args| |farglist|)) (setq |npred| (|sublisFormal| - (KDR |leftForm|) |pred|)) + (IFCDR |leftForm|) |pred|)) (COND (|hasArgsForm?| (setq |subargs| (|sublisFormal| - (KDR |leftForm|) |args|)) + (IFCDR |leftForm|) |args|)) (setq |hpred| (CONS '|hasArgs| |subargs|)) @@ -2005,7 +2005,7 @@ (RPLACA |pair| |leftForm|) (RPLACD |pair| (|sublisFormal| - (KDR |leftForm|) (CDR |pair|))))))) + (IFCDR |leftForm|) (CDR |pair|))))))) |s|)))))))) ;mkHasArgsPred subargs == @@ -2209,7 +2209,7 @@ (SEQ (PROGN (|sayBrightly| "-------------Operation summary-----------------") - (setq |missingOnlyFlag| (KAR |options|)) + (setq |missingOnlyFlag| (ifcar |options|)) (setq |domainForm| (|devaluate| |dom|)) (setq |nam| (CAR |domainForm|)) (setq |$domainArgs| (CDR |domainForm|)) @@ -2335,7 +2335,7 @@ (DECLARE (SPECIAL |$predicateList|)) (RETURN (SEQ (PROGN - (setq |ops| (KAR |option|)) + (setq |ops| (ifcar |option|)) (setq |alist| NIL) (setq |domainForm| (|devaluate| D)) (setq |nam| (CAR |domainForm|)) @@ -2472,7 +2472,7 @@ (setq |conname| (CAR |domname|)) (setq |$predicateList| (GETDATABASE |conname| 'PREDICATES)) - (setq |ops| (KAR |option|)) + (setq |ops| (ifcar |option|)) (PROG (G170045) (setq G170045 NIL) (RETURN @@ -2502,7 +2502,7 @@ ;from?(D,op,sig) == KAR KDR getInheritanceByDoc(D,op,sig) (defun |from?| (D |op| |sig|) - (KAR (KDR (|getInheritanceByDoc| D |op| |sig|)))) + (ifcar (IFCDR (|getInheritanceByDoc| D |op| |sig|)))) ;getExtensionsOfDomain domain == ; u := getDomainExtensionsOfDomain domain @@ -2656,7 +2656,7 @@ (RETURN (SEQ (PROGN (setq |catList| - (OR (KAR |options|) (|getExtensionsOfDomain| D))) + (OR (ifcar |options|) (|getExtensionsOfDomain| D))) (OR (|getDocDomainForOpSig| |op| |sig| (|devaluate| D) D) (PROG (G170178) (setq G170178 NIL) @@ -3091,7 +3091,7 @@ (NEQUAL (|dbPart| |x| 2 1) "0")) - ('T (KAR |x|))))))))))))))))))))) + ('T (ifcar |x|))))))))))))))))))))) ;--============================================================================ ;-- Master Switch Functions for Operation Views @@ -3595,7 +3595,7 @@ ('T NIL))) (COND ((AND (BOOT-EQUAL |what| "Condition") - (NULL (KAR (KAR |data|)))) + (NULL (ifcar (ifcar |data|)))) (setq |dataCount| (- |dataCount| 1)))) (setq |exposurePart| (COND @@ -3822,7 +3822,7 @@ (SETQ G170850 (CONS |x| G170850))))))))))) (COND - ((KDR |domname|) + ((IFCDR |domname|) (CONS " {\\em from} " (|dbConformGen| |domname|))) ('T (|htpProperty| |htPage| '|fromHeading|))))))))))) @@ -3841,7 +3841,7 @@ (defun |conformString| (|form|) (COND - ((KDR |form|) + ((IFCDR |form|) (|conform2StringList| |form| #'|conname2StringList| #'|conformString| NIL)) ('T (|form2StringList| |form|)))) @@ -5509,15 +5509,15 @@ (|dbShowOpParameterJump| |ops| |which| |count| |single?|) (|htSay| " {\\em " - (KAR |args|) "}")) + (ifcar |args|) "}")) ((AND (EQL |n| 3) (LASSOC '|Led| (PROPLIST |op|))) (|htSay| "{\\em " - (KAR |args|) "} ") + (ifcar |args|) "} ") (|dbShowOpParameterJump| |ops| |which| |count| |single?|) (|htSay| " {\\em " - (KAR (KDR |args|)) + (ifcar (IFCDR |args|)) "}")) ('T (|dbShowOpParameterJump| |ops| @@ -6937,7 +6937,7 @@ (DECLARE (SPECIAL |$predEvalAlist| |$returnNowhereFromGoGet|)) (RETURN (SEQ (PROGN - (setq |ops| (KAR |options|)) + (setq |ops| (ifcar |options|)) (setq |$predEvalAlist| NIL) (setq |$returnNowhereFromGoGet| 'T) (setq |domname| (ELT |dom| 0)) @@ -17649,7 +17649,7 @@ (|htSay| "}{") (COND ((OR |one?| (|member| '|names| |exclusions|) - (NULL (KDR |opAlist|))) + (NULL (IFCDR |opAlist|))) (|htSay| "{\\em Names}")) ('T (|htMakePage| @@ -18036,15 +18036,15 @@ (|do| (COND ((AND (EQL |n| 2) (LASSOC '|Nud| (PROPLIST |op|))) (|htSay| |ops| " {\\em " - (|quickForm2HtString| (KAR |args|)) + (|quickForm2HtString| (ifcar |args|)) "}")) ((AND (EQL |n| 3) (LASSOC '|Led| (PROPLIST |op|))) (|htSay| "{\\em " - (|quickForm2HtString| (KAR |args|)) + (|quickForm2HtString| (ifcar |args|)) "} " |ops| " {\\em " (|quickForm2HtString| - (KAR (KDR |args|))) + (ifcar (IFCDR |args|))) "}")) ('T (COND @@ -18141,7 +18141,7 @@ (|args| (|htSayStandard| "\\newline\\tab{2}{\\em Arguments:}") (setq |coSig| - (KDR (GETDATABASE |op| 'COSIG))) + (IFCDR (GETDATABASE |op| 'COSIG))) (DO ((G179518 |args| (CDR G179518)) (|a| NIL) (G179519 (CDR |$sig|) (CDR G179519)) @@ -18158,11 +18158,11 @@ (SEQ (EXIT (PROGN (|htSayIndentRel| 15 'T) (setq |position| - (KAR |relatives|)) + (ifcar |relatives|)) (setq |relatives| - (KDR |relatives|)) + (IFCDR |relatives|)) (COND - ((AND (KAR |coSig|) + ((AND (ifcar |coSig|) (NEQUAL |t| '(|Type|))) (|htMakePage| (CONS @@ -18181,7 +18181,7 @@ "}"))) (|htSay| '|, |) (setq |coSig| - (KDR |coSig|)) + (IFCDR |coSig|)) (|htSayValue| |t|) (|htSayIndentRel| (- 15) 'T) @@ -18212,7 +18212,7 @@ (COND ((NULL (member |predicate| '(T ASCONST))) (setq |pred| - (|sublisFormal| (KDR |conform|) |predicate|)) + (|sublisFormal| (IFCDR |conform|) |predicate|)) (setq |count| (|#| |pred|)) (|htSayStandard| "\\newline\\tab{2}{\\em Conditions:}") @@ -18270,7 +18270,7 @@ (setq |firstTime| NIL) (|htSay| '|{\\em | |d| '|} is |) (|htSayConstructor| |key| - (|sublisFormal| (KDR |conform|) + (|sublisFormal| (IFCDR |conform|) |t|)) (|htSayIndentRel| (- 15) diff --git a/src/interp/c-util.lisp.pamphlet b/src/interp/c-util.lisp.pamphlet index 714a7ee..62fdf52 100644 --- a/src/interp/c-util.lisp.pamphlet +++ b/src/interp/c-util.lisp.pamphlet @@ -648,7 +648,7 @@ (SEQ (IF (BOOT-EQUAL |pair| (setq |pair'| (|assoc| |prop| |p'|))) (EXIT |pair|)) - (IF (AND (AND (setq |val'| (KDR |pair'|)) + (IF (AND (AND (setq |val'| (IFCDR |pair'|)) (BOOT-EQUAL |prop| '|value|)) (setq |m| (|intersectionContour,unifiable| diff --git a/src/interp/cattable.lisp.pamphlet b/src/interp/cattable.lisp.pamphlet index f6d7409..bf8b7e3 100644 --- a/src/interp/cattable.lisp.pamphlet +++ b/src/interp/cattable.lisp.pamphlet @@ -698,7 +698,7 @@ (PROGN (setq |conform| (|getConstructorForm| (|opOf| |domform|))) (setq |catval| (EVAL (|mkEvalable| |conform|))) - (COND ((ATOM (KDR |attr|)) (setq |attr| (IFCAR |attr|)))) + (COND ((ATOM (IFCDR |attr|)) (setq |attr| (IFCAR |attr|)))) (setq |pred| (COND ((setq |u| (LASSOC |attr| (ELT |catval| 2))) diff --git a/src/interp/format.lisp.pamphlet b/src/interp/format.lisp.pamphlet index 2b0bebb..d415a08 100644 --- a/src/interp/format.lisp.pamphlet +++ b/src/interp/format.lisp.pamphlet @@ -854,7 +854,7 @@ code which fixes bug 7217 bad title generated in Axiom 3D output. (SETQ |n| (CADR (CDADDR . #2#))) (SETQ |opSigString| (|formatOpSignature| |op| |sig|)) (COND - ((AND (INTEGERP |n|) (EQUAL #'|Undef| (KAR (ELT |domain| |n|)))) + ((AND (INTEGERP |n|) (EQUAL #'|Undef| (ifcar (ELT |domain| |n|)))) (PROGN (COND ((INTEGERP |$commentedOps|) diff --git a/src/interp/functor.lisp.pamphlet b/src/interp/functor.lisp.pamphlet index 72a6258..93f2660 100644 --- a/src/interp/functor.lisp.pamphlet +++ b/src/interp/functor.lisp.pamphlet @@ -981,7 +981,7 @@ ((NULL (CDR |$definition|)) |body|) ('T (setq |name| - (INTERN (STRCONC (KAR |$definition|) '|;CAT|))) + (INTERN (STRCONC (ifcar |$definition|) '|;CAT|))) (SETANDFILE |name| NIL) (setq |body| (CONS 'COND @@ -3108,7 +3108,7 @@ (CAR |u|) (setq |implem| (CADDR |u|))) - (KADDR |implem|)) + (ifcar (ifcdr (ifcdr |implem|)))) (SETQ G167951 (CONS |implem| G167951))))))))))))))) diff --git a/src/interp/i-coerfn.lisp.pamphlet b/src/interp/i-coerfn.lisp.pamphlet index 4a18cda..eb51a6f 100755 --- a/src/interp/i-coerfn.lisp.pamphlet +++ b/src/interp/i-coerfn.lisp.pamphlet @@ -1827,7 +1827,7 @@ all these coercion functions have the following result: |newargmode|)) (COND ((NULL |unit'|) (|coercionFailure|)) - ('T (setq |factors| (KDR |u'|)) + ('T (setq |factors| (IFCDR |u'|)) (setq |factors'| (PROG (G167438) (setq G167438 NIL) diff --git a/src/interp/i-output.lisp.pamphlet b/src/interp/i-output.lisp.pamphlet index d57d2d3..6508eaa 100644 --- a/src/interp/i-output.lisp.pamphlet +++ b/src/interp/i-output.lisp.pamphlet @@ -6810,10 +6810,10 @@ NIL (setq |a| (CAR (setq |u| (CDR |u|)))) (setq |b| (CAR (setq |u| (CDR |u|)))) (setq |c| - (OR (CAR (setq |u| (KDR |u|))) '((NOTHING . 0)))) + (OR (CAR (setq |u| (IFCDR |u|))) '((NOTHING . 0)))) (setq |d| - (OR (KAR (setq |u| (KDR |u|))) '((NOTHING . 0)))) - (setq |e| (OR (KADR |u|) '((NOTHING . 0)))) + (OR (ifcar (setq |u| (IFCDR |u|))) '((NOTHING . 0)))) + (setq |e| (OR (ifcar (ifcdr |u|)) '((NOTHING . 0)))) (setq |aox| (MAX (setq |wd| (WIDTH |d|)) (setq |we| (WIDTH |e|)))) @@ -6867,8 +6867,8 @@ NIL (RETURN (PROGN (setq |a| (CAR (setq |u| (CDR |u|)))) - (setq |b| (KAR (setq |u| (KDR |u|)))) - (setq |e| (KAR (KDR (KDR (KDR |u|))))) + (setq |b| (ifcar (setq |u| (IFCDR |u|)))) + (setq |e| (ifcar (IFCDR (IFCDR (IFCDR |u|))))) (RETURN (+ (|subspan| |a|) (MAX (|height| |b|) (|height| |e|)))))))) @@ -7185,10 +7185,10 @@ NIL (setq |a| (CAR (setq |u| (CDR |u|)))) (setq |b| (CAR (setq |u| (CDR |u|)))) (setq |c| - (OR (CAR (setq |u| (KDR |u|))) '((NOTHING . 0)))) + (OR (CAR (setq |u| (IFCDR |u|))) '((NOTHING . 0)))) (setq |d| - (OR (KAR (setq |u| (KDR |u|))) '((NOTHING . 0)))) - (setq |e| (OR (KADR |u|) '((NOTHING . 0)))) + (OR (ifcar (setq |u| (IFCDR |u|))) '((NOTHING . 0)))) + (setq |e| (OR (ifcar (ifcdr |u|)) '((NOTHING . 0)))) (RETURN (+ (+ (MAX (WIDTH |d|) (WIDTH |e|)) (MAX (WIDTH |b|) (WIDTH |c|))) @@ -7205,8 +7205,8 @@ NIL (RETURN (PROGN (setq |a| (CAR (setq |u| (CDR |u|)))) - (setq |c| (KAR (setq |u| (KDR (KDR |u|))))) - (setq |d| (KADR |u|)) + (setq |c| (ifcar (setq |u| (IFCDR (IFCDR |u|))))) + (setq |d| (ifcar (ifcdr |u|))) (RETURN (+ (|superspan| |a|) (MAX (|height| |c|) (|height| |d|)))))))) diff --git a/src/interp/i-resolv.lisp.pamphlet b/src/interp/i-resolv.lisp.pamphlet index 8ebd762..0efd75c 100644 --- a/src/interp/i-resolv.lisp.pamphlet +++ b/src/interp/i-resolv.lisp.pamphlet @@ -2498,7 +2498,7 @@ this symmetric resolution is done the following way: (PROG (|dt| |args| |x| |c|) (RETURN (SEQ (COND - ((AND (KDR |t|) (|constructor?| (CAR |t|))) + ((AND (IFCDR |t|) (|constructor?| (CAR |t|))) (setq |dt| (|destructT| (CAR |t|))) (setq |args| (PROG (G167926) diff --git a/src/interp/interop.lisp.pamphlet b/src/interp/interop.lisp.pamphlet index 1f31da5..a36608d 100644 --- a/src/interp/interop.lisp.pamphlet +++ b/src/interp/interop.lisp.pamphlet @@ -545,7 +545,7 @@ (setq |dom| (CAR (CDDDDR G166272))) (setq |catform| (ELT |parvec| (- |n| 1))) (COND - ((VECTORP (KAR |catform|)) |catform|) + ((VECTORP (ifcar |catform|)) |catform|) ('T (setq |newcat| (|oldAxiomPreCategoryBuild| |catform| |dom| NIL)) diff --git a/src/interp/lisplib.lisp.pamphlet b/src/interp/lisplib.lisp.pamphlet index f423733..a79dd87 100644 --- a/src/interp/lisplib.lisp.pamphlet +++ b/src/interp/lisplib.lisp.pamphlet @@ -271,7 +271,7 @@ (declare (special $FUNCTION)) (RETURN (COND - ((setq |file| (KDR (GETL |fun| 'DEFLOC))) + ((setq |file| (IFCDR (GETL |fun| 'DEFLOC))) (|pathname| |file|)) ((NULL (OR (setq |fileinfo| (FUNLOC |fun|)) (setq |fileinfo| (FUNLOC (|unabbrev| |fun|))))) diff --git a/src/interp/nruncomp.lisp.pamphlet b/src/interp/nruncomp.lisp.pamphlet index 7437d4e..284fcba 100644 --- a/src/interp/nruncomp.lisp.pamphlet +++ b/src/interp/nruncomp.lisp.pamphlet @@ -343,7 +343,7 @@ (setq |u| (|get| |form| '|value| |$e|))) (setq |u| (CAR |u|)) (COND - ((member (KAR |u|) '(|Union| |Record|)) + ((member (ifcar |u|) '(|Union| |Record|)) (|listOfBoundVars| |u|)) ('T (CONS |form| NIL)))) ((ATOM |form|) NIL) @@ -420,7 +420,7 @@ ('T |dc|))) (setq |sig| (MSUBST |ndc| |dc| |sig|)) (COND - ((NULL (member (KAR |ndc|) + ((NULL (member (ifcar |ndc|) |$optimizableConstructorNames|)) NIL) ('T (setq |dcval| (|optCallEval| |ndc|)) @@ -1970,7 +1970,7 @@ (OR (|optimize| (COPY - (KAR + (ifcar (|comp| |d| |$EmptyMode| |$e|)))) |d|) diff --git a/src/interp/nrunfast.lisp.pamphlet b/src/interp/nrunfast.lisp.pamphlet index 0123472..a870926 100644 --- a/src/interp/nrunfast.lisp.pamphlet +++ b/src/interp/nrunfast.lisp.pamphlet @@ -909,7 +909,7 @@ (setq |catVec| (CADR |slot4|)) (COND ((EQL (SIZE |catVec|) 0) NIL) - ((INTEGERP (KDR (ELT |catVec| 0))) + ((INTEGERP (IFCDR (ELT |catVec| 0))) (|newLookupInCategories1| |op| |sig| |dom| |dollar|)) ('T (setq |$lookupDefaults| NIL) (COND @@ -1194,7 +1194,7 @@ (SEQ (COND ((setq |addFormCell| (ELT |addFormDomain| |index|)) (COND - ((INTEGERP (KAR |addFormCell|)) + ((INTEGERP (ifcar |addFormCell|)) (PROG (G166464) (setq G166464 NIL) (RETURN @@ -1298,7 +1298,7 @@ (setq |catVec| (CADR |slot4|)) (COND ((EQL (SIZE |catVec|) 0) NIL) - ((INTEGERP (KDR (ELT |catVec| 0))) + ((INTEGERP (IFCDR (ELT |catVec| 0))) (|newLookupInCategories1| |op| |sig| |dom| |dollar|)) ('T (setq |$lookupDefaults| NIL) (COND @@ -1975,7 +1975,7 @@ (|$isDefaultingPackage| (ELT (ELT |domain| 6) 0)) ('T (ELT |domain| 0)))) - (AND (BOOT-EQUAL (KAR |s|) (QCAR (ELT |d| 0))) + (AND (BOOT-EQUAL (ifcar |s|) (QCAR (ELT |d| 0))) (|lazyMatchArgDollarCheck| |s| (ELT |d| 0) (ELT |dollar| 0) |domainArg|))))) ((|isDomain| |d|) (setq |dhash| (|getDomainHash| |d|)) @@ -3084,7 +3084,7 @@ (|isDefaultPackageForm?| (|devaluate| |domain|))) (COND ((AND (> (|#| |catvec|) 0) - (INTEGERP (KDR (ELT |catvec| 0)))) + (INTEGERP (IFCDR (ELT |catvec| 0)))) (setq |predIndex| (|lazyMatchAssocV1| |catform| |catvec| |domain|)) (COND diff --git a/src/interp/nrungo.lisp.pamphlet b/src/interp/nrungo.lisp.pamphlet index 717347d..a02c1ae 100644 --- a/src/interp/nrungo.lisp.pamphlet +++ b/src/interp/nrungo.lisp.pamphlet @@ -316,7 +316,7 @@ (let (addFormCell) (when (setq addFormCell (elt addFormDomain index)) (cond - ((integerp (kar addFormCell)) + ((integerp (ifcar addFormCell)) (let (result) (loop for i in addFormCell do (setq result diff --git a/src/interp/nrunopt.lisp.pamphlet b/src/interp/nrunopt.lisp.pamphlet index 02cfa18..a06f5ea 100644 --- a/src/interp/nrunopt.lisp.pamphlet +++ b/src/interp/nrunopt.lisp.pamphlet @@ -2010,8 +2010,8 @@ (PROG (|options| |con| |ok| |option|) (RETURN (PROGN - (setq |con| (KAR |r|)) - (setq |options| (KDR |r|)) + (setq |con| (IFCAR |r|)) + (setq |options| (IFCDR |r|)) (setq |ok| (OR (member |con| (|allConstructors|)) (setq |con| (|abbreviation?| |con|)))) @@ -2021,7 +2021,7 @@ "Format is: dc(,option)") (|sayBrightly| "options are: all (default), slots, atts, cats, data, ops, optable")) - ('T (setq |option| (KAR |options|)) + ('T (setq |option| (IFCAR |options|)) (COND ((OR (BOOT-EQUAL |option| '|all|) (NULL |option|)) (|dcAll| |con|)) @@ -2739,7 +2739,7 @@ |vSize| |itotal| |lookupFun| |suffix| |vtotal| |etotal|) (RETURN (SEQ (PROGN - (setq |con| (KAR |options|)) + (setq |con| (IFCAR |options|)) (setq |options| (CDR |options|)) (COND ((NULL |con|) (|dcSizeAll|)) @@ -3477,7 +3477,7 @@ (setq |prinAncestorList| (CAR |slot4|)) (COND ((|member| |v| |prinAncestorList|) 'T) - ('T (setq |vOp| (KAR |v|)) + ('T (setq |vOp| (IFCAR |v|)) (COND ((setq |similarForm| (|assoc| |vOp| |prinAncestorList|)) diff --git a/src/interp/profile.lisp.pamphlet b/src/interp/profile.lisp.pamphlet index ad4b1c8..8562cc7 100644 --- a/src/interp/profile.lisp.pamphlet +++ b/src/interp/profile.lisp.pamphlet @@ -62,7 +62,7 @@ NIL) (SEQ (EXIT (PROGN (setq |op| (|opOf| |opSig|)) - (setq |sig| (KAR (KDR |opSig|))) + (setq |sig| (IFCAR (IFCDR |opSig|))) (HPUT |$profileHash| |op| (CONS (CONS |sig| |info|) (HGET |$profileHash| |op|))))))) diff --git a/src/interp/record.lisp.pamphlet b/src/interp/record.lisp.pamphlet index ca0547f..a196deb 100644 --- a/src/interp/record.lisp.pamphlet +++ b/src/interp/record.lisp.pamphlet @@ -112,7 +112,7 @@ ((NULL (|isExistingFile| |pathname|)) (|throwKeyedMsg| "The file %1 is needed but does not exist." (CONS (|namestring| |ifn|) NIL))) - ('T (setq |opath| (OR (KAR |option|) |pathname|)) + ('T (setq |opath| (OR (IFCAR |option|) |pathname|)) (setq |odirect| (|pathnameDirectory| |opath|)) (setq |opathname| (|htMkPath| |odirect| |ifn| "rec")) @@ -156,7 +156,7 @@ |$printTypeIfTrue|)) (RETURN (SEQ (PROGN - (setq $LINELENGTH (OR (KAR |option|) 76)) + (setq $LINELENGTH (OR (IFCAR |option|) 76)) (setq |$printTimeIfTrue| NIL) (setq |$printTypeIfTrue| 'T) (setq |stream| @@ -547,7 +547,7 @@ ((NULL (|isExistingFile| |pathname|)) (|throwKeyedMsg| "The file %1 is needed but does not exist." (CONS (|namestring| |ifn|) NIL))) - ('T (setq |opath| (OR (KAR |option|) |pathname|)) + ('T (setq |opath| (OR (IFCAR |option|) |pathname|)) (setq |odirect| (|pathnameDirectory| |opath|)) (setq |opathname| (|htMkPath| |odirect| |ifn| @@ -706,7 +706,7 @@ (DEFUN |htFile2RecordFile| (&REST G166449 &AUX |option| |pathname|) (DSETQ (|pathname| . |option|) G166449) (|inputFile2RecordFile| - (|htFile2InputFile| |pathname| (KAR |option|)))) + (|htFile2InputFile| |pathname| (IFCAR |option|)))) ;--======================================================================= ;-- Function to record and print values into $testStream diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 49b2f81..0b0c2f9 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -2398,11 +2398,6 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal (defvar |$definingMap| nil) -(defmacro KAR (ARG) `(ifcar ,arg)) -(defmacro KDR (ARG) `(ifcdr ,arg)) -(defmacro KADR (ARG) `(ifcar (ifcdr ,arg))) -(defmacro KADDR (ARG) `(ifcar (ifcdr (ifcdr ,arg)))) - ; 5 PROGRAM STRUCTURE ; 5.3 Top-Level Forms @@ -2505,7 +2500,7 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal (COND (|$letAssoc| (|mapLetPrint| ,(MKQ var) ,var - (QUOTE ,(KAR L)))) + (QUOTE ,(IFCAR L)))) ('T ,var)))) ;; used for LETs in SPAD code --- see devious trick in COMP,TRAN,1 ((ATOM var) @@ -2513,10 +2508,12 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal (SETQ ,var ,val) (IF |$letAssoc| ,(cond ((null (cdr l)) - `(|letPrint| ,(MKQ var) ,var (QUOTE ,(KAR L)))) + `(|letPrint| ,(MKQ var) ,var (QUOTE ,(IFCAR L)))) ((and (eqcar (car l) 'SPADCALL) (= (length (car l)) 3)) - `(|letPrint3| ,(MKQ var) ,var ,(third (car l)) (QUOTE ,(KADR L)))) - (t `(|letPrint2| ,(MKQ var) ,(car l) (QUOTE ,(KADR L)))))) + `(|letPrint3| ,(MKQ var) ,var ,(third (car l)) + (QUOTE ,(ifcar (ifcdr L))))) + (t `(|letPrint2| ,(MKQ var) ,(car l) + (QUOTE ,(ifcar (ifcdr L))))))) ,var)) ('T (ERROR "Cannot compileLET construct")))) @@ -2576,7 +2573,7 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal (defun REPEAT-TRAN (L LP) (COND ((ATOM L) (ERROR "REPEAT FORMAT ERROR")) - ((MEMBER (KAR (KAR L)) + ((MEMBER (IFCAR (IFCAR L)) '(EXIT RESET IN ON GSTEP ISTEP STEP GENERAL UNTIL WHILE SUCHTHAT EXIT)) (REPEAT-TRAN (CDR L) (CONS (CAR L) LP))) ((CONS (NREVERSE LP) (MKPF L 'PROGN))))) @@ -3171,7 +3168,7 @@ LP (COND ((NULL X) (defmacro THETA (&rest LL) (let (U (L (copy-list LL))) - (if (EQ (KAR L) '\,) `(theta CONS . ,(CDR L)) + (if (EQ (IFCAR L) '\,) `(theta CONS . ,(CDR L)) (progn (if (EQCAR (CAR L) 'QUOTE) (RPLAC (CAR L) (CADAR L))) (-REDUCE (CAR L) 0 @@ -3182,7 +3179,7 @@ LP (COND ((NULL X) (defmacro THETA1 (&rest LL) (let (U (L (copy-list LL))) - (if (EQ (KAR L) '\,) + (if (EQ (IFCAR L) '\,) (LIST 'NREVERSE-N (CONS 'THETA1 (CONS 'CONS (CDR L))) 1) (-REDUCE (CAR L) 1 (if (SETQ U (GET (CAR L) 'THETA)) (CAR U) -- 1.7.5.4