diff options
author | dos-reis <gdr@axiomatics.org> | 2007-11-14 01:19:25 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2007-11-14 01:19:25 +0000 |
commit | 62b279b28cf02d59e0f860aac46968223c43cfc3 (patch) | |
tree | 52b6bd0af8e2cbd1bcc5bc60fdaf1ee1c293d4b4 /src/interp/br-con.boot.pamphlet | |
parent | fabbf02ee4b80241b75826536502c2d683e8462e (diff) | |
download | open-axiom-62b279b28cf02d59e0f860aac46968223c43cfc3.tar.gz |
remove more pamphlets
Diffstat (limited to 'src/interp/br-con.boot.pamphlet')
-rw-r--r-- | src/interp/br-con.boot.pamphlet | 1411 |
1 files changed, 0 insertions, 1411 deletions
diff --git a/src/interp/br-con.boot.pamphlet b/src/interp/br-con.boot.pamphlet deleted file mode 100644 index 6b77350c..00000000 --- a/src/interp/br-con.boot.pamphlet +++ /dev/null @@ -1,1411 +0,0 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/br-con.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>> - -import '"bc-util" -)package "BOOT" - - ---====================> WAS b-con.boot <================================ - ---======================================================================= --- Pages Initiated from HyperDoc Pages ---======================================================================= ---NOTE: This duplicate version was discovered 3/20/94 in br-search.boot ---called from buttons via bcCon, bcAbb, bcConform, dbShowCons1, dbSelectCon ---conPage(a,:b) == --- --The next 4 lines allow e.g. MATRIX INT ==> Matrix Integer (see kPage) --- $conArgstrings: local := --- atom a => b --- a := conform2OutputForm a --- [mathform2HtString x for x in rest a] --- if not atom a then a := first a --- da := DOWNCASE a --- pageName := LASSQ(da,'((type . CategoryType)(union . DomainUnion)(record . DomainRecord)(mapping . DomainMapping))) => --- downlink pageName --special jump out for primitive domains --- line := conPageFastPath a => kPage line --lower case name of cons? --- line := conPageFastPath UPCASE a => kPage line --upper case an abbr? --- ySearch a --slow search (include default packages) --- - ---called from buttons via bcCon, bcAbb, bcConform, dbShowCons1, dbSelectCon -conPage(a,:b) == - --The next 4 lines allow e.g. MATRIX INT ==> Matrix Integer (see kPage) - form := - atom a => [a,:b] - a - $conArgstrings: local := [form2HtString x for x in KDR a] - if not atom a then a := first a - da := DOWNCASE a - pageName := LASSQ(da,'((type . CategoryType)(union . DomainUnion)(record . DomainRecord)(mapping . DomainMapping)(enumeration . DomainEnumeration))) => - downlink pageName --special jump out for primitive domains - line := conPageFastPath da => kPage(line,form) --lower case name of cons? - line := conPageFastPath UPCASE a => kPage(line,form) --upper case an abbr? - ySearch a --slow search (include default packages) - -conPageFastPath x == --called by conPage and constructorSearch ---gets line quickly for constructor name or abbreviation - s := STRINGIMAGE x - charPosition(char '_*,s,0) < #s => nil --quit if name has * in it - name := (STRINGP x => INTERN x; x) - entry := HGET($lowerCaseConTb,name) or return nil - lineNumber := LASSQ('dbLineNumber,CDDR entry) => - --'dbLineNumbers property is set by function dbAugmentConstructorDataTable - dbRead lineNumber --read record for constructor from libdb.text - conPageConEntry first entry - -conPageConEntry entry == - $conname: local := nil - $conform: local := nil - $exposed?:local := nil - $doc: local := nil - $kind: local := nil - buildLibdbConEntry entry - ---======================================================================= --- Constructor Page ---======================================================================= --- in br-saturn.boot now ---% kPage(line,:options) == --any cat, dom, package, default package ---% --constructors Cname\#\E\sig \args \abb \comments (C is C, D, P, X) ---% ------------------> BRANCH OUT FOR SATURN ---% true => kPageSaturn(line,options) ---% parts := dbXParts(line,7,1) ---% [kind,name,nargs,xflag,sig,args,abbrev,comments] := parts ---% form := IFCAR options ---% isFile := null kind ---% kind := kind or '"package" ---% RPLACA(parts,kind) ---% conform := mkConform(kind,name,args) ---% conname := opOf conform ---% capitalKind := capitalize kind ---% signature := ncParseFromString sig ---% sourceFileName := dbSourceFile INTERN name ---% constrings := ---% KDR form => dbConformGenUnder form ---% [STRCONC(name,args)] ---% emString := ['"{\sf ",:constrings,'"}"] ---% heading := [capitalKind,'" ",:emString] ---% if not isExposedConstructor conname then heading := ['"Unexposed ",:heading] ---% if name=abbrev then abbrev := asyAbbreviation(conname,nargs) ---% page := htInitPage(heading,nil) ---% htpSetProperty(page,'isFile,true) ---% htpSetProperty(page,'parts,parts) ---% htpSetProperty(page,'heading,heading) ---% htpSetProperty(page,'kind,kind) ---% if asharpConstructorName? conname then ---% htpSetProperty(page,'isAsharpConstructor,true) ---% htpSetProperty(page,'conform,conform) ---% htpSetProperty(page,'signature,signature) ---% kdPageInfo(name,abbrev,nargs,conform,signature,isFile) ---% htSayStandard '"\newline" ---% htBeginMenu(3) ---% htSayStandard '"\item " ---% htMakePage [['bcLinks,['"\menuitemstyle{Description}", ---% [['text,'"\tab{19}",'"General description"]],'kiPage,nil]]] ---% satBreak() ---% htMakePage [['bcLinks,['"\menuitemstyle{Operations}", ---% [['text,'"\tab{19}All exported operations"]],'koPage,'"operation"]]] ---% if not asharpConstructorName? conname then ---% satBreak() ---% htMakePage [['bcLinks,['"\menuitemstyle{Attributes}", ---% [['text,'"\tab{19}All exported attributes"]],'koPage,'"attribute"]]] ---% if kind ^= 'category and (pathname := dbHasExamplePage conname) then ---% satBreak() ---% htMakePage [['bcLinks,['"\menuitemstyle{Examples}", ---% [['text,'"\tab{19}Examples illustrating use"]],'kxPage,pathname]]] ---% satBreak() ---% htMakePage [['bcLinks,['"\menuitemstyle{Exports}", ---% [['text,'"\tab{19}Explicit categories and operations"]],'kePage,nil]]] ---% satBreak() ---% htMakePage [['bcLinks,['"\menuitemstyle{Cross Reference}", ---% [['text,'"\tab{19}Hierarchy and usage information"]],'kcPage,nil]]] ---% htEndMenu(3) ---% if kind ^= 'category and nargs > 0 then addParameterTemplates conform ---% htShowPage() ---% -conform2String u == - x := form2String u - atom x => STRINGIMAGE x - "STRCONC"/[STRINGIMAGE y for y in x] - -kxPage(htPage,name) == downlink name - -kdPageInfo(name,abbrev,nargs,conform,signature,file?) == - htSay("{\sf ",name,'"}") - if abbrev ^= name then bcHt [" has abbreviation ",abbrev] - if file? then bcHt ['" is a source file."] - if nargs = 0 then (if abbrev ^= name then bcHt '".") - else - if abbrev ^= name then bcHt '" and" - bcHt - nargs = 1 => '" takes one argument:" - [" takes ",STRINGIMAGE nargs," arguments:"] - htSaturnBreak() - htSayStandard '"\indentrel{2}" - if nargs > 0 then kPageArgs(conform,signature) - htSayStandard '"\indentrel{-2}" - if name.(#name-1) = char "&" then name := SUBSEQ(name, 0, #name-1) ---sourceFileName := dbSourceFile INTERN name - sourceFileName := GETDATABASE(INTERN name,'SOURCEFILE) - filename := extractFileNameFromPath sourceFileName - if filename ^= '"" then - htSayStandard '"\newline{}" - htSay('"The source code for the constructor is found in ") - htMakePage [['text,'"\unixcommand{",filename,'"}{_\$AXIOM/lib/SPADEDIT ", - sourceFileName, '" ", name, '"}"]] - if nargs ^= 0 then htSay '"." - htSaturnBreak() - -kPageArgs([op,:args],[.,.,:source]) == -------------------> OBSELETE - firstTime := true - coSig := rest GETDATABASE(op,'COSIG) - for x in args for t in source for pred in coSig repeat - if not firstTime then htSay '", and" - htSay('"\newline ") - typeForm := (t is [":",.,t1] => t1; t) - if pred = true - then htMakePage [['bcLinks,[x,'"",'kArgPage,x]]] - else htSay('"{\em ",x,'"}") - htSay( '"\tab{",STRINGIMAGE( # PNAME x),'"}, ") - htSay - pred => '"a domain of category " - '"an element of the domain " - bcConform(typeForm,true) - -kArgPage(htPage,arg) == - [op,:args] := conform := htpProperty(htPage,'conform) - domname := htpProperty(htPage,'domname) - heading := htpProperty(htPage,'heading) - source := CDDAR getConstructorModemap op - n := position(arg,args) - typeForm := sublisFormal(args,source . n) - domTypeForm := mkDomTypeForm(typeForm,conform,domname) - descendants := domainDescendantsOf(typeForm,domTypeForm) - htpSetProperty(htPage,'cAlist,descendants) - rank := - n > 4 => nil - ('(First Second Third Fourth Fifth)).n - htpSetProperty(htPage,'rank,rank) - htpSetProperty(htPage,'thing,'"argument") ---htpSetProperty(htPage,'specialMessage,['reportCategory,conform,typeForm,arg]) - dbShowCons(htPage,'names) - -reportCategory(conform,typeForm,arg) == - htSay('"Argument {\em ",arg,'"}") - [conlist,attrlist,:oplist] := categoryParts(conform,typeForm,true) - htSay '" must " - if conlist then - htSay '"belong to " - if conlist is [u] then - htSay('"category ") - bcConform first u - bcPred rest u - else - htSay('"categories:") - bcConPredTable(conlist,opOf conform) - htSay '"\newline " - if attrlist then - if conlist then htSay '" and " - reportAO('"attribute",attrlist) - htSay '"\newline " - if oplist then - if conlist or attrlist then htSay '" and " - reportAO('"operation",oplist) - -reportAO(kind,oplist) == - htSay('"have ",kind,'":") - for [op,sig,:pred] in oplist repeat - htSay '"\newline " - if #oplist = 1 then htSay '"\centerline{" - if kind = '"attribute" then - attr := form2String [op,:sig] - satDownLink(attr,['"(|attrPage| '|",attr,'"|)"]) - else - ops := escapeSpecialChars STRINGIMAGE op - sigs := form2HtString ['Mapping,:sig] - satDownLink(ops,['"(|opPage| '|",ops,'"| |",sigs,'"|)"]) - htSay '": " - bcConform ['Mapping,:sig] - if #oplist = 1 then htSay '"}" - htSay '"\newline " - -mkDomTypeForm(typeForm,conform,domname) == --called by kargPage - domname => SUBLISLIS(rest domname,rest conform,typeForm) - typeForm is ['Join,:r] => ['Join,:[mkDomTypeForm(t,conform,domname) for t in r]] - null hasIdent typeForm => typeForm - nil - -domainDescendantsOf(conform,domform) == main where --called by kargPage - main() == - conform is [op,:r] => - op = 'Join => jfn(delete('(Type Object),r),delete('(Type Object),IFCDR domform)) - op = 'CATEGORY => nil - domainsOf(conform,domform) - domainsOf(conform,domform) - jfn([y,:r],domlist) == --keep only those domains that appear in ALL parts of Join - alist := domainsOf(y,IFCAR domlist) - for x in r repeat - domlist := IFCDR domlist - x is ['CATEGORY,.,:r] => alist := catScreen(r,alist) - keepList := nil - for [item,:pred] in domainsOf(x,IFCAR domlist) repeat - u := ASSOC(item,alist) => - keepList := [[item,:quickAnd(CDR u,pred)],:keepList] - alist := keepList - for pair in alist repeat RPLACD(pair,simpHasPred CDR pair) - listSort(function GLESSEQP, alist) - catScreen(r,alist) == - for x in r repeat - x isnt [op1,:.] and MEMQ(op1,'(ATTRIBUTE SIGNATURE)) => systemError x - alist := [[item,:npred] for [item,:pred] in alist | - (pred1 := simpHasPred ['has,item,x]) and (npred := quickAnd(pred1,pred))] - alist - ---======================================================================= --- Branches of Constructor Page ---======================================================================= - -kiPage(htPage,junk) == - [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - conform := mkConform(kind,name,args) - domname := kDomainName(htPage,kind,name,nargs) - domname is ['error,:.] => errorPage(htPage,domname) - heading := ['"Description of ", capitalize kind,'" {\sf ",name,args,'"}"] - page := htInitPage(heading,htCopyProplist htPage) - $conformsAreDomains := domname - dbShowConsDoc1(htPage,conform,nil) - htShowPage() - -kePage(htPage,junk) == - [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - constring := STRCONC(name,args) - domname := kDomainName(htPage,kind,name,nargs) - domname is ['error,:.] => errorPage(htPage,domname) - htpSetProperty(htPage,'domname,domname) - $conformsAreDomains: local := domname - conform := mkConform(kind,name,args) - conname := opOf conform - heading := [capitalize kind,'" {\sf ", - (domname => form2HtString(domname,nil,true); constring),'"}"] - data := sublisFormal(IFCDR domname or rest conform, - getConstructorExports((domname or conform),true)) - [conlist,attrlist,:oplist] := data - if domname then - for x in conlist repeat RPLAC(CDR x,simpHasPred CDR x) - for x in attrlist repeat RPLAC(CDDR x,simpHasPred CDDR x) - for x in oplist repeat RPLAC(CDDR x,simpHasPred CDDR x) - prefix := pluralSay(#conlist + #attrlist + #oplist,'"Export",'"Exports") - page := htInitPage([:prefix,'" of ",:heading],htCopyProplist htPage) - htSayStandard '"\beginmenu " - htpSetProperty(page,'data,data) - if conlist then - htMakePage [['bcLinks,[menuButton(),'"",'dbShowCons1,conlist,'names]]] - htSayStandard '"\tab{2}" - htSay '"All attributes and operations from:" - bcConPredTable(conlist,opOf conform,rest conform) - if attrlist then - if conlist then htBigSkip() - kePageDisplay(page,'"attribute",kePageOpAlist attrlist) - if oplist then - if conlist or attrlist then htBigSkip() - kePageDisplay(page,'"operation",kePageOpAlist oplist) - htSayStandard '" \endmenu " - htShowPage() - -kePageOpAlist oplist == - opAlist := nil - for [op,sig,:pred] in oplist repeat - u := LASSOC(op,opAlist) ---was --- opAlist := insertAlist(op,[[sig,pred],:u],opAlist) - opAlist := insertAlist(zeroOneConvert op,[[sig,pred],:u],opAlist) - opAlist - -kePageDisplay(htPage,which,opAlist) == - count := #opAlist - total := +/[#(rest entry) for entry in opAlist] - count = 0 => nil - if which = '"operation" - then htpSetProperty(htPage,'opAlist,opAlist) - else htpSetProperty(htPage,'attrAlist,opAlist) - expandProperty := - which = '"operation" => 'expandOperations - 'expandAttributes - htpSetProperty(htPage,expandProperty,'lists) --mark as unexpanded - htMakePage [['bcLinks,[menuButton(),'"",'dbShowOps,which,'names]]] - htSayStandard '"\tab{2}" - if count ^= total then - if count = 1 - then htSay('"1 name for ") - else htSay(STRINGIMAGE count,'" names for ") - if total > 1 - then htSay(STRINGIMAGE total,'" ",pluralize which,'" are explicitly exported:") - else htSay('"1 ",which,'" is explicitly exported:") - htSaySaturn '"\\" - data := dbGatherData(htPage,opAlist,which,'names) - dbShowOpItems(which,data,false) - -ksPage(htPage,junk) == - [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - domname := kDomainName(htPage,kind,name,nargs) - domname is ['error,:.] => errorPage(htPage,domname) - heading := - null domname => htpProperty(htPage,'heading) - ['"{\sf ",form2HtString(domname,nil,true),'"}"] - if domname then - htpSetProperty(htPage,'domname,domname) - htpSetProperty(htPage,'heading,heading) - domain := (kind = '"category" => nil; EVAL domname) - conform:= htpProperty(htPage,'conform) - page := htInitPageNoScroll(htCopyProplist htPage, - ['"Search order for ",:heading]) - htSay '"When an operation is not defined by the domain, the following domains are searched in order for a _"default definition" - htSayStandard '"\beginscroll " - u := dbSearchOrder(conform,domname,domain) - htpSetProperty(htPage,'cAlist,u) - htpSetProperty(htPage,'thing,'"constructor") - dbShowCons(htPage,'names) - -dbSearchOrder(conform,domname,$domain) == --domain = nil or set to live domain - conform := domname or conform - name:= opOf conform - $infovec: local := dbInfovec name or return nil --exit for categories - u := $infovec.3 - $predvec:= - $domain => $domain . 3 - GETDATABASE(name,'PREDICATES) - catpredvec := CAR u - catinfo := CADR u - catvec := CADDR u - catforms := [[pakform,:pred] for i in 0..MAXINDEX catvec | test ] where - test() == - pred := simpCatPredicate - p:=SUBLISLIS(rest conform,$FormalMapVariableList,kTestPred catpredvec.i) - $domain => EVAL p - p - if domname and CONTAINED('$,pred) then pred := SUBST(domname,'$,pred) --- which = '"attribute" => pred --all categories - (pak := catinfo . i) and pred --only those with default packages - pakform() == - pak and not IDENTP pak => devaluate pak --in case it has been instantiated - catform := kFormatSlotDomain catvec . i --- which = '"attribute" => dbSubConform(rest conform,catform) - res := dbSubConform(rest conform,[pak,"$",:rest catform]) - if domname then res := SUBST(domname,'$,res) - res - [:dbAddChain conform,:catforms] - -kcPage(htPage,junk) == - [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - domname := kDomainName(htPage,kind,name,nargs) - domname is ['error,:.] => errorPage(htPage,domname) --- domain := (kind = '"category" => nil; EVAL domname) - conform := htpProperty(htPage,'conform) - conname := opOf conform - heading := - null domname => htpProperty(htPage,'heading) - ['"{\sf ",form2HtString(domname,nil,true),'"}"] - page := htInitPage(['"Cross Reference for ",:heading],htCopyProplist htPage) - if domname then - htpSetProperty(htPage,'domname,domname) - htpSetProperty(htPage,'heading,heading) - if kind = '"category" and dbpHasDefaultCategory? xpart then - htSay '"This category has default package " - bcCon(STRCONC(name,char '_&),'"") - htSayStandard '"\newline" - htBeginMenu(3) - htSayStandard '"\item " - message := - kind = '"category" => ['"Categories it directly extends"] - ['"Categories the ",(kind = '"default package" => '"package"; kind),'" belongs to by assertion"] - htMakePage [['bcLinks,['"\menuitemstyle{Parents}", - [['text,'"\tab{12}",:message]],'kcpPage,nil]]] - satBreak() - message := - kind = '"category" => ['"All categories it is an extension of"] - ['"All categories the ",kind,'" belongs to"] - htMakePage [['bcLinks,['"\menuitemstyle{Ancestors}", - [['text,'"\tab{12}",:message]],'kcaPage,nil]]] - if kind = '"category" then - satBreak() - htMakePage [['bcLinks,['"\menuitemstyle{Children}",[['text,'"\tab{12}", - '"Categories which directly extend this category"]],'kccPage,nil]]] - - satBreak() - htMakePage [['bcLinks,['"\menuitemstyle{Descendants}",[['text,'"\tab{12}", - '"All categories which extend this category"]],'kcdPage,nil]]] - if not asharpConstructorName? conname then - satBreak() - message := '"Constructors mentioning this as an argument type" - htMakePage [['bcLinks,['"\menuitemstyle{Dependents}", - [['text,'"\tab{12}",message]],'kcdePage,nil]]] - if not asharpConstructorName? conname and kind ^= '"category" then - satBreak() - htMakePage [['bcLinks,['"\menuitemstyle{Lineage}", - '"\tab{12}Constructor hierarchy used for operation lookup",'ksPage,nil]]] - if not asharpConstructorName? conname then - if kind = '"category" then - satBreak() - htMakePage [['bcLinks,['"\menuitemstyle{Domains}",[['text,'"\tab{12}", - '"All domains which are of this category"]],'kcdoPage,nil]]] - if kind ^= '"category" then - satBreak() - htMakePage [['bcLinks,['"\menuitemstyle{Clients}",'"\tab{12}Constructors",'kcuPage,nil]]] - if HGET($defaultPackageNamesHT,conname) - then htSay('" which {\em may use} this default package") --- htMakePage [['bcLinks,['"files",'"",'kcuPage,true]]] - else htSay('" which {\em use} this ",kind) - if kind ^= '"category" or dbpHasDefaultCategory? xpart then - satBreak() - message := - kind = '"category" => ['"Constructors {\em used by} its default package"] - ['"Constructors {\em used by} the ",kind] - htMakePage [['bcLinks,['"\menuitemstyle{Benefactors}", - [['text,'"\tab{12}",:message]],'kcnPage,nil]]] - --to remove "Capsule Information", comment out the next 5 lines - if not asharpConstructorName? conname and hasNewInfoAlist conname then - satBreak() - message := ['"Cross reference for capsule implementation"] - htMakePage [['bcLinks,['"\menuitemstyle{CapsuleInfo}", - [['text,'"\tab{12}",:message]],'kciPage,nil]]] - htEndMenu(3) - htShowPage() - -kcpPage(htPage,junk) == - [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - domname := kDomainName(htPage,kind,name,nargs) - domname is ['error,:.] => errorPage(htPage,domname) - heading := - null domname => htpProperty(htPage,'heading) - ['"{\sf ",form2HtString(domname,nil,true),'"}"] - if domname then - htpSetProperty(htPage,'domname,domname) - htpSetProperty(htPage,'heading,heading) - conform := htpProperty(htPage,'conform) - conname := opOf conform - page := htInitPage(['"Parents of ",:heading],htCopyProplist htPage) - parents := parentsOf conname --was listSort(function GLESSEQP, =this) - if domname then parents := SUBLISLIS(rest domname,rest conform,parents) - htpSetProperty(htPage,'cAlist,parents) - htpSetProperty(htPage,'thing,'"parent") - choice := - domname => 'parameters - 'names - dbShowCons(htPage,choice) - -reduceAlistForDomain(alist,domform,conform) == --called from kccPage - alist := SUBLISLIS(rest domform,rest conform,alist) - for pair in alist repeat RPLACD(pair,simpHasPred(CDR pair,domform)) - [pair for (pair := [.,:pred]) in alist | pred] - -kcaPage(htPage,junk) == - kcaPage1(htPage,'"category",'" an ",'"ancestor",function ancestorsOf, false) - -kcdPage(htPage,junk) == - kcaPage1(htPage,'"category",'" a ",'"descendant",function descendantsOf,true) - -kcdoPage(htPage,junk)== - kcaPage1(htPage,'"domain",'" a ",'"descendant",function domainsOf, false) - -kcaPage1(htPage,kind,article,whichever,fn, isCatDescendants?) == - [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - domname := kDomainName(htPage,kind,name,nargs) - domname is ['error,:.] => errorPage(htPage,domname) - heading := - null domname => htpProperty(htPage,'heading) - ['"{\sf ",form2HtString(domname,nil,true),'"}"] - if domname and not isCatDescendants? then - htpSetProperty(htPage,'domname,domname) - htpSetProperty(htPage,'heading,heading) - conform := htpProperty(htPage,'conform) - conname := opOf conform - ancestors := FUNCALL(fn, conform, domname) - if whichever ^= '"ancestor" then - ancestors := augmentHasArgs(ancestors,conform) - ancestors := listSort(function GLESSEQP,ancestors) ---if domname then ancestors := SUBST(domname,'$,ancestors) - htpSetProperty(htPage,'cAlist,ancestors) - htpSetProperty(htPage,'thing,whichever) - choice := --- domname => 'parameters - 'names - dbShowCons(htPage,choice) - -kccPage(htPage,junk) == - [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - domname := kDomainName(htPage,kind,name,nargs) - domname is ['error,:.] => errorPage(htPage,domname) - heading := - null domname => htpProperty(htPage,'heading) - ['"{\sf ",form2HtString(domname,nil,true),'"}"] - if domname then - htpSetProperty(htPage,'domname,domname) - htpSetProperty(htPage,'heading,heading) - conform := htpProperty(htPage,'conform) - conname := opOf conform - page := htInitPage(['"Children of ",:heading],htCopyProplist htPage) - children:= augmentHasArgs(childrenOf conform,conform) - if domname then children := reduceAlistForDomain(children,domname,conform) - htpSetProperty(htPage,'cAlist,children) - htpSetProperty(htPage,'thing,'"child") - dbShowCons(htPage,'names) - -augmentHasArgs(alist,conform) == - conname := opOf conform - args := KDR conform or return alist - n := #args - [[name,:pred] for [name,:p] in alist] where pred() == - extractHasArgs p is [a,:b] => p - quickAnd(p,['hasArgs,:TAKE(n,KDR getConstructorForm opOf name)]) - -kcdePage(htPage,junk) == - [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - conname := INTERN name - constring := STRCONC(name,args) - conform := - kind ^= '"default package" => ncParseFromString constring - [INTERN name,:rest ncParseFromString STRCONC(char 'd,args)] --because of & - pakname := --- kind = '"category" => INTERN STRCONC(name,char '_&) - opOf conform - domList := getDependentsOfConstructor pakname - cAlist := [[getConstructorForm x,:true] for x in domList] - htpSetProperty(htPage,'cAlist,cAlist) - htpSetProperty(htPage,'thing,'"dependent") - dbShowCons(htPage,'names) - -kcuPage(htPage,junk) == - [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - conname := INTERN name - constring := STRCONC(name,args) - conform := - kind ^= '"default package" => ncParseFromString constring - [INTERN name,:rest ncParseFromString STRCONC(char 'd,args)] --because of & - pakname := - kind = '"category" => INTERN STRCONC(name,char '_&) - opOf conform - domList := getUsersOfConstructor pakname - cAlist := [[getConstructorForm x,:true] for x in domList] - htpSetProperty(htPage,'cAlist,cAlist) - htpSetProperty(htPage,'thing,'"user") - dbShowCons(htPage,'names) - -kcnPage(htPage,junk) == ---if reached by a category, that category has a default package - [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - domname := kDomainName(htPage,kind,name,nargs) - domname is ['error,:.] => errorPage(htPage,domname) - heading := - null domname => htpProperty(htPage,'heading) - ['"{\sf ",form2HtString(domname,nil,true),'"}"] - if domname then - htpSetProperty(htPage,'domname,domname) - htpSetProperty(htPage,'heading,heading) - conform:= htpProperty(htPage,'conform) - pakname := - kind = '"category" => INTERN STRCONC(PNAME name,char '_&) - opOf conform - domList := getImports pakname - if domname then - domList := SUBLISLIS([domname,:rest domname],['$,:rest conform],domList) - cAlist := [[x,:true] for x in domList] - htpSetProperty(htPage,'cAlist,cAlist) - htpSetProperty(htPage,'thing,'"benefactor") - dbShowCons(htPage,'names) - -koPageInputAreaUnchanged?(htPage, nargs) == - [htpLabelInputString(htPage,INTERN STRCONC('"*",STRINGIMAGE i)) for i in 1..nargs] - = htpProperty(htPage,'inputAreaList) - -kDomainName(htPage,kind,name,nargs) == - htpSetProperty(htPage,'domname,nil) - inputAreaList := - [htpLabelInputString(htPage,var) for i in 1..nargs for var in $PatternVariableList] - htpSetProperty(htPage,'inputAreaList,inputAreaList) - conname := INTERN name - args := [kArgumentCheck(domain?,x) or nil for x in inputAreaList - for domain? in rest GETDATABASE(conname,'COSIG)] - or/[null x for x in args] => - (n := +/[1 for x in args | x]) > 0 => - ['error,nil,'"\centerline{You gave values for only {\em ",n,'" } of the {\em ",#args,'"}}",'"\centerline{parameters of {\sf ",name,'"}}\vspace{1}\centerline{Please enter either {\em all} or {\em none} of the type parameters}"] - nil - argString := - null args => '"()" - argTailPart := - "STRCONC"/["STRCONC"/ ['",",:x] for x in KDR args] - "STRCONC"/['"(",:first args,argTailPart,'")"] - typeForm := CATCH('SPAD__READER, unabbrev mkConform(kind,name,argString)) or - ['error,'invalidType,STRCONC(name,argString)] - null (evaluatedTypeForm := kisValidType typeForm) => - ['error,'invalidType,STRCONC(name,argString)] - dbMkEvalable evaluatedTypeForm - -kArgumentCheck(domain?,s) == - s = '"" => nil - domain? and (form := conSpecialString? s) => - null KDR form => [STRINGIMAGE opOf form] - form2String form - [s] - -dbMkEvalable form == ---like mkEvalable except that it does NOT quote domains ---does not do "loadIfNecessary" - [op,:.] := form - kind := GETDATABASE(op,'CONSTRUCTORKIND) - kind = 'category => form - mkEvalable form - -topLevelInterpEval x == - $ProcessInteractiveValue: fluid := true - $noEvalTypeMsg: fluid := true - processInteractive(x,nil) - -kisValidType typeForm == - $ProcessInteractiveValue: fluid := true - $noEvalTypeMsg: fluid := true - CATCH('SPAD__READER, processInteractive(typeForm,nil)) - is [[h,:.],:t] and member(h,'(Domain SubDomain)) => - kCheckArgumentNumbers t and t - false - -kCheckArgumentNumbers t == - [conname,:args] := t - cosig := KDR GETDATABASE(conname,'COSIG) - #cosig ^= #args => false - and/[foo for domain? in cosig for x in args] where foo() == - domain? => kCheckArgumentNumbers x - true - -parseNoMacroFromString(s) == - s := next(function ncloopParse, - next(function lineoftoks,incString s)) - StreamNull s => nil - pf2Sex first rest first s - - - -mkConform(kind,name,argString) == - kind ^= '"default package" => - form := STRCONC(name,argString) - parse := parseNoMacroFromString form - null parse => - sayBrightlyNT '"Won't parse: " - pp form - systemError '"Keywords in argument list?" - ATOM parse => [parse] - parse - [INTERN name,:rest ncParseFromString STRCONC(char 'd,argString)] --& case - ---======================================================================= --- Operation Page for a Domain Form from Scratch ---======================================================================= -conOpPage(htPage,conform) == - updown := dbCompositeWithMap htPage - updown = '"DOWN" => - domname := htpProperty(htPage,'domname) - conOpPage1(dbExtractUnderlyingDomain domname,[['updomain,:domname]]) - domname := htpProperty(htPage,'updomain) - conOpPage1(domname,nil) - -dbCompositeWithMap htPage == - htpProperty(htPage,'updomain) => '"UP" - domain := htpProperty(htPage,'domname) - null domain => false - opAlist := htpProperty(htPage,'opAlist) ---not LASSOC('map,opAlist) => false - dbExtractUnderlyingDomain htpProperty(htPage,'domname) => '"DOWN" - false - -dbExtractUnderlyingDomain domain == or/[x for x in KDR domain | isValidType x] - ---conform is atomic if no parameters, otherwise must be valid domain form -conOpPage1(conform,:options) == ---constructors Cname\#\E\sig \args \abb \comments (C is C, D, P, X) - bindingsAlist := IFCAR options - conname := opOf conform - MEMQ(conname,$Primitives) => - dbSpecialOperations conname - domname := --> !!note!! <-- - null atom conform => conform - nil - line := conPageFastPath conname - [kind,name,nargs,xflag,sig,args,abbrev,comments]:=parts:= dbXParts(line,7,1) - isFile := null kind - kind := kind or '"package" - RPLACA(parts,kind) - constring := STRCONC(name,args) - conform := mkConform(kind,name,args) - capitalKind := capitalize kind - signature := ncParseFromString sig - sourceFileName := dbSourceFile INTERN name - emString := ['"{\sf ",constring,'"}"] - heading := [capitalKind,'" ",:emString] - if not isExposedConstructor conname then heading := ['"Unexposed ",:heading] - page := htInitPage(heading,nil) - htpSetProperty(page,'isFile,true) - htpSetProperty(page,'fromConOpPage1,true) - htpSetProperty(page,'parts,parts) - htpSetProperty(page,'heading,heading) - htpSetProperty(page,'kind,kind) - htpSetProperty(page,'domname,domname) --> !!note!! <-- - htpSetProperty(page,'conform,conform) - htpSetProperty(page,'signature,signature) - if selectedOperation := LASSOC('selectedOperation,IFCDR options) then - htpSetProperty(page,'selectedOperation,selectedOperation) - for [a,:b] in bindingsAlist repeat htpSetProperty(page,a,b) - koPage(page,'"operation") - ---======================================================================= --- Operation Page from Main Page ---======================================================================= -koPage(htPage,which) == - [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts) - constring := STRCONC(name,args) - conname := INTERN name - domname := - (u := htpProperty(htPage,'domname)) is [=conname,:.] - and (htpProperty(htPage,'fromConOpPage1) = true or - koPageInputAreaUnchanged?(htPage,nargs)) => u - kDomainName(htPage,kind,name,nargs) - domname is ['error,:.] => errorPage(htPage,domname) - htpSetProperty(htPage,'domname,domname) - headingString := - domname => form2HtString(domname,nil,true) - constring - heading := [capitalize kind,'" {\sf ",headingString,'"}"] - htpSetProperty(htPage,'which,which) - htpSetProperty(htPage,'heading,heading) - koPageAux(htPage,which,domname,heading) - -koPageFromKKPage(htPage,ao) == - koPageAux(htPage,ao,htpProperty(htPage,'domname),htpProperty(htPage,'heading)) - -koPageAux(htPage,which,domname,heading) == --from koPage, koPageFromKKPage - htpSetProperty(htPage,'which,which) - domname := htpProperty(htPage,'domname) - conform := htpProperty(htPage,'conform) - heading := htpProperty(htPage,'heading) - opAlist := - which = '"attribute" => koAttrs(conform,domname) - which = '"general operation" => koOps(conform,domname,true) - koOps(conform,domname) - if selectedOperation := htpProperty(htPage,'selectedOperation) then - opAlist := [ASSOC(selectedOperation,opAlist) or systemError()] - dbShowOperationsFromConform(htPage,which,opAlist) - -koPageAux1(htPage,opAlist) == - which := htpProperty(htPage,'which) - dbShowOperationsFromConform(htPage,which,opAlist) - -koaPageFilterByName(htPage,functionToCall) == - htpLabelInputString(htPage,'filter) = '"" => - koaPageFilterByCategory(htPage,functionToCall) - filter := pmTransFilter(dbGetInputString htPage) ---WARNING: this call should check for ['error,:.] returned - which := htpProperty(htPage,'which) - opAlist := - [x for x in htpProperty(htPage,'opAlist) | superMatch?(filter,DOWNCASE STRINGIMAGE first x)] - htpSetProperty(htPage,'opAlist,opAlist) - FUNCALL(functionToCall,htPage,nil) - ---======================================================================= --- Get Constructor Documentation ---======================================================================= - -dbConstructorDoc(conform,$op,$sig) == fn conform where - fn (conform := [conname,:$args]) == - or/[gn y for y in GETDATABASE(conname,'DOCUMENTATION)] - gn([op,:alist]) == - op = $op and "or"/[doc or '("") for [sig,:doc] in alist | hn sig] - hn sig == - #$sig = #sig and $sig = SUBLISLIS($args,$FormalMapVariableList,sig) - -dbDocTable conform == ---assumes $docTableHash bound --see dbExpandOpAlistIfNecessary - table := HGET($docTableHash,conform) => table - $docTable : local := MAKE_-HASHTABLE 'ID - --process in reverse order so that closest cover up farthest - for x in originsInOrder conform repeat dbAddDocTable x - dbAddDocTable conform - HPUT($docTableHash,conform,$docTable) - $docTable - -originsInOrder conform == --domain = nil or set to live domain ---from dcCats - [con,:argl] := conform - GETDATABASE(con,'CONSTRUCTORKIND) = 'category => - ASSOCLEFT ancestorsOf(conform,nil) - acc := ASSOCLEFT parentsOf con - for x in acc repeat - for y in originsInOrder x repeat acc := insert(y,acc) - acc - -dbAddDocTable conform == - conname := opOf conform - storedArgs := rest getConstructorForm conname - for [op,:alist] in SUBLISLIS(["$",:rest conform], - ["%",:storedArgs],GETDATABASE(opOf conform,'DOCUMENTATION)) - repeat - op1 := - op = '(Zero) => 0 - op = '(One) => 1 - op - for [sig,doc] in alist repeat - HPUT($docTable,op1,[[conform,:alist],:HGET($docTable,op1)]) - --note opOf is needed!!! for some reason, One and Zero appear within prens - -dbGetDocTable(op,$sig,docTable,$which,aux) == main where ---docTable is [[origin,entry1,...,:code] ...] where --- each entry is [sig,doc] and code is NIL or else a topic code for op - main() == - if null FIXP op and - DIGITP (s := STRINGIMAGE op).0 then op := string2Integer s - -- the above hack should be removed after 3/94 when 0 is not |0| - aux is [[packageName,:.],:pred] => - doc := dbConstructorDoc(first aux,$op,$sig) - origin := - pred => ['ifp,:aux] - first aux - [origin,:doc] - or/[gn x for x in HGET(docTable,op)] - gn u == --u is [origin,entry1,...,:code] - $conform := CAR u --origin - if ATOM $conform then $conform := [$conform] - code := LASTATOM u --optional topic code - comments := or/[p for entry in CDR u | p := hn entry] or return nil - [$conform,first comments,:code] - hn [sig,:doc] == - $which = '"attribute" => sig is ['attribute,: =$sig] and doc - pred := #$sig = #sig and - alteredSig := SUBLISLIS(KDR $conform,$FormalMapVariableList,sig) - alteredSig = $sig - pred => - doc => - doc is ['constant,:r] => r - doc - '("") - false - -kTestPred n == - n = 0 => true - $domain => testBitVector($predvec,n) - simpHasPred $predvec.(n - 1) - -dbAddChainDomain conform == - [name,:args] := conform - $infovec := dbInfovec name or return nil --exit for categories - template := $infovec . 0 - null (form := template . 5) => nil - dbSubConform(args,kFormatSlotDomain devaluate form) - -dbSubConform(args,u) == - atom u => - (n := position(u,$FormalMapVariableList)) >= 0 => args . n - u - u is ['local,y] => dbSubConform(args,y) - [dbSubConform(args,x) for x in u] - -dbAddChain conform == - u := dbAddChainDomain conform => - atom u => nil - [[u,:true],:dbAddChain u] - nil - ---======================================================================= --- Constructor Page Menu ---======================================================================= ----------> !OBSELETE! <------------- -dbPresentCons(htPage,kind,:exclusions) == -- calist is ((catform . pred)...) - $saturn => dbPresentConsSaturn(htPage,kind,exclusions) - htSay('"{\em Views:}") - htpSetProperty(htPage,'exclusion,first exclusions) - cAlist := htpProperty(htPage,'cAlist) - empty? := null cAlist - exposedUnexposedFlag := $includeUnexposed? --used to be star? 4/92 - star? := true --always include information on exposed/unexposed 4/92 - htSayStandard(if star? then '"\tab{13}" else '"\tab{9}") - if empty? or member('names,exclusions) - then htSay '"{\em names}" - else htMakePage [['bcLispLinks,['"names",'"",'dbShowCons,'names]]] - htSayStandard(if star? then '"\tab{21}" else '"\tab{17}") - if empty? or member('kinds,exclusions) or kind ^= 'constructor - then htSay '"{\em kinds}" - else htMakePage [['bcLispLinks,['"kinds",'"",'dbShowCons,'kinds]]] - htSayStandard(if star? then '"\tab{29}" else '"\tab{25}") - if empty? or member('parameters,exclusions) or not "or"/[CDAR x for x in cAlist] - then htSay '"{\em parameters}" - else htMakePage [['bcLispLinks,['"parameters",'"",'dbShowCons,'parameters]]] - if star? then htSayStandard('"\tab{42}") else htSayStandard('"\tab{38}") - if empty? or null CDR cAlist - then htSay '"{\em filter}" - else htMakePage [['bcLinks,['"filter",'"",'dbShowCons,'filter]]] - htMakePage [['bcStrings, [11,'"",'filter,'EM]]] - htSay('"\newline") - if exposedUnexposedFlag then - if $exposedOnlyIfTrue then - htMakePage [['bcLinks,['"exposed",'" {\em only}",'dbShowCons,'exposureOff]]] - else - htSay('"*{\em =}") - htMakePage [['bcLinks,['"unexposed",'"",'dbShowCons,'exposureOn]]] - htSayStandard(if star? then '"\tab{13}" else '"\tab{9}") - if empty? or member('abbrs,exclusions) - then htSay '"{\em abbrs}" - else htMakePage [['bcLispLinks,['"abbrs",'"",'dbShowCons,'abbrs]]] - htSayStandard(if star? then '"\tab{21}" else '"\tab{17}") - if empty? or member('files,exclusions) - then htSay '"{\em files}" - else htMakePage [['bcLispLinks,['"files",'"",'dbShowCons,'files]]] - htSayStandard(if star? then '"\tab{29}" else '"\tab{25}") - if empty? or member('conditions,exclusions) or "and"/[CDR x = true for x in cAlist] - then htSay '"{\em conditions}" - else htMakePage [['bcLispLinks,['"conditions",'"",'dbShowCons,'conditions]]] - if star? then htSayStandard('"\tab{42}") else htSayStandard('"\tab{38}") - if empty? or member('documentation,exclusions) - then htSay '"{\em descriptions}" - else htMakePage [['bcLispLinks,['"descriptions",'"",'dbShowCons,'documentation]]] - -dbShowCons(htPage,key,:options) == - cAlist := htpProperty(htPage,'cAlist) - key = 'filter => - --if $saturn, IFCAR options is the filter string - filter := pmTransFilter(IFCAR options or dbGetInputString htPage) - filter is ['error,:.] => bcErrorPage filter - abbrev? := htpProperty(htPage,'exclusion) = 'abbrs - u := [x for x in cAlist | test] where test() == - conname := CAAR x - subject := (abbrev? => constructor? conname; conname) - superMatch?(filter,DOWNCASE STRINGIMAGE subject) - null u => emptySearchPage('"constructor",filter) - htPage := htInitPageNoScroll(htCopyProplist htPage) - htpSetProperty(htPage,'cAlist,u) - dbShowCons(htPage,htpProperty(htPage,'exclusion)) - if MEMQ(key,'(exposureOn exposureOff)) then - $exposedOnlyIfTrue := - key = 'exposureOn => 'T - NIL - key := htpProperty(htPage,'exclusion) - dbShowCons1(htPage,cAlist,key) - -conPageChoose conname == - cAlist := [[getConstructorForm conname,:true]] - dbShowCons1(nil,cAlist,'names) - -dbShowCons1(htPage,cAlist,key) == - conlist := REMDUP [item for x in cAlist | pred] where - pred() == - item := CAR x - $exposedOnlyIfTrue => isExposedConstructor opOf item - item ---$searchFirstTime and (conlist is [.]) => conPage first conlist ---$searchFirstTime := false - conlist is [.] => conPage - htPage and htpProperty(htPage,'domname) => first conlist - opOf first conlist - conlist := [opOf x for x in conlist] - kinds := "union"/[dbConstructorKind x for x in conlist] - kind := - kinds is [a] => a - 'constructor - proplist := - htPage => htCopyProplist htPage - nil - page := htInitPageNoScroll(proplist,dbConsHeading(htPage,conlist,key,kind)) - if u := htpProperty(page,'specialMessage) then APPLY(first u,rest u) - htSayStandard('"\beginscroll ") - htpSetProperty(page,'cAlist,cAlist) - $conformsAreDomains: local := htpProperty(page,'domname) - do - --key = 'catfilter => dbShowCatFilter(page,key) - key = 'names => bcNameConTable conlist - key = 'abbrs => - bcAbbTable [getCDTEntry(con,true) for con in conlist] - key = 'files => - flist := - [y for con in conlist | - y := (fn := GETDATABASE(con,'SOURCEFILE))] - bcUnixTable(listSort(function GLESSEQP,REMDUP flist)) - key = 'documentation => dbShowConsDoc(page,conlist) - if $exposedOnlyIfTrue then - cAlist := [x for x in cAlist | isExposedConstructor opOf CAR x] - key = 'conditions => dbShowConditions(page,cAlist,kind) - key = 'parameters => bcConTable REMDUP ASSOCLEFT cAlist - key = 'kinds => dbShowConsKinds cAlist - dbConsExposureMessage() - htSayStandard("\endscroll ") - dbPresentCons(page,kind,key) - htShowPageNoScroll() - - -dbConsExposureMessage() == - $atLeastOneUnexposed => - htSay '"\newline{}-------------\newline{}{\em *} = unexposed" - --- DUPLICATE DEF - ALSO in br-saturn.boot --- dbShowConsKinds cAlist == --- ---------> !OBSELETE! <------------- --- cats := doms := paks := defs := nil --- for x in cAlist repeat --- op := CAAR x --- kind := dbConstructorKind op --- kind = 'category => cats := [x,:cats] --- kind = 'domain => doms := [x,:doms] --- kind = 'package => paks:= [x,:paks] --- defs := [x,:defs] --- lists := [NREVERSE cats,NREVERSE doms,NREVERSE paks,NREVERSE defs] --- htBeginMenu(2) --- htSayStandard '"\indent{1}" --- kinds := +/[1 for x in lists | #x > 0] --- for kind in '("category" "domain" "package" "default package") for x in lists | #x > 0 repeat --- htSay('"\item") --- if kinds = 1 then htSay menuButton() else --- htMakePage [['bcLinks,[menuButton(),'"",'dbShowConsKindsFilter,[kind,x]]]] --- htSayStandard '"\tab{1}" --- htSay '"{\em " --- htSay (c := #x) --- htSay '" " --- htSay (c > 1 => pluralize kind; kind) --- htSay '":}" --- bcConTable REMDUP [CAAR y for y in x] --- htEndMenu(2) --- htSay '"\indent{0}" - -dbShowConsKindsFilter(htPage,[kind,cAlist]) == - htpSetProperty(htPage,'cAlist,cAlist) - dbShowCons(htPage,htpProperty(htPage,'exclusion)) - -dbShowConsDoc(htPage,conlist) == - null rest conlist => dbShowConsDoc1(htPage,getConstructorForm opOf first conlist,nil) - cAlist := htpProperty(htPage,'cAlist) - --the following code is necessary to skip over duplicates on cAlist - index := 0 - for x in REMDUP conlist repeat - -- for x in conlist repeat - dbShowConsDoc1(htPage,getConstructorForm x,i) where i() == - while CAAAR cAlist ^= x repeat - index := index + 1 - cAlist := rest cAlist - null cAlist => systemError () - index - -dbShowConsDoc1(htPage,conform,indexOrNil) == - [conname,:conargs] := conform - MEMQ(conname,$Primitives) => - conname := htpProperty(htPage,'conname) - [["constructor",["NIL",doc]],:.] := GETL(conname,'documentation) - sig := '((CATEGORY domain) (SetCategory) (SetCategory)) - displayDomainOp(htPage,'"constructor",conform,conname,sig,true,doc,indexOrNil,'dbSelectCon,nil,nil) - exposeFlag := isExposedConstructor conname - doc := [getConstructorDocumentation conname] - signature := getConstructorSignature conname - sig := - GETDATABASE(conname,'CONSTRUCTORKIND) = 'category => - SUBLISLIS(conargs,$TriangleVariableList,signature) - sublisFormal(conargs,signature) - htSaySaturn '"\begin{description}" - displayDomainOp(htPage,'"constructor",conform,conname,sig,true,doc,indexOrNil,'dbSelectCon,null exposeFlag,nil) - htSaySaturn '"\end{description}" - --NOTE that we pass conform is as "origin" - -getConstructorDocumentation conname == - LASSOC('constructor,GETDATABASE(conname,'DOCUMENTATION)) - is [[nil,line,:.],:.] and line or '"" - -dbSelectCon(htPage,which,index) == - conPage opOf first (htpProperty(htPage,'cAlist)).index - -dbShowConditions(htPage,cAlist,kind) == - conform := htpProperty(htPage,'conform) - conname := opOf conform - article := htpProperty(htPage,'article) - whichever := htpProperty(htPage,'whichever) - [consNoPred,:consPred] := splitConTable cAlist - singular := [kind,'" is"] - plural := [pluralize STRINGIMAGE kind,'" are"] - dbSayItems(#consNoPred,singular,plural,'" unconditional") - htSaySaturn '"\\" - bcConPredTable(consNoPred,conname) - htSayHrule() - dbSayItems(#consPred,singular,plural,'" conditional") - htSaySaturn '"\\" - bcConPredTable(consPred,conname) - -dbConsHeading(htPage,conlist,view,kind) == - thing := htPage and htpProperty(htPage,'thing) or '"constructor" - place := - htPage => htpProperty(htPage,'domname) or htpProperty(htPage,'conform) - nil - count := #(REMDUP conlist) - -- count := #conlist - thing = '"benefactor" => - [STRINGIMAGE count,'" Constructors Used by ",form2HtString(place,nil,true)] - modifier := - thing = '"argument" => - rank := htPage and htpProperty(htPage,'rank) - ['" Possible ",rank,'" "] - kind = 'constructor => ['" "] - ['" ",capitalize STRINGIMAGE kind,'" "] --- count = 1 => --- ['"Select name or a {\em view} at the bottom"] - exposureWord := - $exposedOnlyIfTrue => '(" Exposed ") - nil - prefix := - count = 1 => [STRINGIMAGE count,:modifier,capitalize thing] - firstWord := (count = 0 => '"No "; STRINGIMAGE count) - [firstWord,:exposureWord, :modifier,capitalize pluralize thing] - placepart := - place => ['" of {\em ",form2HtString(place,nil,true),"}"] - nil - heading := [:prefix,:placepart] - connective := - member(view,'(abbrs files kinds)) => '" as " - '" with " - if count ^= 0 and member(view,'(abbrs files parameters conditions)) then heading:= [:heading,'" viewed",connective,'"{\em ",STRINGIMAGE view,'"}"] - heading - -dbShowConstructorLines lines == - cAlist := [[getConstructorForm intern dbName line,:true] for line in lines] - dbShowCons1(nil,listSort(function GLESSEQP,cAlist),'names) - -bcUnixTable(u) == - htSay '"\newline" - htBeginTable() - firstTime := true - for x in u repeat - if firstTime then firstTime := false - else htSaySaturn '"&" - htSay '"{" - ft := - isAsharpFileName? x => '("AS") - '("SPAD") - filename := NAMESTRING $FINDFILE(STRINGIMAGE x, ft) - htMakePage [['text, '"\unixcommand{",PATHNAME_-NAME x, '"}{$AXIOM/lib/SPADEDIT ", filename, '"} "]] - htSay '"}" - htEndTable() - -isAsharpFileName? con == false - ---======================================================================= --- Special Code for Union, Mapping, and Record ---======================================================================= - -dbSpecialDescription(conname) == - conform := getConstructorForm conname - heading := ['"Description of Domain {\sf ",form2HtString conform,'"}"] - page := htInitPage(heading,nil) - htpSetProperty(page,'conname,conname) - $conformsAreDomains := nil - dbShowConsDoc1(page,conform,nil) - htShowPage() - -dbSpecialOperations(conname) == - page := htInitPage(nil,nil) - conform := getConstructorForm conname - opAlist := dbSpecialExpandIfNecessary(conform,rest GETL(conname,'documentation)) - fromHeading := ['" from domain {\sf ",form2HtString conform,'"}"] - htpSetProperty(page,'fromHeading,fromHeading) - htpSetProperty(page,'conform,conform) - htpSetProperty(page,'opAlist,opAlist) - htpSetProperty(page,'noUsage,true) - htpSetProperty(page,'condition?,'no) - dbShowOp1(page,opAlist,'"operation",'names) - -dbSpecialExports(conname) == - conform := getConstructorForm conname - page := htInitPage(['"Exports of {\sf ",form2HtString conform,'"}"],nil) - opAlist := dbSpecialExpandIfNecessary(conform,rest GETL(conname,'documentation)) - kePageDisplay(page,'"operation",opAlist) - htShowPage() - -dbSpecialExpandIfNecessary(conform,opAlist) == - opAlist is [[op,[sig,:r],:.],:.] and rest r => opAlist - for [op,:u] in opAlist repeat - for pair in u repeat - [sig,comments] := pair - RPLACD(pair,['T,conform,'T,comments]) --[sig,pred,origin,exposeFg,doc] - opAlist - -X := '"{\sf Record(a:A,b:B)} is used to create the class of pairs of objects made up of a value of type {\em A} selected by the symbol {\em a} and a value of type {\em B} selected by the symbol {\em b}. " - -Y := '"In general, the {\sf Record} constructor can take any number of arguments and thus can be used to create aggregates of heterogeneous components of arbitrary size selectable by name. " - -Z := '"{\sf Record} is a primitive domain of \Language{} which cannot be defined in the \Language{} language." - -MESSAGE := STRCONC(X,Y,Z) - -PUT('Record,'documentation,SUBST(MESSAGE,'MESSAGE,'( - (constructor (NIL MESSAGE)) - (_= (((Boolean) _$ _$) - "\spad{r = s} tests for equality of two records \spad{r} and \spad{s}")) - (coerce (((OutputForm) _$) - "\spad{coerce(r)} returns an representation of \spad{r} as an output form") - ((_$ (List (Any))) - "\spad{coerce(u)}, where \spad{u} is the list \spad{[x,y]} for \spad{x} of type \spad{A} and \spad{y} of type \spad{B}, returns the record \spad{[a:x,b:y]}")) - (elt ((A $ "a") - "\spad{r . a} returns the value stored in record \spad{r} under selector \spad{a}.") - ((B $ "b") - "\spad{r . b} returns the value stored in record \spad{r} under selector \spad{b}.")) - (setelt ((A $ "a" A) - "\spad{r . a := x} destructively replaces the value stored in record \spad{r} under selector \spad{a} by the value of \spad{x}. Error: if \spad{r} has not been previously assigned a value.") - ((B $ "b" B) - "\spad{r . b := y} destructively replaces the value stored in record \spad{r} under selector \spad{b} by the value of \spad{y}. Error: if \spad{r} has not been previously assigned a value.")) - ))) - -X := '"{\sf Union(A,B)} denotes the class of objects which are which are either members of domain {\em A} or of domain {\em B}. The {\sf Union} constructor can take any number of arguments. " - -Y := '"For an alternate form of {\sf Union} with _"tags_", see \downlink{Union(a:A,b:B)}{DomainUnion}. {\sf Union} is a primitive domain of \Language{} which cannot be defined in the \Language{} language." - -MESSAGE := STRCONC(X,Y) - -PUT('UntaggedUnion,'documentation,SUBST(MESSAGE,'MESSAGE,'( - (constructor (NIL MESSAGE)) - (_= (((Boolean) $ $) - "\spad{u = v} tests if two objects of the union are equal, that is, u and v are hold objects of same branch which are equal.")) - (case (((Boolean) $ "A") - "\spad{u case A} tests if \spad{u} is of the type \spad{A} branch of the union.") - (((Boolean) $ "B") - "\spad{u case B} tests if \spad{u} is of the \spad{B} branch of the union.")) - (coerce ((A $) - "\spad{coerce(u)} returns \spad{x} of type \spad{A} if \spad{x} is of the \spad{A} branch of the union. Error: if \spad{u} is of the \spad{B} branch of the union.") - ((B $) - "\spad{coerce(u)} returns \spad{x} of type \spad{B} if \spad{x} is of the \spad{B} branch of the union. Error: if \spad{u} is of the \spad{A} branch of the union.") - (($ A) - "\spad{coerce(x)}, where \spad{x} has type \spad{A}, returns \spad{x} as a union type.") - (($ B) - "\spad{coerce(y)}, where \spad{y} has type \spad{B}, returns \spad{y} as a union type.")) - ))) - -X := '"{\sf Union(a:A,b:B)} denotes the class of objects which are either members of domain {\em A} or of domain {\em B}. " - -Y := '"The symbols {\em a} and {\em b} are called _"tags_" and are used to identify the two _"branches_" of the union. " - -Z := '"The {\sf Union} constructor can take any number of arguments and has an alternate form without {\em tags} (see \downlink{Union(A,B)}{UntaggedUnion}). " - -W := '"This tagged {\sf Union} type is necessary, for example, to disambiguate two branches of a union where {\em A} and {\em B} denote the same type. " - -A := '"{\sf Union} is a primitive domain of \Language{} which cannot be defined in the \Language{} language." - -MESSAGE := STRCONC(X,Y,Z,W,A) - -PUT('Union,'documentation,SUBST(MESSAGE,'MESSAGE,'( - (constructor (NIL MESSAGE)) - (_= (((Boolean) $ $) - "\spad{u = v} tests if two objects of the union are equal, that is, \spad{u} and \spad{v} are objects of same branch which are equal.")) - (case (((Boolean) $ "A") - "\spad{u case a} tests if \spad{u} is of branch \spad{a} of the union.") - (((Boolean) $ "B") - "\spad{u case b} tests if \spad{u} is of branch \spad{b} of the union.")) - (coerce ((A $) - "\spad{coerce(u)} returns \spad{x} of type \spad{A} if \spad{x} is of branch \spad{a} of the union. Error: if \spad{u} is of branch \spad{b} of the union.") - ((B $) - "\spad{coerce(u)} returns \spad{x} of type \spad{B} if \spad{x} is of branch \spad{b} branch of the union. Error: if \spad{u} is of the \spad{a} branch of the union.") - (($ A) - "\spad{coerce(x)}, where \spad{x} has type \spad{A}, returns \spad{x} as a union type.") - (($ B) - "\spad{coerce(y)}, where \spad{y} has type \spad{B}, returns \spad{y} as a union type.")) - ))) - -X := '"{\sf Mapping(T,S,...)} denotes the class of objects which are mappings from a source domain ({\em S,...}) into a target domain {\em T}. The {\sf Mapping} constructor can take any number of arguments." - -Y := '" All but the first argument is regarded as part of a source tuple for the mapping. For example, {\sf Mapping(T,A,B)} denotes the class of mappings from {\em (A,B)} into {\em T}. " - -Z := '"{\sf Mapping} is a primitive domain of \Language{} which cannot be defined in the \Language{} language." - -MESSAGE := STRCONC(X,Y,Z) - -PUT('Mapping,'documentation, SUBST(MESSAGE,'MESSAGE,'( - (constructor (NIL MESSAGE)) - (_= (((Boolean) $ $) - "\spad{u = v} tests if mapping objects are equal.")) - ))) - -X := '"{\em Enumeration(a1, a2 ,..., aN)} creates an object which is exactly one of the N symbols {\em a1}, {\em a2}, ..., or {\em aN}, N > 0. " - -Y := '" The {\em Enumeration} can constructor can take any number of symbols as arguments." - -MESSAGE := STRCONC(X, Y) - -PUT('Enumeration, 'documentation, SUBST(MESSAGE, 'MESSAGE, '( - (constructor (NIL MESSAGE)) - (_= (((Boolean) _$ _$) - "\spad{e = f} tests for equality of two enumerations \spad{e} and \spad{f}")) - (_^_= (((Boolean) _$ _$) - "\spad{e ^= f} tests that two enumerations \spad{e} and \spad{f} are nont equal")) - (coerce (((OutputForm) _$) - "\spad{coerce(e)} returns a representation of enumeration \spad{r} as an output form") - ((_$ (Symbol)) - "\spad{coerce(s)} converts a symbol \spad{s} into an enumeration which has \spad{s} as a member symbol")) - ))) - - -mkConArgSublis args == - [[arg,:INTERN digits2Names PNAME arg] for arg in args - | (s := PNAME arg) and "or"/[DIGITP ELT(s,i) for i in 0..MAXINDEX s]] - -digits2Names s == ---This is necessary since arguments of conforms CANNOT have digits in TechExplorer - str := '"" - for i in 0..MAXINDEX s repeat - c := s.i - segment := - n := DIGIT_-CHAR_-P c => - ('("Zero" "One" "Two" "Three" "Four" "Five" "Six" "Seven" "Eight" "Nine")).n - c - CONCAT(str, segment) - str -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} |