Revert commits to the wrong tree.

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}