aboutsummaryrefslogtreecommitdiff
path: root/src/interp/showimp.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-09-20 14:50:49 +0000
committerdos-reis <gdr@axiomatics.org>2007-09-20 14:50:49 +0000
commit0850ca5458cb09b2d04cec162558500e9a05cf4a (patch)
treeaa76b50f08c662dab9a49b6ee9f0dc7318139ea1 /src/interp/showimp.boot.pamphlet
parent6f8caa148526efc14239febdc12f91165389a8ea (diff)
downloadopen-axiom-0850ca5458cb09b2d04cec162558500e9a05cf4a.tar.gz
Revert commits to the wrong tree.
Diffstat (limited to 'src/interp/showimp.boot.pamphlet')
-rw-r--r--src/interp/showimp.boot.pamphlet278
1 files changed, 278 insertions, 0 deletions
diff --git a/src/interp/showimp.boot.pamphlet b/src/interp/showimp.boot.pamphlet
new file mode 100644
index 00000000..49b72338
--- /dev/null
+++ b/src/interp/showimp.boot.pamphlet
@@ -0,0 +1,278 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/showimp.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<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.
+
+@
+<<*>>=
+<<license>>
+
+)package "BOOT"
+
+$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}