diff --git a/changelog b/changelog index ca59e80..4d722d9 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090712 tpd src/axiom-website/patches.html 20090712.01.tpd.patch +20090712 tpd src/interp/Makefile remove showimp.boot +20090712 tpd src/interp/br-con.boot merge showimp +20090712 tpd src/interp/showimp.boot removed. merge with br-con 20090711 tpd src/axiom-website/patches.html 20090711.07.tpd.patch 20090711 tpd src/inter/Makefile remove br-data 20090711 tpd src/interp/br-con.boot merge br-data diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 6128eb5..5f4dec2 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1709,5 +1709,7 @@ merge ht-util and htsetvar
merge ht-util and ht-root
20090711.07.tpd.patch merge br-con and br-data
+20090712.01.tpd.patch +merge br-con and showimp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 7ffb6f2..7f8f96f 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -286,7 +286,6 @@ browser. These files should probably be autoloaded. BROBJS= ${AUTO}/bc-matrix.${O} \ ${AUTO}/ht-util.${O} \ ${AUTO}/br-con.${O} \ - ${AUTO}/showimp.${O} \ ${AUTO}/br-op1.${O} ${AUTO}/br-op2.${O} \ ${AUTO}/br-search.${O} ${AUTO}/br-util.${O} \ ${AUTO}/topics.${O} ${AUTO}/br-prof.${O} \ @@ -504,7 +503,7 @@ DOCFILES=${DOC}/alql.boot.dvi \ ${DOC}/setq.lisp.dvi \ ${DOC}/sfsfun.boot.dvi \ ${DOC}/sfsfun-l.lisp.dvi \ - ${DOC}/showimp.boot.dvi ${DOC}/simpbool.boot.dvi \ + ${DOC}/simpbool.boot.dvi \ ${DOC}/slam.boot.dvi ${DOC}/sockio.lisp.dvi \ ${DOC}/spaderror.lisp.dvi ${DOC}/spad.lisp.dvi \ ${DOC}/sys-pkg.lisp.dvi ${DOC}/template.boot.dvi \ @@ -7226,56 +7225,6 @@ ${DOC}/sfsfun.boot.dvi: ${IN}/sfsfun.boot.pamphlet @ -\subsection{showimp.boot} -system level hacking files -<>= -${AUTO}/showimp.${O}: ${OUT}/showimp.${O} - @ echo 579 making ${AUTO}/showimp.${O} from ${OUT}/showimp.${O} - @ cp ${OUT}/showimp.${O} ${AUTO} - -@ -<>= -${OUT}/showimp.${O}: ${MID}/showimp.clisp - @ echo 580 making ${OUT}/showimp.${O} from ${MID}/showimp.clisp - @ (cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/showimp.clisp"' \ - ':output-file "${OUT}/showimp.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/showimp.clisp"' \ - ':output-file "${OUT}/showimp.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${MID}/showimp.clisp: ${IN}/showimp.boot.pamphlet - @ echo 581 making ${MID}/showimp.lisp from ${IN}/showimp.boot.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/showimp.boot.pamphlet >showimp.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "showimp.boot") (${BYE}))' \ - | ${DEPSYS} ; \ - else \ - echo '(progn (boottran::boottocl "showimp.boot") (${BYE}))' \ - | ${DEPSYS} >${TMP}/trace ; \ - fi ; \ - rm showimp.boot ) - -@ -<>= -${DOC}/showimp.boot.dvi: ${IN}/showimp.boot.pamphlet - @echo 582 making ${DOC}/showimp.boot.dvi \ - from ${IN}/showimp.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/showimp.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} showimp.boot ; \ - rm -f ${DOC}/showimp.boot.pamphlet ; \ - rm -f ${DOC}/showimp.boot.tex ; \ - rm -f ${DOC}/showimp.boot ) - -@ - \subsection{hashcode.boot} files for the new compiler <>= @@ -8340,11 +8289,6 @@ clean: <> <> -<> -<> -<> -<> - <> <> <> diff --git a/src/interp/br-con.boot.pamphlet b/src/interp/br-con.boot.pamphlet index 31c54d4..10f80c5 100644 --- a/src/interp/br-con.boot.pamphlet +++ b/src/interp/br-con.boot.pamphlet @@ -2148,6 +2148,224 @@ purgeLocalLibdb() == --used for debugging purposes only obey '"rm libdb.text" +$returnNowhereFromGoGet := false + +showSummary dom == + showPredicates dom + showAttributes dom + showFrom dom + showImp dom + +--======================================================================= +-- Show Where Functions in Domain are Implemented +--======================================================================= +showImp(dom,:options) == + sayBrightly '"-------------Operation summary-----------------" + missingOnlyFlag := KAR options + domainForm := devaluate dom + [nam,:$domainArgs] := domainForm + $predicateList: local := GETDATABASE(nam,'PREDICATES) + predVector := dom.3 + u := getDomainOpTable(dom,true) + --sort into 4 groups: domain exports, unexports, default exports, others + for (x := [.,.,:key]) in u repeat + key = domainForm => domexports := [x,:domexports] + FIXP key => unexports := [x,:unexports] + isDefaultPackageForm? key => defexports := [x,:defexports] + key = 'nowhere => nowheres := [x,:nowheres] + key = 'constant => constants := [x,:constants] + others := [x,:others] --add chain domains go here + sayBrightly + nowheres => ['"Functions exported but not implemented by", + :bright form2String domainForm,'":"] + [:bright form2String domainForm,'"implements all exported operations"] + showDomainsOp1(nowheres,'nowhere) + missingOnlyFlag => 'done + + --first display those exported by the domain, then add chain guys + u := [:domexports,:constants,:SORTBY('CDDR,others)] + while u repeat + [.,.,:key] := CAR u + sayBrightly + key = 'constant => + ["Constants implemented by",:bright form2String key,'":"] + ["Functions implemented by",:bright form2String key,'":"] + u := showDomainsOp1(u,key) + u := SORTBY('CDDR,defexports) + while u repeat + [.,.,:key] := CAR u + defop := INTERN(SUBSTRING((s := PNAME CAR key),0,MAXINDEX s)) + domainForm := [defop,:CDDR key] + sayBrightly ["Default functions from",:bright form2String domainForm,'":"] + u := showDomainsOp1(u,key) + u := SORTBY('CDDR,unexports) + while u repeat + [.,.,:key] := CAR u + sayBrightly ["Not exported: "] + u := showDomainsOp1(u,key) + +--======================================================================= +-- Show Information Directly From Domains +--======================================================================= +showFrom(D,:option) == + ops := KAR option + alist := nil + domainForm := devaluate D + [nam,:.] := domainForm + $predicateList: local := GETDATABASE(nam,'PREDICATES) + for (opSig := [op,sig]) in getDomainSigs1(D,ops) repeat + u := from?(D,op,sig) + x := ASSOC(u,alist) => RPLACD(x,[opSig,:rest x]) + alist := [[u,opSig],:alist] + for [conform,:l] in alist repeat + sayBrightly concat('"From ",form2String conform,'":") + for [op,sig] in l repeat sayBrightly ['" ",:formatOpSignature(op,sig)] + +--======================================================================= +-- Functions implementing showFrom +--======================================================================= +getDomainOps D == + domname := D.0 + conname := CAR domname + $predicateList: local := GETDATABASE(conname,'PREDICATES) + REMDUP listSort(function GLESSEQP,ASSOCLEFT getDomainOpTable(D,nil)) + +getDomainSigs(D,:option) == + domname := D.0 + conname := CAR domname + $predicateList: local := GETDATABASE(conname,'PREDICATES) + getDomainSigs1(D,first option) + +getDomainSigs1(D,ops) == listSort(function GLESSEQP,u) where + u == [x for x in getDomainOpTable(D,nil) | null ops or MEMQ(CAR x,ops)] + +getDomainDocs(D,:option) == + domname := D.0 + conname := CAR domname + $predicateList: local := GETDATABASE(conname,'PREDICATES) + ops := KAR option + [[op,sig,:getInheritanceByDoc(D,op,sig)] for [op,sig] in getDomainSigs1(D,ops)] + +--======================================================================= +-- Getting Inheritance Info from Documentation in Lisplib +--======================================================================= +from?(D,op,sig) == KAR KDR getInheritanceByDoc(D,op,sig) + +getExtensionsOfDomain domain == + u := getDomainExtensionsOfDomain domain + cats := getCategoriesOfDomain domain + for x in u repeat + cats := UNION(cats,getCategoriesOfDomain EVAL x) + [:u,:cats] + +getDomainExtensionsOfDomain domain == + acc := nil + d := domain + while (u := devaluateSlotDomain(5,d)) repeat + acc := [u,:acc] + d := EVAL u + acc + +devaluateSlotDomain(u,dollar) == + u = '$ => devaluate dollar + FIXP u and VECP (y := dollar.u) => devaluate y + u is ['NRTEVAL,y] => MKQ eval y + u is ['QUOTE,y] => u + u is [op,:argl] => [op,:[devaluateSlotDomain(x,dollar) for x in argl]] + devaluate evalSlotDomain(u,dollar) + +getCategoriesOfDomain domain == + predkeyVec := domain.4.0 + catforms := CADR domain.4 + [fn for i in 0..MAXINDEX predkeyVec | test] where + test == predkeyVec.i and + (x := catforms . i) isnt ['DomainSubstitutionMacro,:.] + fn == + VECP x => devaluate x + devaluateSlotDomain(x,domain) + +getInheritanceByDoc(D,op,sig,:options) == +--gets inheritance and documentation information by looking in the LISPLIB +--for each ancestor of the domain + catList := KAR options or getExtensionsOfDomain D + getDocDomainForOpSig(op,sig,devaluate D,D) or + or/[fn for x in catList] or '(NIL NIL) + where fn == getDocDomainForOpSig(op,sig,substDomainArgs(D,x),D) + +getDocDomainForOpSig(op,sig,dollar,D) == + (u := LASSOC(op,GETDATABASE(CAR dollar,'DOCUMENTATION))) + and (doc := or/[[d,dollar] for [s,:d] in u | compareSig(sig,s,D,dollar)]) + +--======================================================================= +-- Functions implementing showImp +--======================================================================= +showDomainsOp1(u,key) == + while u and CAR u is [op,sig,: =key] repeat + sayBrightly ['" ",:formatOpSignature(op,sig)] + u := rest u + u + +getDomainRefName(dom,nam) == + PAIRP nam => [getDomainRefName(dom,x) for x in nam] + not FIXP nam => nam + slot := dom.nam + VECP slot => slot.0 + slot is ['SETELT,:.] => getDomainRefName(dom,getDomainSeteltForm slot) + slot + +getDomainSeteltForm ['SETELT,.,.,form] == + form is ['evalSlotDomain,u,d] => devaluateSlotDomain(u,d) + VECP form => systemError() + form + +showPredicates dom == + sayBrightly '"--------------------Predicate summary-------------------" + conname := CAR dom.0 + predvector := dom.3 + predicateList := GETDATABASE(conname,'PREDICATES) + for i in 1.. for p in predicateList repeat + prefix := + testBitVector(predvector,i) => '"true : " + '"false: " + sayBrightly [prefix,:pred2English p] + +showAttributes dom == + sayBrightly '"--------------------Attribute summary-------------------" + conname := CAR dom.0 + abb := getConstructorAbbreviation conname + predvector := dom.3 + for [a,:p] in dom.2 repeat + prefix := + testBitVector(predvector,p) => '"true : " + '"false: " + sayBrightly concat(prefix,form2String a) + +showGoGet dom == + numvec := CDDR dom.4 + for i in 6..MAXINDEX dom | (slot := dom.i) is ['newGoGet,dol,index,:op] repeat + numOfArgs := numvec.index + whereNumber := numvec.(index := index + 1) + signumList := + [formatLazyDomainForm(dom,numvec.(index + i)) for i in 0..numOfArgs] + index := index + numOfArgs + 1 + namePart := + concat(bright "from",form2String formatLazyDomainForm(dom,whereNumber)) + sayBrightly [i,'": ",:formatOpSignature(op,signumList),:namePart] + +formatLazyDomain(dom,x) == + VECP x => devaluate x + x is [dollar,slotNumber,:form] => formatLazyDomainForm(dom,form) + systemError nil + +formatLazyDomainForm(dom,x) == + x = 0 => ["$"] + FIXP x => formatLazyDomain(dom,dom.x) + atom x => x + x is ['NRTEVAL,y] => (atom y => [y]; y) + [first x,:[formatLazyDomainForm(dom,y) for y in rest x]] + + + @ \eject \begin{thebibliography}{99} diff --git a/src/interp/showimp.boot.pamphlet b/src/interp/showimp.boot.pamphlet deleted file mode 100644 index 8edffd4..0000000 --- a/src/interp/showimp.boot.pamphlet +++ /dev/null @@ -1,272 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp showimp.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -$returnNowhereFromGoGet := false - -showSummary dom == - showPredicates dom - showAttributes dom - showFrom dom - showImp dom - ---======================================================================= --- Show Where Functions in Domain are Implemented ---======================================================================= -showImp(dom,:options) == - sayBrightly '"-------------Operation summary-----------------" - missingOnlyFlag := KAR options - domainForm := devaluate dom - [nam,:$domainArgs] := domainForm - $predicateList: local := GETDATABASE(nam,'PREDICATES) - predVector := dom.3 - u := getDomainOpTable(dom,true) - --sort into 4 groups: domain exports, unexports, default exports, others - for (x := [.,.,:key]) in u repeat - key = domainForm => domexports := [x,:domexports] - FIXP key => unexports := [x,:unexports] - isDefaultPackageForm? key => defexports := [x,:defexports] - key = 'nowhere => nowheres := [x,:nowheres] - key = 'constant => constants := [x,:constants] - others := [x,:others] --add chain domains go here - sayBrightly - nowheres => ['"Functions exported but not implemented by", - :bright form2String domainForm,'":"] - [:bright form2String domainForm,'"implements all exported operations"] - showDomainsOp1(nowheres,'nowhere) - missingOnlyFlag => 'done - - --first display those exported by the domain, then add chain guys - u := [:domexports,:constants,:SORTBY('CDDR,others)] - while u repeat - [.,.,:key] := CAR u - sayBrightly - key = 'constant => - ["Constants implemented by",:bright form2String key,'":"] - ["Functions implemented by",:bright form2String key,'":"] - u := showDomainsOp1(u,key) - u := SORTBY('CDDR,defexports) - while u repeat - [.,.,:key] := CAR u - defop := INTERN(SUBSTRING((s := PNAME CAR key),0,MAXINDEX s)) - domainForm := [defop,:CDDR key] - sayBrightly ["Default functions from",:bright form2String domainForm,'":"] - u := showDomainsOp1(u,key) - u := SORTBY('CDDR,unexports) - while u repeat - [.,.,:key] := CAR u - sayBrightly ["Not exported: "] - u := showDomainsOp1(u,key) - ---======================================================================= --- Show Information Directly From Domains ---======================================================================= -showFrom(D,:option) == - ops := KAR option - alist := nil - domainForm := devaluate D - [nam,:.] := domainForm - $predicateList: local := GETDATABASE(nam,'PREDICATES) - for (opSig := [op,sig]) in getDomainSigs1(D,ops) repeat - u := from?(D,op,sig) - x := ASSOC(u,alist) => RPLACD(x,[opSig,:rest x]) - alist := [[u,opSig],:alist] - for [conform,:l] in alist repeat - sayBrightly concat('"From ",form2String conform,'":") - for [op,sig] in l repeat sayBrightly ['" ",:formatOpSignature(op,sig)] - ---======================================================================= --- Functions implementing showFrom ---======================================================================= -getDomainOps D == - domname := D.0 - conname := CAR domname - $predicateList: local := GETDATABASE(conname,'PREDICATES) - REMDUP listSort(function GLESSEQP,ASSOCLEFT getDomainOpTable(D,nil)) - -getDomainSigs(D,:option) == - domname := D.0 - conname := CAR domname - $predicateList: local := GETDATABASE(conname,'PREDICATES) - getDomainSigs1(D,first option) - -getDomainSigs1(D,ops) == listSort(function GLESSEQP,u) where - u == [x for x in getDomainOpTable(D,nil) | null ops or MEMQ(CAR x,ops)] - -getDomainDocs(D,:option) == - domname := D.0 - conname := CAR domname - $predicateList: local := GETDATABASE(conname,'PREDICATES) - ops := KAR option - [[op,sig,:getInheritanceByDoc(D,op,sig)] for [op,sig] in getDomainSigs1(D,ops)] - ---======================================================================= --- Getting Inheritance Info from Documentation in Lisplib ---======================================================================= -from?(D,op,sig) == KAR KDR getInheritanceByDoc(D,op,sig) - -getExtensionsOfDomain domain == - u := getDomainExtensionsOfDomain domain - cats := getCategoriesOfDomain domain - for x in u repeat - cats := UNION(cats,getCategoriesOfDomain EVAL x) - [:u,:cats] - -getDomainExtensionsOfDomain domain == - acc := nil - d := domain - while (u := devaluateSlotDomain(5,d)) repeat - acc := [u,:acc] - d := EVAL u - acc - -devaluateSlotDomain(u,dollar) == - u = '$ => devaluate dollar - FIXP u and VECP (y := dollar.u) => devaluate y - u is ['NRTEVAL,y] => MKQ eval y - u is ['QUOTE,y] => u - u is [op,:argl] => [op,:[devaluateSlotDomain(x,dollar) for x in argl]] - devaluate evalSlotDomain(u,dollar) - -getCategoriesOfDomain domain == - predkeyVec := domain.4.0 - catforms := CADR domain.4 - [fn for i in 0..MAXINDEX predkeyVec | test] where - test == predkeyVec.i and - (x := catforms . i) isnt ['DomainSubstitutionMacro,:.] - fn == - VECP x => devaluate x - devaluateSlotDomain(x,domain) - -getInheritanceByDoc(D,op,sig,:options) == ---gets inheritance and documentation information by looking in the LISPLIB ---for each ancestor of the domain - catList := KAR options or getExtensionsOfDomain D - getDocDomainForOpSig(op,sig,devaluate D,D) or - or/[fn for x in catList] or '(NIL NIL) - where fn == getDocDomainForOpSig(op,sig,substDomainArgs(D,x),D) - -getDocDomainForOpSig(op,sig,dollar,D) == - (u := LASSOC(op,GETDATABASE(CAR dollar,'DOCUMENTATION))) - and (doc := or/[[d,dollar] for [s,:d] in u | compareSig(sig,s,D,dollar)]) - ---======================================================================= --- Functions implementing showImp ---======================================================================= -showDomainsOp1(u,key) == - while u and CAR u is [op,sig,: =key] repeat - sayBrightly ['" ",:formatOpSignature(op,sig)] - u := rest u - u - -getDomainRefName(dom,nam) == - PAIRP nam => [getDomainRefName(dom,x) for x in nam] - not FIXP nam => nam - slot := dom.nam - VECP slot => slot.0 - slot is ['SETELT,:.] => getDomainRefName(dom,getDomainSeteltForm slot) - slot - -getDomainSeteltForm ['SETELT,.,.,form] == - form is ['evalSlotDomain,u,d] => devaluateSlotDomain(u,d) - VECP form => systemError() - form - -showPredicates dom == - sayBrightly '"--------------------Predicate summary-------------------" - conname := CAR dom.0 - predvector := dom.3 - predicateList := GETDATABASE(conname,'PREDICATES) - for i in 1.. for p in predicateList repeat - prefix := - testBitVector(predvector,i) => '"true : " - '"false: " - sayBrightly [prefix,:pred2English p] - -showAttributes dom == - sayBrightly '"--------------------Attribute summary-------------------" - conname := CAR dom.0 - abb := getConstructorAbbreviation conname - predvector := dom.3 - for [a,:p] in dom.2 repeat - prefix := - testBitVector(predvector,p) => '"true : " - '"false: " - sayBrightly concat(prefix,form2String a) - -showGoGet dom == - numvec := CDDR dom.4 - for i in 6..MAXINDEX dom | (slot := dom.i) is ['newGoGet,dol,index,:op] repeat - numOfArgs := numvec.index - whereNumber := numvec.(index := index + 1) - signumList := - [formatLazyDomainForm(dom,numvec.(index + i)) for i in 0..numOfArgs] - index := index + numOfArgs + 1 - namePart := - concat(bright "from",form2String formatLazyDomainForm(dom,whereNumber)) - sayBrightly [i,'": ",:formatOpSignature(op,signumList),:namePart] - -formatLazyDomain(dom,x) == - VECP x => devaluate x - x is [dollar,slotNumber,:form] => formatLazyDomainForm(dom,form) - systemError nil - -formatLazyDomainForm(dom,x) == - x = 0 => ["$"] - FIXP x => formatLazyDomain(dom,dom.x) - atom x => x - x is ['NRTEVAL,y] => (atom y => [y]; y) - [first x,:[formatLazyDomainForm(dom,y) for y in rest x]] - - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document}