aboutsummaryrefslogtreecommitdiff
path: root/src/interp/package.boot.pamphlet
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/package.boot.pamphlet')
-rw-r--r--src/interp/package.boot.pamphlet300
1 files changed, 0 insertions, 300 deletions
diff --git a/src/interp/package.boot.pamphlet b/src/interp/package.boot.pamphlet
deleted file mode 100644
index f97f86ac..00000000
--- a/src/interp/package.boot.pamphlet
+++ /dev/null
@@ -1,300 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/interp/package.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"
-
-isPackageFunction() ==
- -- called by compile/putInLocalDomainReferences
---+
- nil
-
-processFunctorOrPackage(form,signature,data,localParList,m,e) ==
---+
- processFunctor(form,signature,data,localParList,e)
-
-processPackage($definition is [name,:args],[$catsig,:argssig],code,locals,$e) ==
- $GENNO: local:= 0 --for GENVAR()
- $catsig: local
- --used in ProcessCond
- $maximalViews: local
- --read by ProcessCond
- $ResetItems: local
- --stores those items that get SETQed, and may need re-processing
- $catvecList: local:= [$domainShell]
- $catNames: local:= ["$"]
---PRINT $definition
---PRINT ($catsig,:argssig)
---PRETTYPRINT code
- catvec:= $domainShell --from compDefineFunctor
- $getDomainCode:= optFunctorBody $getDomainCode
- --the purpose of this is so ProcessCond recognises such items
- code:= PackageDescendCode(code,true,nil)
- if delete(nil,locals) then code:=[:code,:(setPackageCode locals)] where
- setPackageCode locals ==
- locals':=[[u,:i] for u in locals for i in 0.. | u]
- locals'' :=[]
- while locals' repeat
- for v in locals' repeat
- [u,:i]:=v
- if and/[EQ(v,v') or not subTree(u,CAR v') for v' in locals']
- then
- locals'':=[v,:locals'']
- locals':=delete(v,locals')
- precomp:=code:=[]
- for elem in locals'' repeat
- [u,:i]:=elem
- if ATOM u then u':=u
- else
- u':=opt(u,precomp) where
- opt(u,alist) ==
- ATOM u => u
- for v in u repeat
- if (a:=ASSOC(v,alist)) then
- [.,:i]:=a
- u:=replace(v,[($QuickCode=>'QREFELT;'ELT),"$",i],u) where
- replace(old,new,l) ==
- l isnt [h,:t] => l
- h = old => [new,:t]
- [h,:replace(old,new,t)]
- v':=opt(v,alist)
- EQ(v,v') => nil
- u:=replace(v,v',u)
- u
- precomp:=[elem,:precomp]
- code:=[[($QuickCode=>'QSETREFV;'SETELT),"$",i,u'],:code]
- nreverse code
- code:=
- ["PROGN",:$getDomainCode,["LET","$",["GETREFV",#locals]],
- --It is important to place this code here,
- --after $ is set up
- --slam functor with shell
- --the order of steps in this PROGN are critical
- addToSlam($definition,"$"),code,[
- "SETELT","$",0, mkDomainConstructor $definition],:
--- If we call addMutableArg this early, then recurise calls to this domain
--- (e.g. while testing predicates) will generate new domains => trouble
--- "SETELT","$",0,addMutableArg mkDomainConstructor $definition],:
- [["SETELT","$",position(name,locals),name]
- for name in $ResetItems | MEMQ(name,locals)],
- :[($mutableDomain => '(RPLACD (LASTNODE (ELT $ 0))
- (LIST (GENSYM)));[]) ],
- "$"]
- for u in $getDomainCode repeat
- u is ['LET,.,u'] and u' is ['getDomainView,.,u''] =>
- $packagesUsed:=union(CategoriesFromGDC u'',$packagesUsed)
- $packagesUsed:=union($functorLocalParameters,$packagesUsed)
- $getDomainCode:= nil
- --if we didn't kill this, DEFINE would insert it in the wrong place
- optFunctorBody code
-
-subTree(u,v) ==
- v=u => true
- ATOM v => nil
- or/[subTree(u,v') for v' in v]
-
-mkList u ==
- u => ["LIST",:u]
- nil
-
-setPackageLocals(pac,locs) ==
- for var in locs for i in 0.. | var^=nil repeat pac.i:= var
-
-PackageDescendCode(code,flag,viewAssoc) ==
- --flag is true if we are walking down code always executed
- --nil if we are in conditional code
- code=nil => nil
- code="noBranch" => nil
- code is ["add",base,:codelist] =>
- systemError '"packages may not have add clauses"
- code is ["PROGN",:codelist] =>
- ["PROGN",:
- [v for u in codelist | (v:= PackageDescendCode(u,flag,viewAssoc))^=nil]]
- code is ["COND",:condlist] =>
- c:=
- ["COND",:
- [[u2:= ProcessCond(first u,viewAssoc),:
- (if null u2
- then nil
- else
- [PackageDescendCode(v,flag and TruthP u2,
- if first u is ["HasCategory",dom,cat]
- then [[dom,:cat],:viewAssoc]
- else viewAssoc) for v in rest u])] for u in condlist]]
- TruthP CAADR c => ["PROGN",:CDADR c]
- c
- code is ["LET",name,body,:.] =>
- if not MEMQ(name,$ResetItems) then $ResetItems:= [name,:$ResetItems]
- if body is [a,:.] and isFunctor a
- then $packagesUsed:=[body,:$packagesUsed]
- code
- code is ["CodeDefine",sig,implem] =>
- --Generated by doIt in COMPILER BOOT
- dom:= "$"
- dom:=
- u:= LASSOC(dom,viewAssoc) => ["getDomainView",dom,u]
- dom
- body:= ["CONS",implem,dom]
- SetFunctionSlots(sig,body,flag,"original")
- code is [":",:.] => (RPLACA(code,"LIST"); RPLACD(code,NIL))
- --Yes, I know that's a hack, but how else do you kill a line?
- code is ["LIST",:.] => nil
- code is ["MDEF",:.] => nil
- code is ["devaluate",:.] => nil
- code is ["call",:.] => code
- code is ["SETELT",:.] => code
- code is ["QSETREFV",:.] => code
- stackWarning ["unknown Package code ",code]
- code
-
-mkOperatorEntry(domainOrPackage,opSig is [op,sig,:flag],pred,count) ==
- domainOrPackage^="domain" =>
- [opSig,pred,["PAC","$",name]] where
- name() == encodeFunctionName(op,domainOrPackage,sig,":",count)
- null flag => [opSig,pred,["ELT","$",count]]
- first flag="constant" => [[op,sig],pred,["CONST","$",count]]
- systemError ["unknown variable mode: ",flag]
-
-optPackageCall(x,["PAC",packageVariableOrForm,functionName],arglist) ==
- RPLACA(x,functionName)
- RPLACD(x,[:arglist,packageVariableOrForm])
- x
-
---% Code for encoding function names inside package or domain
-
-encodeFunctionName(fun,package is [packageName,:arglist],signature,sep,count)
- ==
- signature':= substitute("$",package,signature)
- reducedSig:= mkRepititionAssoc [:rest signature',first signature']
- encodedSig:=
- ("STRCONC"/[encodedPair for [n,:x] in reducedSig]) where
- encodedPair() ==
- n=1 => encodeItem x
- STRCONC(STRINGIMAGE n,encodeItem x)
- encodedName:= INTERNL(getAbbreviation(packageName,#arglist),";",
- encodeItem fun,";",encodedSig, sep,STRINGIMAGE count)
- if $LISPLIB then
- $lisplibSignatureAlist:=
- [[encodedName,:signature'],:$lisplibSignatureAlist]
- encodedName
-
-splitEncodedFunctionName(encodedName, sep) ==
- -- [encodedPackage, encodedItem, encodedSig, sequenceNo] or NIL
- -- sep0 is the separator used in "encodeFunctionName".
- sep0 := '";"
- if not STRINGP encodedName then
- encodedName := STRINGIMAGE encodedName
- null (p1 := STRPOS(sep0, encodedName, 0, '"*")) => nil
- null (p2 := STRPOS(sep0, encodedName, p1+1, '"*")) => 'inner
--- This is picked up in compile for inner functions in partial compilation
- null (p3 := STRPOS(sep, encodedName, p2+1, '"*")) => nil
- s1 := SUBSTRING(encodedName, 0, p1)
- s2 := SUBSTRING(encodedName, p1+1, p2-p1-1)
- s3 := SUBSTRING(encodedName, p2+1, p3-p2-1)
- s4 := SUBSTRING(encodedName, p3+1, nil)
- [s1, s2, s3, s4]
-
-mkRepititionAssoc l ==
- mkRepfun(l,1) where
- mkRepfun(l,n) ==
- null l => nil
- l is [x] => [[n,:x]]
- l is [x, =x,:l'] => mkRepfun(rest l,n+1)
- [[n,:first l],:mkRepfun(rest l,1)]
-
-encodeItem x ==
- x is [op,:argl] => getCaps op
- IDENTP x => PNAME x
- STRINGIMAGE x
-
-getCaps x ==
- s:= STRINGIMAGE x
- clist:= [c for i in 0..MAXINDEX s | UPPER_-CASE_-P (c:= s.i)]
- null clist => '"__"
- "STRCONC"/[first clist,:[L_-CASE u for u in rest clist]]
-
---% abbreviation code
-
-getAbbreviation(name,c) ==
- --returns abbreviation of name with c arguments
- x := constructor? name
- X := ASSQ(x,$abbreviationTable) =>
- N:= ASSQ(name,rest X) =>
- C:= ASSQ(c,rest N) => rest C --already there
- newAbbreviation:= mkAbbrev(X,x)
- RPLAC(rest N,[[c,:newAbbreviation],:rest N])
- newAbbreviation
- newAbbreviation:= mkAbbrev(X,x)
- RPLAC(rest X,[[name,[c,:newAbbreviation]],:rest X])
- newAbbreviation
- $abbreviationTable:= [[x,[name,[c,:x]]],:$abbreviationTable]
- x
-
-mkAbbrev(X,x) == addSuffix(alistSize rest X,x)
-
-alistSize c ==
- count(c,1) where
- count(x,level) ==
- level=2 => #x
- null x => 0
- count(CDAR x,level+1)+count(rest x,level)
-
-addSuffix(n,u) ==
- ALPHA_-CHAR_-P (s:= STRINGIMAGE u).(MAXINDEX s) => INTERN STRCONC(s,STRINGIMAGE n)
- INTERNL STRCONC(s,STRINGIMAGE ";",STRINGIMAGE n)
-
-
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}