diff options
Diffstat (limited to 'src/interp/database.boot.pamphlet')
| -rw-r--r-- | src/interp/database.boot.pamphlet | 697 |
1 files changed, 697 insertions, 0 deletions
diff --git a/src/interp/database.boot.pamphlet b/src/interp/database.boot.pamphlet new file mode 100644 index 00000000..f33d9333 --- /dev/null +++ b/src/interp/database.boot.pamphlet @@ -0,0 +1,697 @@ +\documentclass{article} +\usepackage{axiom} + +\title{\File{src/interp/database.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>> + +SETANDFILEQ($getUnexposedOperations,true) + +--% Functions for manipulating MODEMAP DATABASE + +augLisplibModemapsFromCategory(form is [op,:argl],body,signature) == + sl := [["$",:"*1"],:[[a,:p] for a in argl + for p in rest $PatternVariableList]] + form:= SUBLIS(sl,form) + body:= SUBLIS(sl,body) + signature:= SUBLIS(sl,signature) + opAlist:= SUBLIS(sl,$domainShell.(1)) or return nil + nonCategorySigAlist:= + mkAlistOfExplicitCategoryOps substitute("*1","$",body) + domainList:= + [[a,m] for a in rest form for m in rest signature | + isCategoryForm(m,$EmptyEnvironment)] + catPredList:= [['ofCategory,:u] for u in [["*1",form],:domainList]] + for (entry:= [[op,sig,:.],pred,sel]) in opAlist | + member(sig,LASSOC(op,nonCategorySigAlist)) repeat + pred':= MKPF([pred,:catPredList],'AND) + modemap:= [["*1",:sig],[pred',sel]] + $lisplibModemapAlist:= + [[op,:interactiveModemapForm modemap],:$lisplibModemapAlist] + +augmentLisplibModemapsFromFunctor(form,opAlist,signature) == + form:= [formOp,:argl]:= formal2Pattern form + opAlist:= formal2Pattern opAlist + signature:= formal2Pattern signature + for u in form for v in signature repeat + if MEMQ(u,$PatternVariableList) then + -- we are going to be EVALing categories containing these + -- pattern variables + $e:=put(u,'mode,v,$e) + nonCategorySigAlist:= + mkAlistOfExplicitCategoryOps first signature or return nil + for (entry:= [[op,sig,:.],pred,sel]) in opAlist | + or/[(sig in catSig) for catSig in + allLASSOCs(op,nonCategorySigAlist)] repeat + skip:= + argl and CONTAINED("$",rest sig) => 'SKIP + nil + sel:= substitute(form,"$",sel) + patternList:= listOfPatternIds sig + --get relevant predicates + predList:= + [[a,m] for a in argl for m in rest signature + | MEMQ(a,$PatternVariableList)] + sig:= substitute(form,"$",sig) + pred':= MKPF([pred,:[mkDatabasePred y for y in predList]],'AND) + l:=listOfPatternIds predList + if "OR"/[null MEMQ(u,l) for u in argl] then + sayMSG ['"cannot handle modemap for",:bright op, + '"by pattern match" ] + skip:= 'SKIP + modemap:= [[form,:sig],[pred',sel,:skip]] + $lisplibModemapAlist:= [[op,:interactiveModemapForm modemap], + :$lisplibModemapAlist] + +rebuildCDT(filemode) == + clearConstructorAndLisplibCaches() + $databaseQueue:local :=nil + $e: local := [[NIL]] -- We may need to evaluate Categories + buildDatabase(filemode,false) + $IOindex:= 1 + $InteractiveFrame:= [[NIL]] + 0 + +buildDatabase(filemode,expensive) == + $InteractiveMode: local:= true + $constructorList := nil --looked at by buildLibdb + $ConstructorCache:= MAKE_-HASHTABLE('ID) + SAY '"Making constructor autoload" + makeConstructorsAutoLoad() + SAY '"Building category table" + genCategoryTable() + SAY '"Building libdb.text" + buildLibdb() + SAY '"splitting libdb.text" + dbSplitLibdb() + SAY '"creating browse constructor index" + dbAugmentConstructorDataTable() + SAY '"Building browse.lisp" + buildBrowsedb() + SAY '"Building constructor users database" + mkUsersHashTable() + SAY '"Saving constructor users database" + saveUsersHashTable() + SAY '"Building constructor dependents database" + mkDependentsHashTable() + SAY '"Saving constructor dependents database" + saveDependentsHashTable() + SAY '"Building glossary files" + buildGloss() + +saveUsersHashTable() == + _$ERASE('USERS,'DATABASE,'a) + stream:= writeLib1('USERS,'DATABASE,'a) + for k in MSORT HKEYS $usersTb repeat + rwrite(k, HGET($usersTb, k), stream) + RSHUT stream + +saveDependentsHashTable() == + _$ERASE('DEPENDENTS,'DATABASE,'a) + stream:= writeLib1('DEPENDENTS,'DATABASE,'a) + for k in MSORT HKEYS $depTb repeat + rwrite(k, HGET($depTb, k), stream) + RSHUT stream + +getUsersOfConstructor(con) == + stream := readLib1('USERS, 'DATABASE, 'a) + val := rread(con, stream, nil) + RSHUT stream + val + +getDependentsOfConstructor(con) == + stream := readLib1('DEPENDENTS, 'DATABASE, 'a) + val := rread(con, stream, nil) + RSHUT stream + val + +putModemapIntoDatabase(name,modemap,fileName) == + $forceAdd: local:= nil + mml:= ASSOC(name,$databaseQueue) + if mml = [] then + $databaseQueue:=[[name, modemap],:$databaseQueue] + else + or/[modemap=map' for map' in CDR mml] => "already there" + newEntry:= [modemap,:CDR mml] + RPLACD(mml,newEntry) + newEntry + +orderPredicateItems(pred1,sig,skip) == + pred:= signatureTran pred1 + pred is ["AND",:l] => orderPredTran(l,sig,skip) + pred + +orderPredTran(oldList,sig,skip) == + lastPreds:=nil + --(1) make two kinds of predicates appear last: + ----- (op *target ..) when *target does not appear later in sig + ----- (isDomain *1 ..) + for pred in oldList repeat + ((pred is [op,pvar,.] and MEMQ(op,'(isDomain ofCategory)) + and pvar=first sig and ^(pvar in rest sig)) or + (^skip and pred is ['isDomain,pvar,.] and pvar="*1")) => + oldList:=delete(pred,oldList) + lastPreds:=[pred,:lastPreds] +--sayBrightlyNT "lastPreds=" +--pp lastPreds + + --(2a) lastDependList=list of all variables that lastPred forms depend upon + lastDependList := "UNIONQ"/[listOfPatternIds x for x in lastPreds] +--sayBrightlyNT "lastDependList=" +--pp lastDependList + + --(2b) dependList=list of all variables that isDom/ofCat forms depend upon + dependList := + "UNIONQ"/[listOfPatternIds y for x in oldList | + x is ['isDomain,.,y] or x is ['ofCategory,.,y]] +--sayBrightlyNT "dependList=" +--pp dependList + + --(3a) newList= list of ofCat/isDom entries that don't depend on + for x in oldList repeat + if (x is ['ofCategory,v,body]) or (x is ['isDomain,v,body]) then + indepvl:=listOfPatternIds v + depvl:=listOfPatternIds body + else + indepvl := listOfPatternIds x + depvl := nil + (INTERSECTIONQ(indepvl,dependList) = nil) + and INTERSECTIONQ(indepvl,lastDependList) => + somethingDone := true + lastPreds := [:lastPreds,x] + oldList := delete(x,oldList) +--if somethingDone then +-- sayBrightlyNT "Again lastPreds=" +-- pp lastPreds +-- sayBrightlyNT "Again oldList=" +-- pp oldList + + --(3b) newList= list of ofCat/isDom entries that don't depend on + while oldList repeat + for x in oldList repeat + if (x is ['ofCategory,v,body]) or (x is ['isDomain,v,body]) then + indepvl:=listOfPatternIds v + depvl:=listOfPatternIds body + else + indepvl := listOfPatternIds x + depvl := nil + (INTERSECTIONQ(indepvl,dependList) = nil) => + dependList:= setDifference(dependList,depvl) + newList:= [:newList,x] +-- sayBrightlyNT "newList=" +-- pp newList + + --(4) noldList= what is left over + (noldList:= setDifference(oldList,newList)) = oldList => +-- sayMSG '"NOTE: Parameters to domain have circular dependencies" + newList := [:newList,:oldList] + return nil + oldList:=noldList +-- sayBrightlyNT "noldList=" +-- pp noldList + + for pred in newList repeat + if pred is ['isDomain,x,y] or x is ['ofCategory,x,y] then + ids:= listOfPatternIds y + if and/[id in fullDependList for id in ids] then + fullDependList:= insertWOC(x,fullDependList) + fullDependList:= UNIONQ(fullDependList,ids) + + newList:=[:newList,:lastPreds] + +--substitute (isDomain ..) forms as completely as possible to avoid false paths + newList := isDomainSubst newList + answer := [['AND,:newList],:INTERSECTIONQ(fullDependList,sig)] +--sayBrightlyNT '"answer=" +--pp answer + +isDomainSubst u == main where + main == + u is [head,:tail] => + nhead := + head is ['isDomain,x,y] => ['isDomain,x,fn(y,tail)] + head + [nhead,:isDomainSubst rest u] + u + fn(x,alist) == + atom x => + IDENTP x and MEMQ(x,$PatternVariableList) and (s := findSub(x,alist)) => s + x + [CAR x,:[fn(y,alist) for y in CDR x]] + findSub(x,alist) == + null alist => nil + alist is [['isDomain,y,z],:.] and x = y => z + findSub(x,rest alist) + +signatureTran pred == + atom pred => pred + pred is ['has,D,catForm] and isCategoryForm(catForm,$e) => + ['ofCategory,D,catForm] + [signatureTran p for p in pred] + +interactiveModemapForm mm == + -- create modemap form for use by the interpreter. This function + -- replaces all specific domains mentioned in the modemap with pattern + -- variables, and predicates + mm := replaceVars(COPY mm,$PatternVariableList,$FormalMapVariableList) + [pattern:=[dc,:sig],pred] := mm + pred := [fn x for x in pred] where fn x == + x is [a,b,c] and a ^= 'isFreeFunction and atom c => [a,b,[c]] + x +--pp pred + [mmpat, patternAlist, partial, patvars] := + modemapPattern(pattern,sig) +--pp [pattern, mmpat, patternAlist, partial, patvars] + [pred,domainPredicateList] := + substVars(pred,patternAlist,patvars) +--pp [pred,domainPredicateList] + [pred,:dependList]:= + fixUpPredicate(pred,domainPredicateList,partial,rest mmpat) +--pp [pred,dependList] + [cond, :.] := pred + [mmpat, cond] + +modemapPattern(mmPattern,sig) == + -- Returns a list of the pattern of a modemap, an Alist of the + -- substitutions made, a boolean flag indicating whether + -- the result type is partial, and a list of unused pattern variables + patternAlist := nil + mmpat := nil + patvars := $PatternVariableList + partial := false + for xTails in tails mmPattern repeat + x := first xTails + if x is ['Union,dom,tag] and tag = '"failed" and xTails=sig then + x := dom + partial := true + patvar := rassoc(x,patternAlist) + not null patvar => mmpat := [patvar,:mmpat] + patvar := first patvars + patvars := rest patvars + mmpat := [patvar,:mmpat] + patternAlist := [[patvar,:x],:patternAlist] + [NREVERSE mmpat,patternAlist,partial,patvars] + +substVars(pred,patternAlist,patternVarList) == + --make pattern variable substitutions + domainPredicates := nil + for [[patVar,:value],:.] in tails patternAlist repeat + pred := substitute(patVar,value,pred) + patternAlist := nsubst(patVar,value,patternAlist) + domainPredicates := substitute(patVar,value,domainPredicates) + if ^MEMQ(value,$FormalMapVariableList) then + domainPredicates := [["isDomain",patVar,value],:domainPredicates] + everything := [pred,patternAlist,domainPredicates] + for var in $FormalMapVariableList repeat + CONTAINED(var,everything) => + replacementVar := first patternVarList + patternVarList := rest patternVarList + pred := substitute(replacementVar,var,pred) + domainPredicates := substitute(replacementVar,var,domainPredicates) + [pred, domainPredicates] + +fixUpPredicate(predClause, domainPreds, partial, sig) == + -- merge the predicates in predClause and domainPreds into a + -- single predicate + [predicate, fn, :skip] := predClause + if first predicate = "AND" then + predicates := APPEND(domainPreds,rest predicate) + else if predicate ^= MKQ "T" +--was->then predicates:= REVERSE [predicate, :domainPreds] + then predicates:= [predicate, :domainPreds] + else predicates := domainPreds or [predicate] + if #predicates > 1 then + pred := ["AND",:predicates] + [pred,:dependList]:=orderPredicateItems(pred,sig,skip) + else + pred := orderPredicateItems(first predicates,sig,skip) + dependList:= if pred is ['isDomain,pvar,[.]] then [pvar] else nil + pred := moveORsOutside pred + if partial then pred := ["partial", :pred] + [[pred, fn, :skip],:dependList] + +moveORsOutside p == + p is ['AND,:q] => + q := [moveORsOutside r for r in q] + x := or/[r for r in q | r is ['OR,:s]] => + moveORsOutside(['OR,:[['AND,:SUBST(t,x,q)] for t in CDR x]]) + ['AND,:q] + p + +replaceVars(x,oldvars,newvars) == + -- replace every identifier in oldvars with the corresponding + -- identifier in newvars in the expression x + for old in oldvars for new in newvars repeat + x := substitute(new,old,x) + x + +getDomainFromMm mm == + -- Returns the Domain (or package or category) of origin from a pattern + -- modemap + [., cond] := mm + if cond is ['partial, :c] then cond := c + condList := + cond is ['AND, :cl] => cl + cond is ['OR, ['AND, :cl],:.] => cl --all cl's should give same info + [cond] + val := + for condition in condList repeat + condition is ['isDomain, "*1", dom] => return opOf dom + condition is ['ofCategory, "*1", cat] => return opOf cat + null val => + keyedSystemError("S2GE0016", + ['"getDomainFromMm",'"Can't find domain in modemap condition"]) + val + +getFirstArgTypeFromMm mm == + -- Returns the type of the first argument or nil + [pats, cond] := mm + [.,.,:args] := pats + null args => nil + arg1 := first args + if cond is ['partial, :c] then cond := c + condList := + cond is ['AND, :cl] => cl + cond is ['OR, ['AND, :cl],:.] => cl --all cl's should give same info + [cond] + type := nil + for condition in condList while not type repeat + if condition is ['isDomain, a1, dom] and a1=arg1 then type := dom + type + +isFreeFunctionFromMm mm == + -- This returns true is the modemap represents a free function, ie, + -- one not coming from a domain or category. + [., cond] := mm + isFreeFunctionFromMmCond cond + +isFreeFunctionFromMmCond cond == + -- This returns true is the modemap represents a free function, ie, + -- one not coming from a domain or category. + if cond is ['partial, :c] then cond := c + condList := + cond is ['AND, :cl] => cl + cond is ['OR, ['AND, :cl],:.] => cl --all cl's should give same info + [cond] + iff := false + for condition in condList while not iff repeat + if condition is ['isFreeFunction, :.] then iff := true + iff + +getAllModemapsFromDatabase(op,nargs) == + $getUnexposedOperations: local := true + startTimingProcess 'diskread + ans := getSystemModemaps(op,nargs) + stopTimingProcess 'diskread + ans + +getModemapsFromDatabase(op,nargs) == + $getUnexposedOperations: local := false + startTimingProcess 'diskread + ans := getSystemModemaps(op,nargs) + stopTimingProcess 'diskread + ans + +getSystemModemaps(op,nargs) == + mml:= GETDATABASE(op,'OPERATION) => + mms := NIL + for (x := [[.,:sig],.]) in mml repeat + (NUMBERP nargs) and (nargs ^= #QCDR sig) => 'iterate + $getUnexposedOperations or isFreeFunctionFromMm(x) or + isExposedConstructor(getDomainFromMm(x)) => mms := [x,:mms] + 'iterate + mms + nil + +getInCoreModemaps(modemapList,op,nargs) == + mml:= LASSOC (op,modemapList) => + mml:= CAR mml + [x for (x:= [[dc,:sig],.]) in mml | + (NUMBERP nargs => nargs=#rest sig; true) and + (cfn := abbreviate (domName := getDomainFromMm x)) and + ($getUnexposedOperations or isExposedConstructor(domName))] + nil + +mkAlistOfExplicitCategoryOps target == + if target is ['add,a,:l] then + target:=a + target is ['Join,:l] => + "union"/[mkAlistOfExplicitCategoryOps cat for cat in l] + target is ['CATEGORY,.,:l] => + l:= flattenSignatureList ['PROGN,:l] + u:= + [[atomizeOp op,:sig] for x in l | x is ['SIGNATURE,op,sig,:.]] + where + atomizeOp op == + atom op => op + op is [a] => a + keyedSystemError("S2GE0016", + ['"mkAlistOfExplicitCategoryOps",'"bad signature"]) + opList:= REMDUP ASSOCLEFT u + [[x,:fn(x,u)] for x in opList] where + fn(op,u) == + u is [[a,:b],:c] => (a=op => [b,:fn(op,c)]; fn(op,c)) + isCategoryForm(target,$e) => nil + keyedSystemError("S2GE0016", + ['"mkAlistOfExplicitCategoryOps",'"bad signature"]) + +flattenSignatureList(x) == + atom x => nil + x is ['SIGNATURE,:.] => [x] + x is ['IF,cond,b1,b2] => + append(flattenSignatureList b1, flattenSignatureList b2) + x is ['PROGN,:l] => + ll:= [] + for x in l repeat + x is ['SIGNATURE,:.] => ll:=cons(x,ll) + ll:= append(flattenSignatureList x,ll) + ll + nil + +mkDatabasePred [a,t] == + isCategoryForm(t,$e) => ['ofCategory,a,t] + ['ofType,a,t] + +formal2Pattern x == + SUBLIS(pairList($FormalMapVariableList,rest $PatternVariableList),x) + +updateDatabase(fname,cname,systemdir?) == + -- for now in NRUNTIME do database update only if forced + not $forceDatabaseUpdate => nil + $newcompMode = 'true => nil + -- these modemaps are never needed in the old scheme + if oldFname := constructor? cname then + clearClams() + clearAllSlams [] + if GETL(cname, 'LOADED) then + clearConstructorCaches() + if $forceDatabaseUpdate or not systemdir? then + clearClams() + clearAllSlams [] + +removeCoreModemaps(modemapList,c) == + newUserModemaps:= nil + c := opOf unabbrev c + for [op,mmList] in modemapList repeat + temp:= nil + for mm in mmList repeat + cname := getDomainFromMm mm + if cname ^= c then temp:= [:temp,mm] + if temp then newUserModemaps:= [:newUserModemaps,[op,temp]] + newUserModemaps + +addCoreModemap(modemapList,op,modemap,cname) == + entry:= ASSQ(op,modemapList) => + RPLAC(CADR entry,[modemap,:CADR entry]) + modemapList + modeMapList:= [:modemapList,[op,[ modemap]]] + +REMOVER(lst,item) == + --destructively removes item from lst + not PAIRP lst => + lst=item => nil + lst + first lst=item => rest lst + RPLNODE(lst,REMOVER(first lst,item),REMOVER(rest lst,item)) + +allLASSOCs(op,alist) == + [value for [key,:value] in alist | key = op] + +loadDependents fn == + isExistingFile [fn,$spadLibFT,"*"] => + MEMQ("dependents",RKEYIDS(fn,$spadLibFT)) => + stream:= readLib1(fn,$spadLibFT,"*") + l:= rread('dependents,stream,nil) + RSHUT stream + for x in l repeat + x='SubDomain => nil + loadIfNecessary x + +--% Miscellaneous Stuff + +getOplistForConstructorForm (form := [op,:argl]) == + -- The new form is an op-Alist which has entries (<op> . signature-Alist) + -- where signature-Alist has entries (<signature> . item) + -- where item has form (<slotNumber> <condition> <kind>) + -- where <kind> = ELT | CONST | Subsumed | (XLAM..) .. + pairlis:= [[fv,:arg] for fv in $FormalMapVariableList for arg in argl] + opAlist := getOperationAlistFromLisplib op + [:getOplistWithUniqueSignatures(op,pairlis,signatureAlist) + for [op,:signatureAlist] in opAlist] + +getOplistWithUniqueSignatures(op,pairlis,signatureAlist) == + alist:= nil + for [sig,:[slotNumber,pred,kind]] in signatureAlist | kind ^= 'Subsumed repeat + alist:= insertAlist(SUBLIS(pairlis,[op,sig]), + SUBLIS(pairlis,[pred,[kind,nil,slotNumber]]), + alist) + alist + +--% Code For Modemap Insertion + +insertModemap(new,mmList) == + null mmList => [new] +--isMoreSpecific(new,old:= first mmList) => [new,:mmList] +--[old,:insertModemap(new,rest mmList)] + [new,:mmList] + +--% Exposure Group Code + +dropPrefix(fn) == + member(fn.0,[char "?",char "-",char "+"]) => SUBSTRING(fn,1,nil) + fn + +--moved to util.lisp +--++loadExposureGroupData() == +--++ egFile := ['INTERP,'EXPOSED] +--++-- null MAKE_-INPUT_-FILENAME(egFile) => +--++-- throwKeyedMsg("S2IL0003",[namestring egFile]) +--++ stream:= DEFIOSTREAM(['(MODE . INPUT),['FILE,:egFile]],80,0) +--++ $globalExposureGroupAlist := NIL +--++ egName := NIL +--++ egFiles := NIL +--++ while (not PLACEP (x:= READ_-LINE stream)) repeat +--++ x := DROPTRAILINGBLANKS x +--++ SIZE(x) = 0 => 'iterate -- blank line +--++ (x.0 = char "#") or (x.0 = char "*") => 'iterate -- comment +--++ x.0 = char " " => +--++ -- possible exposure group member name and library name +--++ null egName => +--++ throwKeyedMsg("S2IZ0069A",[namestring egFile,x]) +--++ x := dropLeadingBlanks x +--++ -- should be two tokens on the line +--++ p := STRPOS('" ",x,1,NIL) +--++ NULL p => +--++ throwKeyedMsg("S2IZ0069B",[namestring egFile,x]) +--++ n := object2Identifier SUBSTRING(x,0,p) +--++ x := dropLeadingBlanks SUBSTRING(x,p+1,NIL) +--++ SIZE(x) = 0 => +--++ throwKeyedMsg("S2IZ0069B",[namestring egFile,x]) +--++ egFiles := [[n,:object2Identifier x],:egFiles] +--++ -- have a new group name +--++ if egName then $globalExposureGroupAlist := +--++ [[egName,:nreverse egFiles],:$globalExposureGroupAlist] +--++ egFiles := NIL +--++ STRPOS('" ",x,1,NIL) => +--++ throwKeyedMsg("S2IZ0069C",[namestring egFile,x]) +--++ egName := object2Identifier x +--++ if egFiles then $globalExposureGroupAlist := +--++ [[egName,:nreverse egFiles],:$globalExposureGroupAlist] +--++ SHUT stream +--++ $globalExposureGroupAlist := nreverse $globalExposureGroupAlist +--++ 'done + +isExposedConstructor name == + -- this function checks the local exposure data in the frame to + -- see if the given constructor is exposed. The format of + -- $localExposureData is a vector with + -- slot 0: list of groups exposed in the frame + -- slot 1: list of constructors explicitly exposed + -- slot 2: list of constructors explicitly hidden + -- check if it is explicitly hidden + MEMQ(name,'(Union Record Mapping)) => true + MEMQ(name,$localExposureData.2) => false + -- check if it is explicitly exposed + MEMQ(name,$localExposureData.1) => true + -- check if it is in an exposed group + found := NIL + for g in $localExposureData.0 while not found repeat + null (x := GETALIST($globalExposureGroupAlist,g)) => 'iterate + if GETALIST(x,name) then found := true + found + +displayExposedGroups() == + sayKeyedMsg("S2IZ0049A",[$interpreterFrameName]) + if null $localExposureData.0 + then centerAndHighlight '"there are no exposed groups" + else for g in $localExposureData.0 repeat + centerAndHighlight g + +displayExposedConstructors() == + sayKeyedMsg("S2IZ0049B",NIL) + if null $localExposureData.1 + then centerAndHighlight + '"there are no explicitly exposed constructors" + else for c in $localExposureData.1 repeat + centerAndHighlight c + +displayHiddenConstructors() == + sayKeyedMsg("S2IZ0049C",NIL) + if null $localExposureData.2 + then centerAndHighlight + '"there are no explicitly hidden constructors" + else for c in $localExposureData.2 repeat + centerAndHighlight c + + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document} |