Initial population.

1 files changed, 354 insertions, 0 deletions

diff --git a/src/interp/xruncomp.boot.pamphlet b/src/interp/xruncomp.boot.pamphlet
new file mode 100644
index 00000000..3d8c2c55
--- /dev/null
+++ b/src/interp/xruncomp.boot.pamphlet
@@ -0,0 +1,354 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/xruncomp.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>>
+
+------- from info.boot -----------
+
+-- modemap is of the form : ((op (targ arg1 arg2 ... argn)) pred (elt $ n))
+
+--------------------> NEW DEFINITION (see modemap.boot.pamphlet)
+evalAndSub(domainName,viewName,functorForm,form,$e) ==
+  $lhsOfColon: local:= domainName
+  isCategory form => [substNames(domainName,viewName,functorForm,form.(1)),$e]
+  --next lines necessary-- see MPOLY for which $ is actual arg. --- RDJ 3/83
+  if CONTAINED("$$",form) then $e:= put("$$","mode",get("$","mode",$e),$e)
+  opAlist:= getOperationAlist(domainName,functorForm,form)
+  substAlist:= substNames(domainName,viewName,functorForm,opAlist)
+  [substAlist,$e]
+
+--------------------> NEW DEFINITION (see modemap.boot.pamphlet)
+substNames(domainName,viewName,functorForm,opalist) ==
+  functorForm := SUBSTQ("$$","$", functorForm)
+  nameForDollar :=
+    isCategoryPackageName functorForm => CADR functorForm
+    domainName
+    
+       -- following calls to SUBSTQ must copy to save RPLAC's in
+       -- putInLocalDomainReferences
+  [[:SUBSTQ("$","$$",SUBSTQ(nameForDollar,"$",modemapform)),
+       [sel, viewName,if domainName = "$" then pos else
+                                         CADAR modemapform]]
+     for [:modemapform,[sel,"$",pos]] in
+          EQSUBSTLIST(KDR functorForm,$FormalMapVariableList, opalist)]
+
+--------------------> NEW DEFINITION (see modemap.boot.pamphlet)
+addModemap1(op,mc,sig,pred,fn,e) ==
+   --mc is the "mode of computation"; fn the "implementation"
+  if mc='Rep then
+--     if fn is [kind,'Rep,.] and
+               -- save old sig for NRUNTIME
+--       (kind = 'ELT or kind = 'CONST) then fn:=[kind,'Rep,sig]
+     sig:= substitute("$",'Rep,sig)
+  currentProplist:= getProplist(op,e) or nil
+  newModemapList:=
+    mkNewModemapList(mc,sig,pred,fn,LASSOC('modemap,currentProplist),e,nil)
+  newProplist:= augProplist(currentProplist,'modemap,newModemapList)
+  newProplist':= augProplist(newProplist,"FLUID",true)
+  unErrorRef op
+        --There may have been a warning about op having no value
+  addBinding(op,newProplist',e)
+
+--------------------> NEW DEFINITION (see modemap.boot.pamphlet)
+addConstructorModemaps(name,form is [functorName,:.],e) ==
+  $InteractiveMode: local:= nil
+  e:= putDomainsInScope(name,e) --frame
+  fn := GETL(functorName,"makeFunctionList")
+  [funList,e]:= FUNCALL(fn,name,form,e)
+  for [op,sig,opcode] in funList repeat
+    if opcode is [sel,dc,n] and sel='ELT then
+          nsig := substitute("$$$",name,sig)
+          nsig := substitute('$,"$$$",substitute("$$",'$,nsig))
+          opcode := [sel,dc,nsig]
+    e:= addModemap(op,name,sig,true,opcode,e)
+  e
+
+------- from info.boot -----------
+
+--------------------> NEW DEFINITION (see info.boot.pamphlet)
+actOnInfo(u,$e) ==
+  null u => $e
+  u is ["PROGN",:l] => (for v in l repeat $e:= actOnInfo(v,$e); $e)
+  $e:=
+    put("$Information","special",Info:= [u,:get("$Information","special",$e)],$e
+      )
+  u is ["COND",:l] =>
+      --there is nowhere %else that this sort of thing exists
+    for [ante,:conseq] in l repeat
+      if member(hasToInfo ante,Info) then for v in conseq repeat
+        $e:= actOnInfo(v,$e)
+    $e
+  u is ["ATTRIBUTE",name,att] =>
+    [vval,vmode,venv]:= GetValue name
+    SAY("augmenting ",name,": ",u)
+    key:= if CONTAINED("$",vmode) then "domain" else name
+    cat:= ["CATEGORY",key,["ATTRIBUTE",att]]
+    $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
+      --there is nowhere %else that this sort of thing exists
+  u is ["SIGNATURE",name,operator,modemap] =>
+    implem:=
+      (implem:=ASSOC([name,:modemap],get(operator,'modemap,$e))) =>
+          CADADR implem
+      name = "$" => ['ELT,name,-1]
+      ['ELT,name,substitute('$,name,modemap)]
+    $e:= addModemap(operator,name,modemap,true,implem,$e)
+    [vval,vmode,venv]:= GetValue name
+    SAY("augmenting ",name,": ",u)
+    key:= if CONTAINED("$",vmode) then "domain" else name
+    cat:= ["CATEGORY",key,["SIGNATURE",operator,modemap]]
+    $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
+  u is ["has",name,cat] =>
+    [vval,vmode,venv]:= GetValue name
+    cat=vmode => $e --stating the already known
+    u:= compMakeCategoryObject(cat,$e) =>
+         --we are adding information about a category
+      [catvec,.,$e]:= u
+      [ocatvec,.,$e]:= compMakeCategoryObject(vmode,$e)
+      -- member(vmode,CAR catvec.4) =>
+      --    JHD 82/08/08 01:40 This does not mean that we can ignore the
+      --    extension, since this may not be compatible with the view we
+      --    were passed
+ 
+      --we are adding a principal descendant of what was already known
+      --    $e:= augModemapsFromCategory(name,name,nil,catvec,$e)
+      --    SAY("augmenting ",name,": ",cat)
+      --    put(name, "value", (vval, cat, venv), $e)
+      member(cat,first ocatvec.4) or
+         ASSOC(cat,CADR ocatvec.4) is [.,'T,.] => $e
+        --SAY("Category extension error:
+        --cat shouldn't be a join
+                      --what was being asserted is an ancestor of what was known
+      if name="$"
+        then $e:= augModemapsFromCategory(name,name,name,cat,$e)
+        else
+          viewName:=genDomainViewName(name,cat)
+          genDomainView(viewName,name,cat,"HasCategory")
+          if not MEMQ(viewName,$functorLocalParameters) then
+             $functorLocalParameters:=[:$functorLocalParameters,viewName]
+      SAY("augmenting ",name,": ",cat)
+      $e:= put(name,"value",[vval,mkJoin(cat,vmode),venv],$e)
+    SAY("extension of ",vval," to ",cat," ignored")
+    $e
+  systemError '"knownInfo"
+
+------- from nruncomp.boot -----------
+
+--------------------> NEW DEFINITION (see nruncomp.boot.pamphlet)
+genDeltaEntry opMmPair ==
+--called from compApplyModemap
+--$NRTdeltaLength=0.. always equals length of $NRTdeltaList
+  [.,[odc,:.],.] := opMmPair
+  --opModemapPair := SUBLIS($LocalDomainAlist,opMmPair)
+  [op,[dc,:sig],[.,cform:=[eltOrConst,.,nsig]]] := opMmPair
+  if $profileCompiler = true then profileRecord(dc,op,sig)
+  eltOrConst = 'XLAM => cform
+  if eltOrConst = 'Subsumed then eltOrConst := 'ELT
+  if atom dc then
+    dc = "$" => nsig := sig
+    if NUMBERP nsig then nsig := substitute('$,dc,substitute("$$","$",sig))
+    -- following hack needed to invert Rep to $ substitution
+--  if odc = 'Rep and cform is [.,.,osig] then sig:=osig
+  newimp := optDeltaEntry(op,nsig,dc,eltOrConst) => newimp
+  setDifference(listOfBoundVars dc,$functorLocalParameters) ^= [] =>
+    ['applyFun,['compiledLookupCheck,MKQ op,
+         mkList consSig(nsig,dc),consDomainForm(dc,nil)]]
+  odc := dc
+  if null atom dc then dc := substitute("$$",'$,dc)
+ --   sig := substitute('$,dc,sig)
+ --   cform := substitute('$,dc,cform)
+  opModemapPair :=
+    [op,[dc,:[genDeltaSig x for x in nsig]],['T,cform]] -- force pred to T
+  if null NRTassocIndex dc and dc ^= $NRTaddForm and
+    (member(dc,$functorLocalParameters) or null atom dc) then
+    --create "domain" entry to $NRTdeltaList
+      $NRTdeltaList:= [['domain,NRTaddInner dc,:dc],:$NRTdeltaList]
+      saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+      $NRTdeltaLength := $NRTdeltaLength+1
+      compEntry:= compOrCroak(odc,$EmptyMode,$e).expr
+--      dc
+      RPLACA(saveNRTdeltaListComp,compEntry)
+  u :=
+    [eltOrConst,'$,$NRTbase+$NRTdeltaLength-index] where index ==
+      (n:= POSN1(opModemapPair,$NRTdeltaList)) => n + 1
+        --n + 1 since $NRTdeltaLength is 1 too large
+      $NRTdeltaList:= [opModemapPair,:$NRTdeltaList]
+      $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+      $NRTdeltaLength := $NRTdeltaLength+1
+      0
+  u
+
+--------------------> NEW DEFINITION (see nruncomp.boot.pamphlet)
+NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) ==
+  --converts a domain form to a lazy domain form; everything other than 
+  --the operation name should be assigned a slot
+  null firstTime and (k:= NRTassocIndex x) => k
+  VECP x => systemErrorHere '"NRTencode"
+  PAIRP x =>
+    QCAR x='Record or x is ['Union,['_:,a,b],:.] =>
+      [QCAR x,:[['_:,a,encode(b,c,false)]
+        for [.,a,b] in QCDR x for [.,=a,c] in CDR compForm]]
+    constructor? QCAR x or MEMQ(QCAR x,'(Union Mapping)) =>
+      [QCAR x,:[encode(y,z,false) for y in QCDR x for z in CDR compForm]]
+    ['NRTEVAL,NRTreplaceAllLocalReferences COPY_-TREE lispize compForm]
+  MEMQ(x,$formalArgList) =>
+    v := $FormalMapVariableList.(POSN1(x,$formalArgList))
+    firstTime => ['local,v]
+    v
+  x = '$ => x
+  x = "$$" => x
+  ['QUOTE,x]
+
+--------------------> NEW DEFINITION (see nruncomp.boot.pamphlet)
+consDomainName(x,dc) ==
+  x = dc => ''$
+  x = '$ => ''$
+  x = "$$" => ['devaluate,'$]
+  x is [op,:argl] =>
+    (op = 'Record) or (op = 'Union and argl is [[":",:.],:.])  =>
+       mkList [MKQ op,
+         :[['LIST,MKQ '_:,MKQ tag,consDomainName(dom,dc)]
+                   for [.,tag,dom] in argl]]
+    isFunctor op or op = 'Mapping or constructor? op =>
+         -- call to constructor? needed if op was compiled in $bootStrapMode
+        mkList [MKQ op,:[consDomainName(y,dc) for y in argl]]
+    substitute('$,"$$",x)
+  x = [] => x
+  (y := LASSOC(x,$devaluateList)) => y
+  k:=NRTassocIndex x =>
+    ['devaluate,['ELT,'$,k]]
+  get(x,'value,$e) =>
+    isDomainForm(x,$e) => ['devaluate,x]
+    x
+  MKQ x
+
+--------------------> NEW DEFINITION (see nruncomp.boot.pamphlet)
+NRTassignCapsuleFunctionSlot(op,sig) ==
+--called from compDefineCapsuleFunction
+  opSig := [op,sig]
+  [.,.,implementation] := NRTisExported? opSig or return nil
+    --if opSig is not exported, it is local and need not be assigned
+  if $insideCategoryPackageIfTrue then
+      sig := substitute('$,CADR($functorForm),sig)
+  sig := [genDeltaSig x for x in sig]
+  opModemapPair := [op,['_$,:sig],['T,implementation]]
+  POSN1(opModemapPair,$NRTdeltaList) => nil   --already there
+  $NRTdeltaList:= [opModemapPair,:$NRTdeltaList]
+  $NRTdeltaListComp := [nil,:$NRTdeltaListComp]
+  $NRTdeltaLength := $NRTdeltaLength+1
+
+--------------------> NEW DEFINITION (see nruncomp.boot.pamphlet)
+changeDirectoryInSlot1() ==  --called by NRTbuildFunctor
+  --3 cases:
+  --  if called inside NRTbuildFunctor, $NRTdeltaLength gives different locs
+  --  otherwise called from compFunctorBody (all lookups are forwarded):
+  --    $NRTdeltaList = nil  ===> all slot numbers become nil
+  $lisplibOperationAlist := [sigloc entry for entry in $domainShell.1] where
+    sigloc [opsig,pred,fnsel] ==
+        if pred ^= 'T then
+          pred := simpBool pred
+          $NRTslot1PredicateList := insert(pred,$NRTslot1PredicateList)
+        fnsel is [op,a,:.] and (op = 'ELT or op = 'CONST) =>
+          if $insideCategoryPackageIfTrue then
+              opsig := substitute('$,CADR($functorForm),opsig)
+          [opsig,pred,[op,a,vectorLocation(first opsig,CADR opsig)]]
+        [opsig,pred,fnsel]
+  sortedOplist := listSort(function GLESSEQP,
+                           COPY_-LIST $lisplibOperationAlist,function CADR)
+  $lastPred :local := nil
+  $newEnv :local := $e
+  $domainShell.1 := [fn entry for entry in sortedOplist] where
+    fn [[op,sig],pred,fnsel] ==
+       if $lastPred ^= pred then
+            $newEnv := deepChaseInferences(pred,$e)
+            $lastPred := pred
+       newfnsel :=
+         fnsel is ['Subsumed,op1,sig1] =>
+           ['Subsumed,op1,genSlotSig(sig1,'T,$newEnv)]
+         fnsel
+       [[op, genSlotSig(sig,pred,$newEnv)] ,pred,newfnsel]
+
+------- from compiler.boot -----------
+
+--------------------> NEW DEFINITION (see compiler.boot.pamphlet)
+getFormModemaps(form is [op,:argl],e) ==
+  op is ["elt",domain,op1] =>
+    [x for x in getFormModemaps([op1,:argl],e) | x is [[ =domain,:.],:.]]
+  null atom op => nil
+  modemapList:= get(op,"modemap",e)
+  if $insideCategoryPackageIfTrue then
+    modemapList := [x for x in modemapList | x is [[dom,:.],:.] and dom ^= '$]
+  if op="elt"
+     then modemapList:= eltModemapFilter(LAST argl,modemapList,e) or return nil
+     else
+      if op="setelt" then modemapList:=
+        seteltModemapFilter(CADR argl,modemapList,e) or return nil
+  nargs:= #argl
+  finalModemapList:= [mm for (mm:= [[.,.,:sig],:.]) in modemapList | #sig=nargs]
+  modemapList and null finalModemapList =>
+    stackMessage ["no modemap for","%b",op,"%d","with ",nargs," arguments"]
+  finalModemapList
+
+------- from functor.boot -----------
+
+--------------------> NEW DEFINITION (see functor.boot.pamphlet)
+LookUpSigSlots(sig,siglist) ==
+--+ must kill any implementations below of the form (ELT $ NIL)
+  if $insideCategoryPackageIfTrue then
+           sig := substitute('$,CADR($functorForm),sig)
+  siglist := $lisplibOperationAlist
+  REMDUP [implem for u in siglist | SigSlotsMatch(sig,first u,implem:=CADDR u)
+              and KADDR implem]
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}