remove pamphlets - part 5

1 files changed, 0 insertions, 933 deletions

diff --git a/src/interp/interop.boot.pamphlet b/src/interp/interop.boot.pamphlet
deleted file mode 100644
index 88d4e560..00000000
--- a/src/interp/interop.boot.pamphlet
+++ /dev/null
@@ -1,933 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/interp/interop.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"
-
--- note domainObjects are now (dispatchVector hashCode . domainVector)
--- lazy oldAxiomDomainObjects are (dispatchVector hashCode  (Call form) . backptr), 
--- pre oldAxiomCategory is (dispatchVector . (cat form))
--- oldAxiomCategory objects are (dispatchVector . ( (cat form)  hash defaultpack parentlist))
-
-hashCode? x == INTEGERP x
-
-$domainTypeTokens := ['lazyOldAxiomDomain, 'oldAxiomDomain, 'oldAxiomPreCategory,
-           'oldAxiomCategory, 0]
-
--- The name game.
--- The compiler produces names that are of the form:
--- a) cons(0, <string>)
--- b) cons(1, type-name, arg-names...)
--- c) cons(2, arg-names...)
--- d) cons(3, value)
--- NB: (c) is for tuple-ish constructors, 
---     and (d) is for dependent types.
-
-DNameStringID := 0
-DNameApplyID  := 1
-DNameTupleID  := 2
-DNameOtherID  := 3
-
-DNameToSExpr1 dname ==
-  NULL dname => error "unexpected domain name"
-  CAR dname = DNameStringID => 
-    INTERN(CompStrToString CDR dname)
-  name0 := DNameToSExpr1 CAR CDR dname
-  args  := CDR CDR dname
-  name0 = '_-_> => 
-    froms := CAR args
-    froms := MAPCAR(function DNameToSExpr, CDR froms)
-    ret   := CAR CDR args -- a tuple
-    ret   := DNameToSExpr CAR CDR ret -- contents
-    CONS('Mapping, CONS(ret, froms))
-  name0 = 'Union or name0 = 'Record =>
-    sxs := MAPCAR(function DNameToSExpr, CDR CAR args)
-    CONS(name0, sxs)
-  name0 = 'Enumeration =>
-    CONS(name0, MAPCAR(function DNameFixEnum, CDR CAR args))
-  CONS(name0, MAPCAR(function DNameToSExpr, args))
-
-DNameToSExpr dname ==
-  CAR dname = DNameOtherID  =>
-	CDR dname
-  sx := DNameToSExpr1 dname
-  CONSP sx => sx
-  LIST sx
-
-DNameFixEnum arg == CompStrToString CDR arg
-  
-SExprToDName(sexpr, cosigVal) == 
-  -- is it a non-type valued object?
-  NOT cosigVal => [DNameOtherID, :sexpr]
-  if CAR sexpr = '_: then sexpr := CAR CDR CDR sexpr
-  CAR sexpr = 'Mapping =>
-    args := [ SExprToDName(sx, 'T) for sx in CDR sexpr]
-    [DNameApplyID,
-         [DNameStringID,: StringToCompStr '"->"],
-              [DNameTupleID, : CDR args],
-		 [DNameTupleID, CAR args]]
-  name0 :=   [DNameStringID, : StringToCompStr SYMBOL_-NAME CAR sexpr]
-  CAR sexpr = 'Union or CAR sexpr = 'Record =>
-    [DNameApplyID, name0, 
-        [DNameTupleID,: [ SExprToDName(sx, 'T) for sx in CDR sexpr]]]
-  newCosig := CDR GETDATABASE(CAR sexpr, QUOTE COSIG)
-  [DNameApplyID, name0,
-   : MAPCAR(function SExprToDName, CDR sexpr, newCosig)]
-
--- local garbage because Compiler strings are null terminated
-StringToCompStr(str) == 
-   CONCATENATE(QUOTE STRING, str, STRING (CODE_-CHAR 0))
-
-CompStrToString(str) == 
-   SUBSTRING(str, 0, (LENGTH str - 1))
--- local garbage ends
-
-runOldAxiomFunctor(:allArgs) ==
-  [:args,env] := allArgs
-  GETDATABASE(env, 'CONSTRUCTORKIND) = 'category =>
-      [$oldAxiomPreCategoryDispatch,: [env, :args]]
-  dom:=APPLY(env, args)
-  makeOldAxiomDispatchDomain dom
-
-makeLazyOldAxiomDispatchDomain domform ==
-  attribute? domform =>
-      [$attributeDispatch, domform, hashString(SYMBOL_-NAME domform)]
-  GETDATABASE(opOf domform, 'CONSTRUCTORKIND) = 'category =>
-      [$oldAxiomPreCategoryDispatch,: domform]
-  dd := [$lazyOldAxiomDomainDispatch, hashTypeForm(domform,0), domform]
-  NCONC(dd,dd) -- installs back pointer to head of domain.
-  dd
-
-makeOldAxiomDispatchDomain dom ==
-  PAIRP dom => dom
-  [$oldAxiomDomainDispatch,hashTypeForm(dom.0,0),:dom]
-
-closeOldAxiomFunctor(name) ==
-   [function runOldAxiomFunctor,:SYMBOL_-FUNCTION name]
-
-lazyOldAxiomDomainLookupExport(domenv, self, op, sig, box, skipdefaults, env) ==
-  dom := instantiate domenv
-  SPADCALL(CDR dom, self, op, sig, box, skipdefaults, CAR(dom).3)
-
-lazyOldAxiomDomainHashCode(domenv, env) == CAR domenv
-
-lazyOldAxiomDomainDevaluate(domenv, env) ==
-  dom := instantiate domenv
-  SPADCALL(CDR dom, CAR(dom).1)
-
-lazyOldAxiomAddChild(domenv, kid, env) ==
-  CONS($lazyOldAxiomDomainDispatch,domenv)
-
-$lazyOldAxiomDomainDispatch :=
-   VECTOR('lazyOldAxiomDomain,
-          [function lazyOldAxiomDomainDevaluate],
-          [nil],
-	  [function lazyOldAxiomDomainLookupExport],
-          [function lazyOldAxiomDomainHashCode],
-          [function lazyOldAxiomAddChild])
-
--- old Axiom pre category objects are just (dispatch . catform)
--- where catform is ('categoryname,: evaluated args)
--- old Axiom category objects are  (dispatch . [catform, hashcode, defaulting package, parent vector, dom])
-oldAxiomPreCategoryBuild(catform, dom, env) ==
-   pack := oldAxiomCategoryDefaultPackage(catform, dom)
-   CONS($oldAxiomCategoryDispatch,
-       [catform, hashTypeForm(catform,0), pack, oldAxiomPreCategoryParents(catform,dom), dom])
-oldAxiomPreCategoryHashCode(catform, env) == hashTypeForm(catform,0)
-oldAxiomCategoryDefaultPackage(catform, dom) ==
-    hasDefaultPackage opOf catform 
-
-oldAxiomPreCategoryDevaluate([op,:args], env) ==
-   SExprToDName([op,:devaluateList args], T)
-
-$oldAxiomPreCategoryDispatch :=
-   VECTOR('oldAxiomPreCategory,
-          [function oldAxiomPreCategoryDevaluate],
-          [nil],
-          [nil],
-          [function oldAxiomPreCategoryHashCode],
-          [function oldAxiomPreCategoryBuild],
-          [nil])
-
-oldAxiomCategoryDevaluate([[op,:args],:.], env) ==
-   SExprToDName([op,:devaluateList args], T)
-
-oldAxiomPreCategoryParents(catform,dom) ==
-  vars := ["$",:rest GETDATABASE(opOf catform, 'CONSTRUCTORFORM)]
-  vals := [dom,:rest catform]
-  -- parents :=  GETDATABASE(opOf catform, 'PARENTS)
-  parents := parentsOf opOf catform
-  PROGV(vars, vals,
-    LIST2VEC
-      [EVAL quoteCatOp cat for [cat,:pred] in parents | EVAL pred])
-
-quoteCatOp cat == 
-   atom cat => MKQ cat
-   ['LIST, MKQ CAR cat,: CDR cat]
-
-
-oldAxiomCategoryLookupExport(catenv, self, op, sig, box, env) ==
-   [catform,hash, pack,:.] := catenv
-   opIsHasCat op => if EQL(sig, hash) then [self] else nil
-   NULL(pack) => nil
-   if not VECP pack then
-       pack:=apply(pack, CONS(self, rest catform))
-       RPLACA(CDDR catenv, pack)
-   fun := basicLookup(op, sig, pack, self) => [fun]
-   nil
-
-oldAxiomCategoryParentCount([.,.,.,parents,.], env) == LENGTH parents
-oldAxiomCategoryNthParent([.,.,.,parvec,dom], n, env) ==
-  catform := ELT(parvec, n-1)
-  VECTORP KAR catform => catform
-  newcat := oldAxiomPreCategoryBuild(catform,dom,nil)
-  SETELT(parvec, n-1, newcat)
-  newcat
-
-oldAxiomCategoryBuild([catform,:.], dom, env) ==
-  oldAxiomPreCategoryBuild(catform,dom, env)
-oldAxiomCategoryHashCode([.,hash,:.], env) == hash
-
-$oldAxiomCategoryDispatch :=
-   VECTOR('oldAxiomCategory,
-          [function oldAxiomCategoryDevaluate],
-          [nil],
-          [function oldAxiomCategoryLookupExport],
-          [function oldAxiomCategoryHashCode],
-          [function oldAxiomCategoryBuild], -- builder ??
-          [function oldAxiomCategoryParentCount],
-          [function oldAxiomCategoryNthParent]) -- 1 indexed
-
-attributeDevaluate(attrObj, env) ==
-   [name, hash] := attrObj
-   StringToCompStr SYMBOL_-NAME name
-
-attributeLookupExport(attrObj, self, op, sig, box, env) ==
-   [name, hash] := attrObj
-   opIsHasCat op => if EQL(hash, sig) then [self] else nil
-
-attributeHashCode(attrObj, env) ==
-   [name, hash] := attrObj
-   hash
-
-attributeCategoryBuild(attrObj, dom, env) ==
-   [name, hash] := attrObj
-   [$attributeDispatch, name, hash] 
-
-attributeCategoryParentCount(attrObj, env) == 0
-
-attributeNthParent(attrObj, env) == nil
-
-$attributeDispatch :=
-   VECTOR('attribute,
-          [function attributeDevaluate],
-          [nil],
-          [function attributeLookupExport],
-          [function attributeHashCode],
-          [function attributeCategoryBuild], -- builder ??
-          [function attributeCategoryParentCount],
-          [function attributeNthParent]) -- 1 indexed
-
-
-orderedDefaults(conform,domform) ==
-  $depthAssocCache : local := MAKE_-HASHTABLE 'ID
-  conList := [x for x in orderCatAnc (op := opOf conform) | hasDefaultPackage op]
-  acc := nil
-  ancestors := ancestorsOf(conform,domform)
-  for x in conList repeat
-    for y in ancestors | x = CAAR y repeat acc := [y,:acc]
-  NREVERSE acc
-
-instantiate domenv ==
-   -- following is a patch for a bug in runtime.as
-   -- has a lazy dispatch vector with an instantiated domenv
-  VECTORP CDR domenv => [$oldAxiomDomainDispatch ,: domenv]
-  callForm := CADR domenv
-  oldDom := CDDR domenv
-  [functor,:args] := callForm
---  if null(fn := GETL(functor,'instantiate)) then
---     ofn := SYMBOL_-FUNCTION functor
---     loadFunctor functor
---     fn := SYMBOL_-FUNCTION functor
---     SETF(SYMBOL_-FUNCTION functor, ofn)
---     PUT(functor, 'instantiate, fn)
---  domvec := APPLY(fn, args)
-  domvec := APPLY(functor, args)
-  RPLACA(oldDom, $oldAxiomDomainDispatch)
-  RPLACD(oldDom, [CADR oldDom,: domvec])
-  oldDom
-
-hashTypeForm([fn,: args], percentHash) == 
-   hashType([fn,:devaluateList args], percentHash)
-
---------------------> NEW DEFINITION (override in i-util.boot.pamphlet)
-devaluate(d) ==
-  isDomain d =>
-      -- ?need a shortcut for old domains
-      -- ELT(CAR d, 0) = 'oldAxiomDomain => ...
-      -- FIXP(ELT(CAR d,0)) => d
-      DNameToSExpr(SPADCALL(CDR d,CAR(d).1))
-  not REFVECP d => d
-  QSGREATERP(QVSIZE d,5) and QREFELT(d,3) is ['Category] => QREFELT(d,0)
-  QSGREATERP(QVSIZE d,0) =>
-    d':=QREFELT(d,0)
-    isFunctor d' => d'
-    d
-  d
-
-$hashOp1 := hashString '"1"
-$hashOp0 := hashString '"0"
-$hashOpApply := hashString '"apply"
-$hashOpSet := hashString '"set!"
-$hashSeg := hashString '".."
-$hashPercent := hashString '"%"
-
-oldAxiomDomainLookupExport _
-  (domenv, self, op, sig, box, skipdefaults, env) ==
-     domainVec := CDR domenv
-     if hashCode? op then
-         EQL(op, $hashOp1) => op := 'One
-         EQL(op, $hashOp0) => op := 'Zero
-         EQL(op, $hashOpApply) => op := 'elt
-         EQL(op, $hashOpSet) => op := 'setelt
-         EQL(op, $hashSeg) => op := 'SEGMENT
-     constant := nil
-     if hashCode? sig and self and EQL(sig, getDomainHash self) then
-       sig := '($)
-       constant := true
-     val :=
-       skipdefaults => 
-          oldCompLookupNoDefaults(op, sig, domainVec, self)
-       oldCompLookup(op, sig, domainVec, self)
-     null val => val
-     if constant then val := SPADCALL val
-     RPLACA(box, val)
-     box
-     
-oldAxiomDomainHashCode(domenv, env) == CAR domenv
-
-oldAxiomDomainHasCategory(domenv, cat, env) ==
-  HasAttribute(domvec := CDR domenv, cat) or
-    HasCategory(domvec, devaluate cat)
-
-oldAxiomDomainDevaluate(domenv, env) == 
-   SExprToDName(CDR(domenv).0, 'T)
-
-oldAxiomAddChild(domenv, child, env) == CONS($oldAxiomDomainDispatch, domenv)
-
-$oldAxiomDomainDispatch :=
-   VECTOR('oldAxiomDomain,
-          [function oldAxiomDomainDevaluate],
-          [nil],
-	  [function oldAxiomDomainLookupExport],
-	  [function oldAxiomDomainHashCode],
-          [function oldAxiomAddChild])
-
---------------------> NEW DEFINITION (see g-util.boot.pamphlet)
-isDomain a ==
-  PAIRP a and VECP(CAR a) and
-    member(CAR(a).0, $domainTypeTokens)
-
--- following is interpreter interfact to function lookup
--- perhaps it should always work with hashcodes for signature?
---------------------> NEW DEFINITION (override in nrungo.boot.pamphlet)
-NRTcompiledLookup(op,sig,dom) ==
-  if CONTAINED('_#,sig) then
-      sig := [NRTtypeHack t for t in sig]
-  hashCode? sig =>   compiledLookupCheck(op,sig,dom)
-  (fn := compiledLookup(op,sig,dom)) => fn
-  percentHash :=
-      VECP dom => hashType(dom.0, 0)
-      getDomainHash dom
-  compiledLookupCheck(op, hashType(['Mapping,:sig], percentHash), dom)
-
---------------------> NEW DEFINITION (override in nrungo.boot.pamphlet)
-compiledLookup(op, sig, dollar) ==
-  if not isDomain dollar then dollar := NRTevalDomain dollar
-  basicLookup(op, sig, dollar, dollar)
-
---------------------> NEW DEFINITION (override in nrungo.boot.pamphlet)
-basicLookup(op,sig,domain,dollar) ==
-   -- following case is for old domains like Record and Union
-   -- or for getting operations out of yourself
-  VECP domain =>
-     isNewWorldDomain domain => -- getting ops from yourself (or for defaults)
-        oldCompLookup(op, sig, domain, dollar)
-     -- getting ops from Record or Union
-     lookupInDomainVector(op,sig,domain,dollar)
-  hashPercent :=
-     VECP dollar => hashType(dollar.0,0)
-     hashType(dollar,0)
-  box := [nil]
-  not VECP(dispatch := CAR domain) => error "bad domain format"
-  lookupFun := dispatch.3
-  dispatch.0 = 0 =>  -- new compiler domain object
-       hashSig :=
-           hashCode? sig => sig
-	   opIsHasCat op => hashType(sig, hashPercent)
-           hashType(['Mapping,:sig], hashPercent)
-
-       if SYMBOLP op then
-          op = 'Zero => op := $hashOp0
-          op = 'One => op := $hashOp1
-          op = 'elt => op := $hashOpApply
-          op = 'setelt => op := $hashOpSet
-          op := hashString SYMBOL_-NAME op
-       val:=CAR SPADCALL(CDR domain, dollar, op, hashSig, box, false,
-                               lookupFun) => val
-       hashCode? sig => nil
-       #sig>1 or opIsHasCat op => nil
-       boxval := SPADCALL(CDR dollar, dollar, op, hashType(first sig, hashPercent),
-                     box, false, lookupFun) =>
-          [FUNCTION IDENTITY,: CAR boxval]
-       nil
-  opIsHasCat op =>
-      HasCategory(domain, sig)
-  if hashCode? op then
-     EQL(op, $hashOp1) => op := 'One
-     EQL(op, $hashOp0) => op := 'Zero
-     EQL(op, $hashOpApply) => op := 'elt
-     EQL(op, $hashOpSet) => op := 'setelt
-     EQL(op, $hashSeg) => op := 'SEGMENT
-  hashCode? sig and EQL(sig, hashPercent) =>
-      SPADCALL CAR SPADCALL(CDR dollar, dollar, op, '($), box, false, lookupFun)
-  CAR SPADCALL(CDR dollar, dollar, op, sig, box, false, lookupFun)
-
-basicLookupCheckDefaults(op,sig,domain,dollar) ==
-  box := [nil]
-  not VECP(dispatch := CAR dollar) => error "bad domain format"
-  lookupFun := dispatch.3
-  dispatch.0 = 0  =>  -- new compiler domain object
-       hashPercent :=
-          VECP dollar => hashType(dollar.0,0)
-          hashType(dollar,0)
-
-       hashSig :=
-         hashCode? sig => sig
-         hashType( ['Mapping,:sig], hashPercent)
-
-       if SYMBOLP op then op := hashString SYMBOL_-NAME op
-       CAR SPADCALL(CDR dollar, dollar, op, hashSig, box, not $lookupDefaults, lookupFun)
-  CAR SPADCALL(CDR dollar, dollar, op, sig, box, not $lookupDefaults, lookupFun)
-
-$hasCatOpHash := hashString '"%%"
-opIsHasCat op ==
-  hashCode? op => EQL(op, $hasCatOpHash)
-  EQ(op, "%%")
-
--- has cat questions lookup up twice if false
--- replace with following ?
---  not(opIsHasCat op) and
---     (u := lookupInDomainVector(op,sig,domvec,domvec)) => u
-
-oldCompLookup(op, sig, domvec, dollar) ==
-  $lookupDefaults:local := nil
-  u := lookupInDomainVector(op,sig,domvec,dollar) => u
-  $lookupDefaults := true
-  lookupInDomainVector(op,sig,domvec,dollar)
-
-oldCompLookupNoDefaults(op, sig, domvec, dollar) ==
-  $lookupDefaults:local := nil
-  lookupInDomainVector(op,sig,domvec,dollar)
-
---------------------> NEW DEFINITION (override in nrungo.boot.pamphlet)
-lookupInDomainVector(op,sig,domain,dollar) ==
-  PAIRP domain => basicLookupCheckDefaults(op,sig,domain,domain)
-  slot1 := domain.1
-  SPADCALL(op,sig,dollar,slot1)
-
---------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
-lookupComplete(op,sig,dollar,env) ==
-   hashCode? sig => hashNewLookupInTable(op,sig,dollar,env,nil)
-   newLookupInTable(op,sig,dollar,env,nil)
- 
---------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
-lookupIncomplete(op,sig,dollar,env) == 
-   hashCode? sig => hashNewLookupInTable(op,sig,dollar,env,true)
-   newLookupInTable(op,sig,dollar,env,true)
- 
---------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
-lookupInCompactTable(op,sig,dollar,env) ==
-   hashCode? sig => hashNewLookupInTable(op,sig,dollar,env,true)
-   newLookupInTable(op,sig,dollar,env,true)
-
---------------------> NEW DEFINITION (override in nrunfast.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)
-    isDomain d =>
-        dhash:=getDomainHash d
-        dhash =
-           (if hashCode? s then s else hashType(s, dhash))
---      s = devaluate d
-    lazyMatch(s,d,dollar,domain)                         --new style
-  a = '$ => s = devaluate dollar
-  a = "$$" => s = devaluate domain
-  STRINGP a =>
-    STRINGP s => a = s
-    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
- 
---------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
-getOpCode(op,vec,max) ==
---search Op vector for "op" returning code if found, nil otherwise
-  res := nil
-  hashCode? op =>
-    for i in 0..max by 2 repeat
-      EQL(hashString PNAME QVELT(vec,i),op) => return (res := QSADD1 i)
-    res
-  for i in 0..max by 2 repeat
-    EQ(QVELT(vec,i),op) => return (res := QSADD1 i)
-  res
-
-hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
-  opIsHasCat op =>
-      HasCategory(domain, sig)
-  if hashCode? op and EQL(op, $hashOp1) then op := 'One
-  if hashCode? op and EQL(op, $hashOp0) then op := 'Zero
-  hashPercent :=
-    VECP dollar => hashType(dollar.0,0)
-    hashType(dollar,0)
-  if hashCode? sig and EQL(sig, hashPercent) then 
-         sig := hashType('(Mapping $), hashPercent)
-  dollar = nil => systemError()
-  $lookupDefaults = true =>
-    hashNewLookupInCategories(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 := if hashCode? sig then -1 else (#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
-      numTableArgs :=numvec.i
-      predIndex := numvec.(i := QSADD1 i)
-      (predIndex ^= 0) and null testBitVector(predvec,predIndex) => nil
-      exportSig :=
-          [newExpandTypeSlot(numvec.(i + j + 1),
-            dollar,domain) for j in 0..numTableArgs]
-      sig ^= hashType(['Mapping,: exportSig],hashPercent) => nil --signifies no match
-      loc := numvec.(i + numTableArgs + 2)
-      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))
-  (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
-
---------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
-newExpandLocalType(lazyt,dollar,domain) ==
-  VECP lazyt => lazyt.0
-  isDomain lazyt => devaluate lazyt
-  ATOM lazyt => lazyt
-  lazyt is [vec,.,:lazyForm] and VECP vec =>              --old style
-    newExpandLocalTypeForm(lazyForm,dollar,domain)
-  newExpandLocalTypeForm(lazyt,dollar,domain)             --new style
-
-hashNewLookupInCategories(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]) =>
-              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
-
---------------------> NEW DEFINITION (override in nrunfast.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 and SYMBOLP CAR 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
-
-HasAttribute(domain,attrib) ==
-  hashPercent :=
-       VECP domain => hashType(domain.0,0)
-       hashType(domain,0)
-  isDomain domain =>
-     FIXP((first domain).0) => 
-        -- following call to hashType was missing 2nd arg. 
-        -- getDomainHash domain added on 4/01/94 by RSS
-        basicLookup("%%",hashType(attrib, hashPercent),domain,domain)
-     HasAttribute(CDDR domain, attrib)
--->
-  isNewWorldDomain domain => newHasAttribute(domain,attrib)
---+
-  (u := LASSOC(attrib,domain.2)) and lookupPred(first u,domain,domain)
- 
-newHasAttribute(domain,attrib) ==
-  hashPercent :=
-       VECP domain => hashType(domain.0,0)
-       hashType(domain,0)
-  predIndex :=
-     hashCode? attrib =>
-        -- following call to hashType was missing 2nd arg. 
-        -- hashPercent added by PAB 15/4/94
-        or/[x for x in domain.2 | attrib = hashType(first x, hashPercent)]
-     LASSOC(attrib,domain.2)
-  predIndex =>
-    EQ(predIndex,0) => true
-    predvec := domain.3
-    testBitVector(predvec,predIndex)
-  false
-
-newHasCategory(domain,catform) ==
-  catform = '(Type) => true  
-  slot4 := domain.4
-  auxvec := CAR slot4
-  catvec := CADR slot4
-  $isDefaultingPackage: local := isDefaultPackageForm? devaluate domain
-  #catvec > 0 and INTEGERP KDR catvec.0 =>              --old style
-    predIndex := lazyMatchAssocV1(catform,catvec,domain)
-    null predIndex => false
-    EQ(predIndex,0) => true
-    predvec := QVELT(domain,3)
-    testBitVector(predvec,predIndex)
-  lazyMatchAssocV(catform,auxvec,catvec,domain)         --new style
-
---------------------> NEW DEFINITION (override in nrunfast.boot.pamphlet)
-lazyMatchAssocV(x,auxvec,catvec,domain) ==      --new style slot4
-  n : FIXNUM := MAXINDEX catvec
-  -- following call to hashType was missing 2nd arg. 0 added on 3/31/94 by RSS
-  hashCode? x =>
-    percentHash :=
-      VECP domain => hashType(domain.0, 0)
-      getDomainHash domain
-    or/[ELT(auxvec,i) for i in 0..n |
-        x = hashType(newExpandLocalType(QVELT(catvec,i),domain,domain), percentHash)]
-  xop := CAR x
-  or/[ELT(auxvec,i) for i in 0..n |
-    --xop = CAR (lazyt := QVELT(catvec,i)) and lazyMatch(x,lazyt,domain,domain)]
-    xop = CAR (lazyt := getCatForm(catvec,i,domain)) and lazyMatch(x,lazyt,domain,domain)]
-
-getCatForm(catvec, index, domain) ==
-   NUMBERP(form := QVELT(catvec,index)) => domain.form
-   form
-
-has(domain,catform') == HasCategory(domain,catform')
-
-HasCategory(domain,catform') ==
-  catform' is ['SIGNATURE,:f] => HasSignature(domain,f)
-  catform' is ['ATTRIBUTE,f] => HasAttribute(domain,f)
-  isDomain domain =>
-     FIXP((first domain).0) =>
-        catform' := devaluate catform'
-        basicLookup("%%",catform',domain,domain)
-     HasCategory(CDDR domain, catform')
-  catform:= devaluate catform'
-  isNewWorldDomain domain => newHasCategory(domain,catform)
-  domain0:=domain.0 -- handles old style domains, Record, Union etc.
-  slot4 := domain.4
-  catlist := slot4.1
-  member(catform,catlist) or
-   MEMQ(opOf(catform),'(Object Type)) or  --temporary hack
-    or/[compareSigEqual(catform,cat,domain0,domain) for cat in catlist]
-
---systemDependentMkAutoload(fn,cnam) ==
---    FBOUNDP(cnam) => "next"
---    SETF(SYMBOL_-FUNCTION cnam,mkAutoLoad(fn, cnam))
-
---------------------> NEW DEFINITION (override in nrunfast.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
---getInfovec name
-  SETELT(thisDomain,slot,slotDomain)
-
-
---------------------> NEW DEFINITION (override in template.boot.pamphlet)
-evalSlotDomain(u,dollar) ==
-  $returnNowhereFromGoGet: local := false
-  $ : fluid := dollar
-  $lookupDefaults : local := nil -- new world
-  isDomain u => u
-  u = '$ => dollar
-  u = "$$" => dollar
-  FIXP u =>
-    VECP (y := dollar.u) => y
-    isDomain y => y
-    y is ['SETELT,:.] => eval y--lazy domains need to marked; this is dangerous?
-    y is [v,:.] => 
-      VECP v => lazyDomainSet(y,dollar,u)               --old style has [$,code,:lazyt]
-      constructor? v or MEMQ(v,'(Record Union Mapping)) => 
-        lazyDomainSet(y,dollar,u)                       --new style has lazyt
-      y
-    y
-  u is ['NRTEVAL,y] => 
-    y is ['ELT,:.] => evalSlotDomain(y,dollar)
-    eval  y
-  u is ['QUOTE,y] => y
-  u is ['Record,:argl] =>
-     FUNCALL('Record0,[[tag,:evalSlotDomain(dom,dollar)]
-                                 for [.,tag,dom] in argl])
-  u is ['Union,:argl] and first argl is ['_:,.,.] =>
-     APPLY('Union,[['_:,tag,evalSlotDomain(dom,dollar)]
-                                 for [.,tag,dom] in argl])
-  u is ['spadConstant,d,n] =>
-    dom := evalSlotDomain(d,dollar)
-    SPADCALL(dom . n)
-  u is ['ELT,d,n] =>
-    dom := evalSlotDomain(d,dollar)
-    slot := dom . n
-    slot is ['newGoGet,:env] => replaceGoGetSlot env
-    slot
-  u is [op,:argl] => APPLY(op,[evalSlotDomain(x,dollar) for x in argl])
-  systemErrorHere '"evalSlotDomain"
- 
---------------------> NEW DEFINITION (override in i-util.boot.pamphlet)
-domainEqual(a,b) ==
-  devaluate(a) = devaluate(b)
-
---makeConstructorsAutoLoad()
-
--- following changes should go back into xrun.boot
--- patched version from xrun.boot
---------------------> NEW DEFINITION (override in clammed.boot.pamphlet)
---------------------> NEW DEFINITION (override in xrun.boot.pamphlet)
-coerceConvertMmSelection(funName,m1,m2) ==
-  -- calls selectMms with $Coerce=NIL and tests for required
-  -- target type. funName is either 'coerce or 'convert.
-  $declaredMode : local:= NIL
-  $reportBottomUpFlag : local:= NIL
-  l := selectMms1(funName,m2,[m1],[m1],NIL)
---  mmS := [[sig,[targ,arg],:pred] for x in l | x is [sig,[.,arg],:pred] and
-  mmS := [x for x in l | x is [sig,:.] and hasCorrectTarget(m2,sig) and
-      sig is [dc,targ,oarg] and isEqualOrSubDomain(m1,oarg)]
-  mmS and CAR mmS
-
---------------------> NEW DEFINITION (see i-funsel.boot.pamphlet)
-getFunctionFromDomain(op,dc,args) ==
-  -- finds the function op with argument types args in dc
-  -- complains, if no function or ambiguous
-  $reportBottomUpFlag:local:= NIL
-  member(CAR dc,$nonLisplibDomains) =>
-    throwKeyedMsg("S2IF0002",[CAR dc])
-  not constructor? CAR dc =>
-    throwKeyedMsg("S2IF0003",[CAR dc])
-  p:= findFunctionInDomain(op,dc,NIL,args,args,NIL,NIL) =>
---+
-    --sig := [NIL,:args]
-    domain := evalDomain dc
-    for mm in nreverse p until b repeat
-      [[.,:osig],nsig,:.] := mm
-      b := compiledLookup(op,nsig,domain)
-    b or  throwKeyedMsg("S2IS0023",[op,dc])
-  throwKeyedMsg("S2IF0004",[op,dc])
-
-@
-
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}