remove pamphlets - part 7

1 files changed, 0 insertions, 692 deletions

diff --git a/src/interp/nrunfast.boot.pamphlet b/src/interp/nrunfast.boot.pamphlet
deleted file mode 100644
index e6a29b12..00000000
--- a/src/interp/nrunfast.boot.pamphlet
+++ /dev/null
@@ -1,692 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp nrunfast.boot}
-\author{The Axiom Team}
-\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>>
-
---=======================================================================
---                     Basic Functions
---=======================================================================
-initNewWorld() ==
-  $NRTflag := true
-  $NRTvec := true
-  $NRTmakeCompactDirect := true
-  $NRTquick := true
-  $NRTmakeShortDirect := true
-  $newWorld := true
-  $monitorNewWorld := false
-  $consistencyCheck := false
-  $spadLibFT := 'NRLIB
-  $NRTmonitorIfTrue := false
-  $updateCatTableIfTrue := false
-  $doNotCompressHashTableIfTrue := true
- 
-isNewWorldDomain domain == INTEGERP domain.3    --see HasCategory/Attribute
- 
-getDomainByteVector dom == CDDR dom.4
- 
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
-getOpCode(op,vec,max) ==
---search Op vector for "op" returning code if found, nil otherwise
-  res := nil
-  for i in 0..max by 2 repeat
-    EQ(QVELT(vec,i),op) => return (res := QSADD1 i)
-  res
- 
---=======================================================
---                 Lookup From Compiled Code
---=======================================================
-newGoGet(:l) ==
-  [:arglist,env] := l
-  slot := replaceGoGetSlot env
-  APPLY(first slot,[:arglist,rest slot])  --SPADCALL it!
- 
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
---------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
-replaceGoGetSlot env ==
-  [thisDomain,index,:op] := env
-  thisDomainForm := devaluate thisDomain
-  bytevec := getDomainByteVector thisDomain
-  numOfArgs := bytevec.index
-  goGetDomainSlotIndex := bytevec.(index := QSADD1 index)
-  goGetDomain :=
-     goGetDomainSlotIndex = 0 => thisDomain
-     thisDomain.goGetDomainSlotIndex
-  if PAIRP goGetDomain then
-     goGetDomain := lazyDomainSet(goGetDomain,thisDomain,goGetDomainSlotIndex)
-  sig :=
-    [newExpandTypeSlot(bytevec.(index := QSADD1 index),thisDomain,thisDomain)
-      for i in 0..numOfArgs]
-  thisSlot := bytevec.(QSADD1 index)
-  if $monitorNewWorld then
-    sayLooking(concat('"%l","..",form2String thisDomainForm,
-      '" wants",'"%l",'"  "),op,sig,goGetDomain)
-  slot :=  .basicLookup(op,sig,goGetDomain,goGetDomain)
-  slot = nil =>
-    $returnNowhereFromGoGet = true =>
-      ['nowhere,:goGetDomain]  --see newGetDomainOpTable
-    sayBrightly concat('"Function: ",formatOpSignature(op,sig),
-      '" is missing from domain: ",form2String goGetDomain.0)
-    keyedSystemError("S2NR0001",[op,sig,goGetDomain.0])
-  if $monitorNewWorld then
-    sayLooking1(['"goget stuffing slot",:bright thisSlot,'"of "],thisDomain)
-  SETELT(thisDomain,thisSlot,slot)
-  if $monitorNewWorld then
-    sayLooking1('"<------",[CAR slot,:devaluate CDR slot])
-  slot
- 
---=======================================================
---       Lookup Function in Slot 1 (via SPADCALL)
---=======================================================
-lookupFF(op,sig,dollar,env) == newLookupInTable(op,sig,dollar,env,nil)
- 
-lookupUF(op,sig,dollar,env) == newLookupInTable(op,sig,dollar,env,true)
- 
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
-lookupComplete(op,sig,dollar,env) == newLookupInTable(op,sig,dollar,env,nil)
- 
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
-lookupIncomplete(op,sig,dollar,env) == newLookupInTable(op,sig,dollar,env,true)
- 
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
-lookupInCompactTable(op,sig,dollar,env) ==
-  newLookupInTable(op,sig,dollar,env,true)
- 
-newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
-  dollar = nil => systemError()
-  $lookupDefaults = true =>
-    newLookupInCategories(op,sig,domain,dollar)      --lookup first in my cats
-      or newLookupInAddChain(op,sig,domain,dollar)
-  --fast path when called from newGoGet
-  success := false
-  if $monitorNewWorld then
-    sayLooking(concat('"---->",form2String devaluate domain,
-      '"----> searching op table for:","%l","  "),op,sig,dollar)
-  someMatch := false
-  numvec := getDomainByteVector domain
-  predvec := domain.3
-  max := MAXINDEX opvec
-  k := getOpCode(op,opvec,max) or return
-    flag => newLookupInAddChain(op,sig,domain,dollar)
-    nil
-  maxIndex := MAXINDEX numvec
-  start := ELT(opvec,k)
-  finish :=
-    QSGREATERP(max,k) => opvec.(QSPLUS(k,2))
-    maxIndex
-  if QSGREATERP(finish,maxIndex) then systemError '"limit too large"
-  numArgs := QSDIFFERENCE(#sig,1)
-  success := nil
-  $isDefaultingPackage: local :=
-    -- use special defaulting handler when dollar non-trivial
-    dollar ^= domain and isDefaultPackageForm? devaluate domain
-  while finish > start repeat
-    PROGN
-      i := start
-      numArgs ^= (numTableArgs :=numvec.i) => nil
-      predIndex := numvec.(i := QSADD1 i)
-      NE(predIndex,0) and null testBitVector(predvec,predIndex) => nil
-      loc := newCompareSig(sig,numvec,(i := QSADD1 i),dollar,domain)
-      null loc => nil  --signifies no match
-      loc = 1 => (someMatch := true)
-      loc = 0 =>
-        start := QSPLUS(start,QSPLUS(numTableArgs,4))
-        i := start + 2
-        someMatch := true --mark so that if subsumption fails, look for original
-        subsumptionSig :=
-          [newExpandTypeSlot(numvec.(QSPLUS(i,j)),
-            dollar,domain) for j in 0..numTableArgs]
-        if $monitorNewWorld then
-          sayBrightly [formatOpSignature(op,sig),'"--?-->",
-            formatOpSignature(op,subsumptionSig)]
-        nil
-      slot := domain.loc
-      null atom slot =>
-        EQ(QCAR slot,'newGoGet) => someMatch:=true
-                   --treat as if operation were not there
-        --if EQ(QCAR slot,'newGoGet) then
-        --  UNWIND_-PROTECT --break infinite recursion
-        --    ((SETELT(domain,loc,'skip); slot := replaceGoGetSlot QCDR slot),
-        --      if domain.loc = 'skip then domain.loc := slot)
-        return (success := slot)
-      slot = 'skip =>       --recursive call from above 'replaceGoGetSlot
-        return (success := newLookupInAddChain(op,sig,domain,dollar))
-      systemError '"unexpected format"
-    start := QSPLUS(start,QSPLUS(numTableArgs,4))
-  NE(success,'failed) and success =>
-    if $monitorNewWorld then
-      sayLooking1('"<----",uu) where uu ==
-        PAIRP success => [first success,:devaluate rest success]
-        success
-    success
-  subsumptionSig and (u:= basicLookup(op,subsumptionSig,domain,dollar)) => u
-  flag or someMatch => newLookupInAddChain(op,sig,domain,dollar)
-  nil
- 
- 
-isDefaultPackageForm? x == x is [op,:.]
-  and IDENTP op and (s := PNAME op).(MAXINDEX s) = "&"
- 
- 
---=======================================================
---       Lookup Addlist (from lookupInDomainTable or lookupInDomain)
---=======================================================
-newLookupInAddChain(op,sig,addFormDomain,dollar) ==
-  if $monitorNewWorld then sayLooking1('"looking up add-chain: ",addFormDomain)
-  addFunction:=newLookupInDomain(op,sig,addFormDomain,dollar,5)
-  addFunction =>
-    if $monitorNewWorld then
-      sayLooking1(concat('"<----add-chain function found for ",
-        form2String devaluate addFormDomain,'"<----"),CDR addFunction)
-    addFunction
-  nil
- 
---=======================================================
---   Lookup In Domain (from lookupInAddChain)
---=======================================================
-newLookupInDomain(op,sig,addFormDomain,dollar,index) ==
-  addFormCell := addFormDomain.index =>
-    INTEGERP KAR addFormCell =>
-      or/[newLookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell]
-    if null VECP addFormCell then lazyDomainSet(addFormCell,addFormDomain,index)
-    lookupInDomainVector(op,sig,addFormDomain.index,dollar)
-  nil
- 
---=======================================================
---       Category Default Lookup (from goGet or lookupInAddChain)
---=======================================================
-newLookupInCategories(op,sig,dom,dollar) ==
-  slot4 := dom.4
-  catVec := CADR slot4
-  SIZE catVec = 0 => nil                      --early exit if no categories
-  INTEGERP KDR catVec.0 =>
-    newLookupInCategories1(op,sig,dom,dollar) --old style
-  $lookupDefaults : local := nil
-  if $monitorNewWorld = true then sayBrightly concat('"----->",
-    form2String devaluate dom,'"-----> searching default packages for ",op)
-  predvec := dom.3
-  packageVec := QCAR slot4
---the next three lines can go away with new category world
-  varList := ['$,:$FormalMapVariableList]
-  valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]]
-  valueList := [MKQ val for val in valueList]
-  nsig := MSUBST(dom.0,dollar.0,sig)
-  for i in 0..MAXINDEX packageVec |
-       (entry := packageVec.i) and entry ^= 'T repeat
-    package :=
-      VECP entry =>
-         if $monitorNewWorld then
-           sayLooking1('"already instantiated cat package",entry)
-         entry
-      IDENTP entry =>
-        cat := catVec.i
-        packageForm := nil
-        if not GETL(entry,'LOADED) then loadLib entry
-        infovec := GETL(entry,'infovec)
-        success :=
-          --VECP infovec =>  ----new world
-          true =>  ----new world
-            opvec := infovec.1
-            max := MAXINDEX opvec
-            code := getOpCode(op,opvec,max)
-            null code => nil
-            byteVector := CDDDR infovec.3
-            endPos :=
-              code+2 > max => SIZE byteVector
-              opvec.(code+2)
-            not nrunNumArgCheck(#(QCDR sig),byteVector,opvec.code,endPos) => nil
-            --numOfArgs := byteVector.(opvec.code)
-            --numOfArgs ^= #(QCDR sig) => nil
-            packageForm := [entry,'$,:CDR cat]
-            package := evalSlotDomain(packageForm,dom)
-            packageVec.i := package
-            package
-                           ----old world
-          table := HGET($Slot1DataBase,entry) or systemError nil
-          (u := LASSQ(op,table))
-            and (v := or/[rest x for x in u | #sig = #x.0]) =>
-              packageForm := [entry,'$,:CDR cat]
-              package := evalSlotDomain(packageForm,dom)
-              packageVec.i := package
-              package
-          nil
-        null success =>
-          if $monitorNewWorld = true then
-            sayBrightlyNT '"  not in: "
-            pp (packageForm and devaluate package or entry)
-          nil
-        if $monitorNewWorld then
-          sayLooking1('"candidate default package instantiated: ",success)
-        success
-      entry
-    null package => nil
-    if $monitorNewWorld then
-      sayLooking1('"Looking at instantiated package ",package)
-    res := basicLookup(op,sig,package,dollar) =>
-      if $monitorNewWorld = true then
-        sayBrightly '"candidate default package succeeds"
-      return res
-    if $monitorNewWorld = true then
-      sayBrightly '"candidate fails -- continuing to search categories"
-    nil
- 
-nrunNumArgCheck(num,bytevec,start,finish) ==
-   args := bytevec.start
-   num = args => true
-   (start := start + args + 4) = finish => nil
-   nrunNumArgCheck(num,bytevec,start,finish)
- 
-newLookupInCategories1(op,sig,dom,dollar) ==
-  $lookupDefaults : local := nil
-  if $monitorNewWorld = true then sayBrightly concat('"----->",
-    form2String devaluate dom,'"-----> searching default packages for ",op)
-  predvec := dom.3
-  slot4 := dom.4
-  packageVec := CAR slot4
-  catVec := CAR QCDR slot4
---the next three lines can go away with new category world
-  varList := ['$,:$FormalMapVariableList]
-  valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]]
-  valueList := [MKQ val for val in valueList]
-  nsig := MSUBST(dom.0,dollar.0,sig)
-  for i in 0..MAXINDEX packageVec | (entry := ELT(packageVec,i))
-      and (VECP entry or (predIndex := CDR (node := ELT(catVec,i))) and
-          (EQ(predIndex,0) or testBitVector(predvec,predIndex))) repeat
-    package :=
-      VECP entry =>
-         if $monitorNewWorld then
-           sayLooking1('"already instantiated cat package",entry)
-         entry
-      IDENTP entry =>
-        cat := QCAR node
-        packageForm := nil
-        if not GETL(entry,'LOADED) then loadLib entry
-        infovec := GETL(entry,'infovec)
-        success :=
-          VECP infovec =>
-            opvec := infovec.1
-            max := MAXINDEX opvec
-            code := getOpCode(op,opvec,max)
-            null code => nil
-            byteVector := CDDR infovec.3
-            numOfArgs := byteVector.(opvec.code)
-            numOfArgs ^= #(QCDR sig) => nil
-            packageForm := [entry,'$,:CDR cat]
-            package := evalSlotDomain(packageForm,dom)
-            packageVec.i := package
-            package
-          table := HGET($Slot1DataBase,entry) or systemError nil
-          (u := LASSQ(op,table))
-            and (v := or/[rest x for x in u | #sig = #x.0]) =>
-              packageForm := [entry,'$,:CDR cat]
-              package := evalSlotDomain(packageForm,dom)
-              packageVec.i := package
-              package
-          nil
-        null success =>
-          if $monitorNewWorld = true then
-            sayBrightlyNT '"  not in: "
-            pp (packageForm and devaluate package or entry)
-          nil
-        if $monitorNewWorld then
-          sayLooking1('"candidate default package instantiated: ",success)
-        success
-      entry
-    null package => nil
-    if $monitorNewWorld then
-      sayLooking1('"Looking at instantiated package ",package)
-    res := lookupInDomainVector(op,sig,package,dollar) =>
-      if $monitorNewWorld = true then
-        sayBrightly '"candidate default package succeeds"
-      return res
-    if $monitorNewWorld = true then
-      sayBrightly '"candidate fails -- continuing to search categories"
-    nil
- 
---=======================================================
---     Instantiate Default Package if Signature Matches
---=======================================================
- 
-getNewDefaultPackage(op,sig,infovec,dom,dollar) ==
-  hohohoho()
-  opvec := infovec . 1
-  numvec := CDDR infovec . 3
-  max := MAXINDEX opvec
-  k := getOpCode(op,opvec,max) or return nil
-  maxIndex := MAXINDEX numvec
-  start := ELT(opvec,k)
-  finish :=
-    QSGREATERP(max,k) => opvec.(QSPLUS(k,2))
-    maxIndex
-  if QSGREATERP(finish,maxIndex) then systemError '"limit too large"
-  numArgs := QSDIFFERENCE(#sig,1)
-  success := nil
-  while finish > start repeat
-    PROGN
-      i := start
-      numArgs ^= (numTableArgs :=numvec.i) => nil
-      newCompareSigCheaply(sig,numvec,(i := QSPLUS(i,2))) =>
-        return (success := true)
-    start := QSPLUS(start,QSPLUS(numTableArgs,4))
-  null success => nil
-  defaultPackage := cacheCategoryPackage(packageVec,catVec,i)
- 
---=======================================================
---         Compare Signature to One Derived from Table
---=======================================================
-newCompareSig(sig, numvec, index, dollar, domain) ==
-  k := index
-  null (target := first sig)
-   or lazyMatchArg(target,numvec.k,dollar,domain) =>
-     and/[lazyMatchArg(s,numvec.(k := i),dollar,domain)
-              for s in rest sig for i in (index+1)..] => numvec.(QSINC1 k)
-     nil
-  nil
- 
---=======================================================
---     Compare Signature to One Derived from Table
---=======================================================
-lazyMatchArg(s,a,dollar,domain) == lazyMatchArg2(s,a,dollar,domain,true)
- 
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
---------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
-lazyMatchArg2(s,a,dollar,domain,typeFlag) ==
-  if s = '$ then
---  a = 0 => return true  --needed only if extra call in newGoGet to basicLookup
-    s := devaluate dollar -- calls from HasCategory can have $s
-  INTEGERP a =>
-    not typeFlag => s = domain.a
-    a = 6 and $isDefaultingPackage => s = devaluate dollar
-    VECP (d := domainVal(dollar,domain,a)) =>
-      s = d.0 => true
-      domainArg := ($isDefaultingPackage => domain.6.0; domain.0)
-      KAR s = QCAR d.0 and lazyMatchArgDollarCheck(s,d.0,dollar.0,domainArg)
-    --VECP CAR d => lazyMatch(s,CDDR d,dollar,domain)      --old style (erase)
-    lazyMatch(s,d,dollar,domain)                         --new style
-  a = '$ => s = devaluate dollar
-  STRINGP a =>
-    s is ['QUOTE,y] and PNAME y = a
-    IDENTP s and PNAME s = a
-  atom a =>  a = s
-  op := opOf a
-  op  = 'NRTEVAL => s = nrtEval(CADR a,domain)
-  op = 'QUOTE => s = CADR a
-  lazyMatch(s,a,dollar,domain)
-  --above line is temporarily necessary until system is compiled 8/15/90
---s = a
- 
-lazyMatch(source,lazyt,dollar,domain) ==
-  lazyt is [op,:argl] and null atom source and op=CAR source
-    and #(sargl := CDR source) = #argl =>
-      MEMQ(op,'(Record Union)) and first argl is [":",:.] =>
-        and/[stag = atag and lazyMatchArg(s,a,dollar,domain)
-              for [.,stag,s] in sargl for [.,atag,a] in argl]
-      MEMQ(op,'(Union Mapping QUOTE)) =>
-         and/[lazyMatchArg(s,a,dollar,domain) for s in sargl for a in argl]
-      coSig := GETDATABASE(op,'COSIG)
-      NULL coSig => error ["bad Constructor op", op]
-      and/[lazyMatchArg2(s,a,dollar,domain,flag)
-           for s in sargl for a in argl for flag in rest coSig]
-  STRINGP source and lazyt is ['QUOTE,=source] => true
-  NUMBERP source =>
-      lazyt is ['_#, slotNum] => source = #(domain.slotNum)
-      lazyt is ['call,'LENGTH, slotNum] => source = #(domain.slotNum)
-      nil
-  source is ['construct,:l] => l = lazyt
-  -- A hideous hack on the same lines as the previous four lines JHD/MCD
-  nil
-
- 
-lazyMatchArgDollarCheck(s,d,dollarName,domainName) ==
-  #s ^= #d => nil
-  scoSig := GETDATABASE(opOf s,'COSIG) or return nil
-  if MEMQ(opOf s, '(Union Mapping Record)) then 
-     scoSig := [true for x in s]
-  and/[fn for x in rest s for arg in rest d for xt in rest scoSig] where
-   fn ==
-    x = arg => true
-    x is ['elt,someDomain,opname] => lookupInDomainByName(opname,evalDomain someDomain,arg)
-    x = '$ and (arg = dollarName or arg = domainName) => true
-    x = dollarName and arg = domainName => true
-    ATOM x or ATOM arg => false
-    xt and CAR x = CAR arg =>
-      lazyMatchArgDollarCheck(x,arg,dollarName,domainName)
-    false
-
-lookupInDomainByName(op,domain,arg) ==
-  atom arg => nil
-  opvec := domain . 1 . 2
-  numvec := getDomainByteVector domain
-  predvec := domain.3
-  max := MAXINDEX opvec
-  k := getOpCode(op,opvec,max) or return nil
-  maxIndex := MAXINDEX numvec
-  start := ELT(opvec,k)
-  finish :=
-    QSGREATERP(max,k) => opvec.(QSPLUS(k,2))
-    maxIndex
-  if QSGREATERP(finish,maxIndex) then systemError '"limit too large"
-  success := false
-  while finish > start repeat
-    i := start
-    numberOfArgs :=numvec.i
-    predIndex := numvec.(i := QSADD1 i)
-    NE(predIndex,0) and null testBitVector(predvec,predIndex) => nil
-    slotIndex := numvec.(i + 2 + numberOfArgs)
-    newStart := QSPLUS(start,QSPLUS(numberOfArgs,4))
-    slot := domain.slotIndex
-    null atom slot and EQ(CAR slot,CAR arg) and EQ(CDR slot,CDR arg) => return (success := true)
-    start := QSPLUS(start,QSPLUS(numberOfArgs,4))
-  success
- 
---=======================================================
---        Expand Signature from Encoded Slot Form
---=======================================================
---------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
-newExpandGoGetTypeSlot(slot,dollar,domain) ==
-  newExpandTypeSlot(slot,domain,domain)
- 
---------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
-newExpandTypeSlot(slot, dollar, domain) ==
---> returns domain form for dollar.slot
-   newExpandLocalType(domainVal(dollar, domain, slot), dollar,domain)
- 
- 
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
---------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
-newExpandLocalType(lazyt,dollar,domain) ==
-  VECP lazyt => lazyt.0
-  lazyt is [vec,.,:lazyForm] and VECP vec =>              --old style
-    newExpandLocalTypeForm(lazyForm,dollar,domain)
-  newExpandLocalTypeForm(lazyt,dollar,domain)             --new style
- 
---------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
-newExpandLocalTypeForm([functorName,:argl],dollar,domain) ==
-  MEMQ(functorName, '(Record Union)) and first argl is [":",:.] =>
-    [functorName,:[['_:,tag,newExpandLocalTypeArgs(dom,dollar,domain,true)]
-                                 for [.,tag,dom] in argl]]
-  MEMQ(functorName, '(Union Mapping)) =>
-	  [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]]
-  functorName = 'QUOTE => [functorName,:argl]
-  coSig := GETDATABASE(functorName,'COSIG)
-  NULL coSig => error ["bad functorName", functorName]
-  [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag)
-        for a in argl for flag in rest coSig]]
- 
---------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
-newExpandLocalTypeArgs(u,dollar,domain,typeFlag) ==
-  u = '$ => dollar.0      -------eliminate this as $ is rep by 0
-  INTEGERP u =>
-     typeFlag => newExpandTypeSlot(u, dollar,domain)
-     domain.u
-  u is ['NRTEVAL,y] => nrtEval(y,domain)
-  u is ['QUOTE,y] => y
-  atom u => u   --can be first, rest, etc.
-  newExpandLocalTypeForm(u,dollar,domain)
- 
---------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
-nrtEval(expr,dom) ==
-  $:fluid := dom
-  eval expr
- 
-domainVal(dollar,domain,index) ==
---returns a domain or a lazy slot
-  index = 0 => dollar
-  index = 2 => domain
-  domain.index
- 
- 
---=======================================================
---          Convert Lazy Domain to Domain Form
---=======================================================
- 
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
-lazyDomainSet(lazyForm,thisDomain,slot) ==
-  form :=
-    lazyForm is [vec,.,:u] and VECP vec => u        --old style
-    lazyForm                                        --new style
-  slotDomain := evalSlotDomain(form,thisDomain)
-  if $monitorNewWorld then
-    sayLooking1(concat(form2String devaluate thisDomain,
-      '" activating lazy slot ",slot,'": "),slotDomain)
-  name := CAR form
-  SETELT(thisDomain,slot,slotDomain)
- 
---=======================================================
---                   HasCategory/Attribute
---=======================================================
--- PLEASE NOTE: This function has the rather charming side-effect that
--- e.g. it works if domform is an Aldor Category.  This is being used
--- by extendscategoryForm in c-util to allow Aldor domains to be used
--- in spad code.  Please do not break this!  An example is the use of
--- Interval (an Aldor domain) by SIGNEF in limitps.spad.  MCD.
-newHasTest(domform,catOrAtt) ==
-  domform is [dom,:.] and dom in '(Union Record Mapping Enumeration) =>
-    ofCategory(domform, catOrAtt)
-  catOrAtt = '(Type) => true
-  GETDATABASE(opOf domform, 'ASHARP?) => fn(domform,catOrAtt) where
-  -- atom (infovec := getInfovec opOf domform) => fn(domform,catOrAtt) where
-    fn(a,b) ==
-      categoryForm?(a) => assoc(b, ancestorsOf(a, nil))
-      isPartialMode a => throwKeyedMsg("S2IS0025",NIL)
-      b is ["SIGNATURE",:opSig] =>
-        HasSignature(evalDomain a,opSig)
-      b is ["ATTRIBUTE",attr] => HasAttribute(evalDomain a,attr)
-      hasCaty(a,b,NIL) ^= 'failed
-      HasCategory(evalDomain a,b) => true -- for asharp domains: must return Boolean
-  op := opOf catOrAtt
-  isAtom := atom catOrAtt
-  null isAtom and op = 'Join =>
-    and/[newHasTest(domform,x) for x in rest catOrAtt]
--- we will refuse to say yes for 'Cat has Cat'
---GETDATABASE(opOf domform,'CONSTRUCTORKIND) = 'category => throwKeyedMsg("S2IS0025",NIL)
--- on second thoughts we won't!
-  GETDATABASE(opOf domform,'CONSTRUCTORKIND) = 'category =>
-      domform = catOrAtt => 'T
-      for [aCat,:cond] in [:ancestorsOf(domform,NIL),:SUBLISLIS (rest domform,$FormalMapVariableList,GETDATABASE(opOf domform,'ATTRIBUTES))] |  aCat = catOrAtt  repeat
-         return evalCond cond where
-           evalCond x ==
-	     ATOM x => x
-             [pred,:l] := x
-             pred = 'has => 
-                  l is [ w1,['ATTRIBUTE,w2]] => newHasTest(w1,w2) 
-                  l is [ w1,['SIGNATURE,:w2]] => compiledLookup(CAR w2,CADR w2, eval mkEvalable w1)
-                  newHasTest(first  l ,first rest l) 
-             pred = 'OR => or/[evalCond i for i in l]
-             pred = 'AND => and/[evalCond i for i in l]
-             x  
-  null isAtom and constructor? op  =>
-    domain := eval mkEvalable domform
-    newHasCategory(domain,catOrAtt)
-  newHasAttribute(eval mkEvalable domform,catOrAtt)
- 
-lazyMatchAssocV(x,auxvec,catvec,domain) ==      --new style slot4
-  n : FIXNUM := MAXINDEX catvec
-  xop := CAR x
-  or/[ELT(auxvec,i) for i in 0..n |
-    xop = CAR (lazyt := QVELT(catvec,i)) and lazyMatch(x,lazyt,domain,domain)]
- 
-lazyMatchAssocV1(x,vec,domain) ==               --old style slot4
-  n : FIXNUM := MAXINDEX vec
-  xop := CAR x
-  or/[QCDR QVELT(vec,i) for i in 0..n |
-    xop = CAR (lazyt := CAR QVELT(vec,i)) and lazyMatch(x,lazyt,domain,domain)]
- 
---newHasAttribute(domain,attrib) ==
---  predIndex := LASSOC(attrib,domain.2) =>
---    EQ(predIndex,0) => true
---    predvec := domain.3
---    testBitVector(predvec,predIndex)
---  false
- 
---=======================================================
---                   Utility Functions
---=======================================================
- 
-sayLooking(prefix,op,sig,dom) ==
-  $monitorNewWorld := false
-  dollar := devaluate dom
-  atom dollar or VECP dollar or or/[VECP x for x in dollar] => systemError nil
-  sayBrightly
-    concat(prefix,formatOpSignature(op,sig),bright '"from ",form2String dollar)
-  $monitorNewWorld := true
- 
-sayLooking1(prefix,dom) ==
-  $monitorNewWorld := false
-  dollar :=
-    VECP dom => devaluate dom
-    devaluateList dom
-  sayBrightly concat(prefix,form2String dollar)
-  $monitorNewWorld := true
- 
-cc() == -- don't remove this function
-  clearConstructorCaches()
-  clearClams()
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}