Revert commits to the wrong tree.

1 files changed, 0 insertions, 764 deletions

diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot
deleted file mode 100644
index b63519d8..00000000
--- a/src/interp/br-op2.boot
+++ /dev/null
@@ -1,764 +0,0 @@
--- 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.
-
-
---====================> WAS br-op2.boot <================================
-
---=======================================================================
---                   Operation Description
---=======================================================================
-
-displayDomainOp(htPage,which,origin,op,sig,predicate,
-                doc,index,chooseFn,unexposed?,$generalSearch?) ==
------------------------> OBSELETE
-  $saturn =>
-    displayDomainOp1(htPage,which,origin,op,sig,predicate,
-                doc,index,chooseFn,unexposed?,$generalSearch?)
-  $chooseDownCaseOfType : local := true   --see dbGetContrivedForm
-  $whereList  : local := nil
-  $NumberList : local := '(i j k l m n i1 j1 k1 l1 m1 n1 i2 j2 k2 l2 m2 n2 i3 j3 k3 l3 m3 n3 i4 j4 k4 l4 m4 n4 )
-  $ElementList: local := '(x y z u v w x1 y1 z1 u1 v1 w1 x2 y2 z2 u2 v2 w2 x3 y3 z3 u3 v3 w3 x4 y4 z4 u4 v4 w4 )
-  $FunctionList:local := '(f g h d e F G H)
-  $DomainList:  local := '(D R S E T A B C M N P Q U V W)
-  exactlyOneOpSig     := null index
-  conform   := htpProperty(htPage,'domname) or htpProperty(htPage,'conform)
-                 or origin
-  if $generalSearch? then $DomainList := rest $DomainList
-  opform :=
-    which = '"attribute" =>
-      null sig => [op]
-      [op,sig]
-    which = '"constructor" => origin
-    dbGetDisplayFormForOp(op,sig,doc)
-  htSay('"\newline")
-  if exactlyOneOpSig then htSay('"\menuitemstyle{}")
-  else htMakePage [['bcLinks,['"\menuitemstyle{}",'"",chooseFn,which,index]]]
-  htSay('"\tab{2}")
-  op   := IFCAR opform
-  args := IFCDR opform
-  ops := escapeSpecialChars STRINGIMAGE op
-  n := #sig
-  do
-    n = 2 and LASSOC('Nud,PROPLIST op) => htSay(ops,'" {\em ",quickForm2HtString KAR args,'"}")
-    n = 3 and LASSOC('Led,PROPLIST op) => htSay('"{\em ",quickForm2HtString KAR args,'"} ",ops,'" {\em ",quickForm2HtString KAR KDR args,'"}")
-    if unexposed? and $includeUnexposed? then
-      htSayUnexposed()
-      htSaySaturn '"\unexposed{{\em "
-      htSaySaturn ops
-      htSaySaturn '"}"
-    htSayStandard(ops)
-    predicate='ASCONST or GETDATABASE(op,'NILADIC) or member(op,'(0 1)) => 'skip
-    which = '"attribute" and null args => 'skip
-    htSay('"(")
-    if IFCAR args then htSay('"{\em ",quickForm2HtString IFCAR args,'"}")
-    for x in IFCDR args repeat
-      htSay('",{\em ",quickForm2HtString x,'"}")
-    htSay('")")
-  constring := form2HtString conform
-  conname   := first conform
-  $conkind   : local := htpProperty(htPage,'kind) -- a string e.g. "category"
-                          or STRINGIMAGE GETDATABASE(conname,'CONSTRUCTORKIND)
-  $conlength : local := #constring
-  $conform   : local := conform
-  $conargs   : local := rest conform
-  if which = '"operation" then
-    $signature : local :=
-      MEMQ(conname,$Primitives) => nil
-      CDAR getConstructorModemap conname
-    --RDJ: this next line is necessary until compiler bug is fixed
-    --that forgets to substitute #variables for t#variables;
-    --check the signature for SegmentExpansionCategory, e.g.
-    tvarlist := TAKE(# $conargs,$TriangleVariableList)
-    $signature := SUBLISLIS($FormalMapVariableList,tvarlist,$signature)
-  $sig :=
-    which = '"attribute" or which = '"constructor" => sig
-    $conkind ^= '"package" => sig
-    symbolsUsed := [x for x in rest conform | IDENTP x]
-    $DomainList := SETDIFFERENCE($DomainList,symbolsUsed)
-    getSubstSigIfPossible sig
-  if member(which,'("operation" "constructor")) then
-    $displayReturnValue: local := nil
-    if args then
-      htSay('"\newline")
-      htSayStandard '"\tab{2}"
-      htSay '"{\em Arguments:}"
-      for a in args for t in rest $sig repeat
-        htSayIndentRel(15,true)
-        htSay('"{\em ",form2HtString(a),'"}, ")
-        htSayValue t
-        htSayIndentRel(-15,true)
-        htSay('"\newline ")
-    if first $sig then
-      $displayReturnValue := true
-      htSay('"\newline\tab{2}{\em Returns:}")
-      htSayIndentRel(15)
-      htSayValue first $sig
-      htSayIndentRel(-15)
-      htSay('"\newline ")
-  if origin and ($generalSearch? or origin ^= conform) and opOf(origin)^=op then
-    htSay('"\newline\tab{2}{\em Origin:}")
-    htSayIndentRel(15)
-    if not isExposedConstructor opOf origin and $includeUnexposed? then htSayUnexposed()
-    bcConform(origin,true)
-    htSayIndentRel(-15)
-  if not MEMQ(predicate,'(T ASCONST)) then
-    pred := sublisFormal(KDR conform,predicate)
-    count := #pred
-    htSay('"\newline\tab{2}{\em Conditions:}")
-    for p in displayBreakIntoAnds SUBST($conform,"$",pred) repeat
-      htSayIndentRel(15,count > 1)
-      bcPred(p,$conform,true)
-      htSayIndentRel(-15,count > 1)
-      htSay('"\newline ")
-  if $whereList then
-    count := #$whereList
-    htSay('"\newline\tab{2}{\em Where:}")
-    if ASSOC("$",$whereList) then
-      htSayIndentRel(15,true)
-      htSayStandard '"{\em \$} is "
-      htSaySaturn '"{\em \%} is "
-      htSay
-        $conkind = '"category" => '"of category "
-        '"the domain "
-      bcConform(conform,true,true)
-      htSayIndentRel(-15,true)
-    for [d,key,:t] in $whereList | d ^= "$" repeat
-      htSayIndentRel(15,count > 1)
-      htSay("{\em ",d,"} is ")
-      htSayConstructor(key,sublisFormal(KDR conform,t))
-      htSayIndentRel(-15,count > 1)
-  if doc and (doc ^= '"" and (doc isnt [d] or d ^= '"")) then
-    htSay('"\newline\tab{2}{\em Description:}")
-    htSayIndentRel(15)
-    if doc = $charFauxNewline then htSay $charNewline
-    else
-       ndoc:= 
-          -- we are confused whether doc is a string or a list of strings
-          CONSP doc =>  [SUBSTITUTE($charNewline, $charFauxNewline, i) for i in doc]
-          SUBSTITUTE($charNewline, $charFauxNewline,doc)
-       htSay ndoc
-    htSayIndentRel(-15)
-  if exactlyOneOpSig and (infoAlist := htpProperty(htPage,'infoAlist)) then
-    displayInfoOp(htPage,infoAlist,op,sig)
-
-
-htSayIndentRel(n,:options) ==
------------------> OBSELETE
-  flag := IFCAR options
-  m := ABSVAL n
-  if flag then m := m + 2
-  htSay
-    n > 0 =>
-      flag => ['"\indent{",STRINGIMAGE m,'"}\tab{-2}"]
-      ['"\indent{",STRINGIMAGE m,'"}\tab{0}"]
-    n < 0 => ['"\indent{0}\newline "]
-
-htSayConstructor(key,u) ==
-  u is ['CATEGORY,kind,:r] =>
-    htSay('"a ",kind,'" ")
-    htSayExplicitExports(r)
-  key = 'is =>
-    htSay '"the domain "
-    bcConform(u,true)
-  htSay
-    key = 'is => '"the domain "
-    kind := GETDATABASE(opOf u,'CONSTRUCTORKIND)
-    kind = 'domain => '"an element of "
-    '"a domain of "
-  u is ['Join,:middle,r] =>
-    rest middle =>
-      htSay '"categories "
-      bcConform(first middle,true)
-      for x in rest middle repeat
-        htSay '", "
-        bcConform(x,true)
-      r is ['CATEGORY,.,:r] =>
-        htSay '" and "
-        htSayExplicitExports(r)
-      htSay '" and "
-      bcConform(r,true)
-    htSay '"category "
-    bcConform(first middle,true)
-    r is ['CATEGORY,.,:r] =>
-     htSay '" "
-     htSayExplicitExports(r)
-    htSay '" and "
-    bcConform(r,true)
-  htSay(kind,'" ")
-  bcConform(u,true)
-
-htSayExplicitExports r ==
-  htSay '"with explicit exports"
-  $displayReturnValue => nil
-  htSay '":"
-  for x in r repeat
-    htSay '"\newline "
-    x is ['SIGNATURE,op,sig] =>
-      ops := escapeSpecialChars STRINGIMAGE op
-      htMakePage [['bcLinks,[ops,'"",'oPage,ops]]]
-      htSay '": "
-      bcConform ['Mapping,:sig]
-    x is ['ATTRIBUTE,a] =>
-      s := form2HtString a
-      htMakePage [['bcLinks,[ops,'"",'aPage,s]]]
-    x is ['IF,:.] =>
-      htSay('"{\em if ...}")
-    systemError()
-
-displayBreakIntoAnds pred ==
-  pred is [op,:u] and member(op,'(and AND)) => u
-  [pred]
-
-htSayValue t ==
-  t is ['Mapping,target,:source] =>
-      htSay('"a function from ")
-      htSayTuple source
-      htSay '" to "
-      htSayArgument target
-  t = '(Category) => htSay('"a category")
-  t is [op,:.] and MEMQ(op,'(Join CATEGORY)) or constructor? opOf t =>
-    htSayConstructor(nil,t)
-  htSay('"an element of domain ")
-  htSayArgument t                            --continue for operations
-
-htSayArgument t == --called only for operations not for constructors
-  null $signature => htSay ['"{\em ",t,'"}"]
-  MEMQ(t, '(_$ _%)) =>
-    $conkind = '"category" and $conlength > 20 =>
-      $generalSearch? => htSay '"{\em D} of the origin category"
-      addWhereList("$",'is,nil)
-      htSayStandard '"{\em $}"
-      htSaySaturn '"{\em \%}"
-    htSayStandard '"{\em $}"
-    htSaySaturn '"{\em \%}"
-  not IDENTP t => bcConform(t,true)
-  k := position(t,$conargs)
-  if k > -1 then
-    typeOfArg := (rest $signature).k
-    addWhereList(t,'member,typeOfArg)
-  htSay('"{\em ",t,'"}")
-
-addWhereList(id,kind,typ) ==
-  $whereList := insert([id,kind,:typ],$whereList)
-
-htSayTuple t ==
-  null t => htSay '"()"
-  null rest t => htSayArgument first t
-  htSay '"("
-  htSayArgument first t
-  for d in rest t repeat
-    htSay '","
-    htSayArgument d
-  htSay '")"
-
-dbGetDisplayFormForOp(op,sig,doc) ==
-  dbGetFormFromDocumentation(op,sig,doc) or dbGetContrivedForm(op,sig)
-
-dbGetFormFromDocumentation(op,sig,x) ==
-  doc := (STRINGP x => x; first x)
-  STRINGP doc and
-     (stringPrefix?('"\spad{",doc) and (k := 6) or
-       stringPrefix?('"\s{",doc) and (k := 3)) =>
-    n := charPosition($charRbrace,doc,k)
-    s := SUBSTRING(doc,k,n - k)
-    parse := ncParseFromString s
-    parse is [=op,:.] and #parse = #sig => parse
-  nil
-
-dbMakeContrivedForm(op,sig,:options) ==
-  $chooseDownCaseOfType : local := IFCAR options
-  $NumberList : local := '(i j k l m n i1 j1 k1 l1 m1 n1 i2 j2 k2 l2 m2 n2 i3 j3 k3 l3 m3 n3 i4 j4 k4 l4 m4 n4 )
-  $ElementList: local := '(x y z u v w x1 y1 z1 u1 v1 w1 x2 y2 z2 u2 v2 w2 x3 y3 z3 u3 v3 w3 x4 y4 z4 u4 v4 w4 )
-  $FunctionList:local := '(f g h d e F G H)
-  $DomainList:  local := '(R S D E T A B C M N P Q U V W)
-  dbGetContrivedForm(op,sig)
-
-dbGetContrivedForm(op,sig) ==
-  op = '"0" => [0]
-  op = '"1" => [1]
-  [op,:[dbChooseOperandName s for s in rest sig]]
-
-dbChooseOperandName(typ) ==
-  typ is ['Mapping,:.] =>
-    x := first $FunctionList
-    $FunctionList := rest $FunctionList
-    x
-  name := opOf typ
-  kind :=
-    name = "$" => 'domain
-    GETDATABASE(name,'CONSTRUCTORKIND)
-  s := PNAME opOf typ
-  kind ^= 'category =>
-    anySubstring?('"Integer",s,0) or anySubstring?('"Number",s,0) =>
-      x := first $NumberList
-      $NumberList := rest $NumberList
-      x
-    x :=
-      $chooseDownCaseOfType =>
-        y := DOWNCASE typ
-        x :=
-          member(y,$ElementList) => y
-          first $ElementList
-      first $ElementList
-    $ElementList := delete(x,$ElementList)
-    x
-  x := first $DomainList
-  $DomainList := rest $DomainList
-  x
-
-getSubstSigIfPossible sig ==
-  getSubstSignature sig or sig
-
---
---  while (u := getSubstSignature sig) repeat
---     sig := u
---  sig
-
-fullSubstitute(x,y,z) ==  --substitutes deeply: x for y in list z
-  z = y => x
-  atom z => z
-  [fullSubstitute(x,y,u) for u in z]
-
-getSubstCandidates sig ==
-  candidates := nil
-  for x in sig for i in 1.. | x is [.,.,:.] repeat
-    getSubstQualify(x,i,sig) => candidates := getSubstInsert(x,candidates)
-    y := or/[getSubstQualify(y,i,sig) for y in rest x | y is [.,.,:.]] =>
-      candidates := insert(y,candidates)
-  candidates
-
-getSubstSignature sig ==
-    candidates := getSubstCandidates sig
-    null candidates => nil
-    D := first $DomainList
-    $DomainList := rest $DomainList
-    winner := first candidates
-    newsig := fullSubstitute(D,winner,sig)
-    sig :=
-      null rest candidates => newsig
-      count := NUMOFNODES newsig
-      for x in rest candidates repeat
-        trial := fullSubstitute(D,x,sig)
-        trialCount := NUMOFNODES trial
-        trialCount < count =>
-          newsig := trial
-          count  := trialCount
-          winner := x
-      newsig
-    addWhereList(D,'is,winner)
-    newsig
-
-getSubstQualify(x,i,sig) ==
-    or/[CONTAINED(x,y) for y in sig for j in 1.. | j ^= i] => x
-    false
-
-getSubstInsert(x,candidates) ==
-    return insert(x,candidates)
-    null candidates => [x]
-    or/[CONTAINED(x,y) for y in candidates] => candidates
-    y := or/[CONTAINED(y,x) for y in candidates] => SUBST(x,y,candidates)
-    candidates
-
-
---=======================================================================
---                      Who Uses
---=======================================================================
-whoUsesOperation(htPage,which,key) ==  --see dbPresentOps
-  key = 'filter => koaPageFilterByName(htPage,'whoUsesOperation)
-  opAlist := htpProperty(htPage,'opAlist)
-  conform := htpProperty(htPage,'conform)
-  conargs := rest conform
-  opl := nil
-  for [op,:alist] in opAlist repeat
-    for [sig,:.] in alist repeat
-      opl := [[op,:SUBLISLIS($FormalMapVariableList,rest conform,sig)],:opl]
-  opl := NREVERSE opl
-  u := whoUses(opl,conform)
-  prefix := pluralSay(#u,'"constructor uses",'"constructors use")
-  suffix :=
-    opAlist is [[op1,.]] =>
-      ['" operation {\em ",escapeSpecialChars STRINGIMAGE op1,'":",form2HtString ['Mapping,:sig],'"}"]
-    ['" these operations"]
-  page := htInitPage([:prefix,:suffix],htCopyProplist htPage)
-  nopAlist := nil
-  for [name,:opsigList] in u repeat
-    for opsig in opsigList repeat
-      sofar    := LASSOC(opsig,nopAlist)
-      nopAlist := insertAlist(opsig,[name,:LASSOC(opsig,nopAlist)],nopAlist)
-  usedList := nil
-  for [(pair := [op,:sig]),:namelist] in nopAlist repeat
-    ops := escapeSpecialChars STRINGIMAGE op
-    usedList := [pair,:usedList]
-    htSay('"Users of {\em ",ops,'": ")
-    bcConform ['Mapping,:sublisFormal(conargs,sig)]
-    htSay('"}\newline")
-    bcConTable listSort(function GLESSEQP,REMDUP namelist)
-  noOneUses := SETDIFFERENCE(opl,usedList)
-  if #noOneUses > 0 then
-    htSay('"No constructor uses the ")
-    htSay
-      #noOneUses = 1 => '"operation: "
-      [#noOneUses,'" operations:"]
-    htSay '"\newline "
-    for [op,:sig] in noOneUses repeat
-      htSay('"\tab{2}{\em ",escapeSpecialChars STRINGIMAGE op,'": ")
-      bcConform ['Mapping,:sublisFormal(conargs,sig)]
-      htSay('"}\newline")
-  htSayStandard '"\endscroll "
-  dbPresentOps(page,which,'usage)
-  htShowPageNoScroll()
-
-whoUses(opSigList,conform) ==
-  opList := REMDUP ASSOCLEFT opSigList
-  numOfArgsList := REMDUP [-1 + #sig for [.,:sig] in opSigList]
-  acc  := nil
-  $conname : local := first conform
-  domList := getUsersOfConstructor $conname
-  hash := MAKE_-HASH_-TABLE()
-  for name in allConstructors() | MEMQ(name,domList) repeat
-    $infovec : local := dbInfovec name
-    null $infovec => 'skip           --category
-    template := $infovec . 0
-    found := false
-    opacc := nil
-    for i in 7..MAXINDEX template repeat
-      item := template . i
-      item isnt [n,:op] or not MEMQ(op,opList) => 'skip
-      index := n
-      numvec := getCodeVector()
-      numOfArgs := numvec . index
-      null member(numOfArgs,numOfArgsList) => 'skip
-      whereNumber := numvec.(index := index + 1)
-      template . whereNumber isnt [= $conname,:.] => 'skip
-      signumList := dcSig(numvec,index + 1,numOfArgs)
-      opsig := or/[pair for (pair := [op1,:sig]) in opSigList | op1 = op and whoUsesMatch?(signumList,sig,nil)]
-        => opacc := [opsig,:opacc]
-    if opacc then acc := [[name,:opacc],:acc]
-  acc
-
-whoUsesMatch?(signumList,sig,al) ==
-  #signumList = #sig and whoUsesMatch1?(signumList,sig,al)
-
-whoUsesMatch1?(signumList,sig,al) ==
-  signumList is [subject,:r] and sig is [pattern,:s] =>
-    x := LASSOC(pattern,al) =>
-      x = subject => whoUsesMatch1?(r,s,al)
-      false
-    pattern = '_$ =>
-      subject is [= $conname,:.] => whoUsesMatch1?(r,s,[['_$,:subject],:al])
-      false
-    whoUsesMatch1?(r,s,[[pattern,:subject],:al])
-  true
-
---=======================================================================
---                   Get Attribute/Operation Alist
---=======================================================================
-
-koAttrs(conform,domname) ==
-  [conname,:args] := conform
---asharpConstructorName? conname => nil  --assumed
-  'category = GETDATABASE(conname,'CONSTRUCTORKIND) =>
-      koCatAttrs(conform,domname)
-  $infovec: local := dbInfovec conname or return nil
-  $predvec: local :=
-    $domain => $domain . 3
-    GETDATABASE(conname,'PREDICATES)
-  u := [[a,:pred] for [a,:i] in $infovec . 2 | a ^= 'nil and (pred := sublisFormal(args,kTestPred i))]
-                                               ---------  CHECK for a = nil
-  listSort(function GLESSEQP,fn u) where fn u ==
-    alist := nil
-    for [a,:pred] in u repeat
-      op := opOf a
-      args := IFCDR a
-      alist := insertAlist(op,insertAlist(args,[pred],LASSOC(op,alist)),alist)
-    alist
-
-koOps(conform,domname,:options) == main where
---returns alist of form ((op (sig . pred) ...) ...)
-  main ==
-    $packageItem: local := nil
---  relatives? := IFCAR options
-    ours :=
---    relatives? = 'onlyRelatives => nil
-      fn(conform,domname)
---    if relatives? then
---      relatives := relativesOf(conform,domname)
---      if domname then relatives :=
---      SUBLISLIS([domname,:rest domname],['_$,:rest conform],relatives)
---      --kill all relatives that have a sharp variable remaining in them
---      for x in relatives repeat
---      or/[y for y in CDAR x | isSharpVar y] => 'skip
---      acc := [x,:acc]
---      relatives := NREVERSE acc
---      for (pair := [pakform,:.]) in relatives repeat
---      $packageItem := sublisFormal(rest conform,pair)
---      ours := merge(fn(pakform,nil),ours)
-    listSort(function GLESSEQP,trim ours)
-  trim u == [pair for pair in u | IFCDR pair]
-  fn(conform,domname) ==
-    conform := domname or conform
-    [conname,:args] := conform
-    subargs: local := args
-    ----------> new <------------------
-    u := koCatOps(conform,domname) => u
---    'category = GETDATABASE(conname,'CONSTRUCTORKIND) =>
---        koCatOps(conform,domname)
-    asharpConstructorName? opOf conform => nil
-    ----------> new <------------------
-    $infovec: local := dbInfovec conname--------> removed 94/10/24
-    exposureTail :=
-      null $packageItem => '(NIL NIL)
-      isExposedConstructor opOf conform => [conform,:'(T)]
-      [conform,:'(NIL)]
-    for [op,:u] in getOperationAlistFromLisplib conname repeat
-      op1 := zeroOneConvert op
-      acc :=
-       [[op1,:[[sig,npred,:exposureTail] for [sig,slot,pred,key,:.] in sublisFormal(subargs,u) |
-         (key ^= 'Subsumed) and (npred := simpHasPred pred)]],:acc]
-    acc
-  merge(alist,alist1) == --alist1 takes precedence
-    for [op,:al] in alist1 repeat
-      u := LASSOC(op,alist) =>
-        for [sig,:item] in al | not LASSOC(sig,u) repeat
-          u := insertAlist(sig,item,u)
-        alist := insertAlist(op,u,DELASC(op,alist)) --add the merge of two alists
-      alist := insertAlist(op,al,alist)  --add the whole inner alist
-    alist
-
-zeroOneConvert x ==
-  x = 'Zero => 0
-  x = 'One  => 1
-  x
-
-kFormatSlotDomain x == fn formatSlotDomain x where fn x ==
-  atom x => x
-  (op := CAR x) = '_$ => '_$
-  op = 'local => CADR x
-  op = ":" => [":",CADR x,fn CADDR x]
-  MEMQ(op,$Primitives) or constructor? op =>
-    [fn y for y in x]
-  INTEGERP op => op
-  op = 'QUOTE and atom CADR x => CADR x
-  x
-
-koCatOps(conform,domname) ==
-  conname := opOf conform
-  oplist := REVERSE GETDATABASE(conname,'OPERATIONALIST)
-  oplist := sublisFormal(IFCDR domname or IFCDR conform ,oplist)
-  --check below for INTEGERP key to avoid subsumed signatures
-  [[zeroOneConvert op,:nalist] for [op,:alist] in oplist | nalist := koCatOps1(alist)]
-
-koCatOps1 alist == [x for item in alist | x := pair] where
-  pair ==
-    [sig,:r] := item
-    null r => [sig,true]
-    [key,:options] := r
-    null (pred := IFCAR options) =>
-      IFCAR IFCDR options = 'ASCONST => [sig,'ASCONST]
-      [sig,true]
-    npred := simpHasPred pred => [sig,npred]
-    false
-
-koCatAttrs(catform,domname) ==
-  $if: local := MAKE_-HASHTABLE 'ID
-  catname   := opOf catform
-  koCatAttrsAdd(domname or catform,true)
-  ancestors := ancestorsOf(catform,domname)
-  for [conform,:pred] in ancestors repeat koCatAttrsAdd(conform,pred)
-  hashTable2Alist $if
-
-hashTable2Alist tb ==
-  [[op,:HGET(tb,op)] for op in listSort(function GLESSEQP,HKEYS $if)]
-
-koCatAttrsAdd(catform,pred) ==
-  for [name,argl,:p] in CAR getConstructorExports catform repeat
-    npred  := quickAnd(pred,p)
-    exists := HGET($if,name)
-    if existingPred := LASSOC(argl,exists)_
-        then npred := quickOr(npred,existingPred)
-    if not MEMQ(name,'(nil nothing)) _
-        then HPUT($if,name,[[argl,simpHasPred npred],:exists])
-
---=======================================================================
---            Filter by Category
---=======================================================================
-
-koaPageFilterByCategory(htPage,calledFrom) ==
-  opAlist := htpProperty(htPage,'opAlist)
-  which   := htpProperty(htPage,'which)
-  page := htInitPageNoScroll(htCopyProplist htPage,
-             dbHeading(opAlist,which,htpProperty(htPage,'heading)))
-  htSay('"Select a category ancestor below or ")
-  htMakePage [['bcLispLinks,['"filter",'"on:",calledFrom,'filter]]]
-  htMakePage [['bcStrings, [13,'"",'filter,'EM]]]
-  htSay('"\beginscroll ")
-  conform := htpProperty(htPage,'conform)
-  domname := htpProperty(htPage,'domname)
-  ancestors := ASSOCLEFT ancestorsOf(conform,domname)
-  htpSetProperty(page,'ancestors,listSort(function GLESSEQP,ancestors))
-  bcNameCountTable(ancestors,'form2HtString,'koaPageFilterByCategory1,true)
-  htShowPage()
-
-dbHeading(items,which,heading,:options) ==
-  names?   := IFCAR options
-  count :=
-    names? => #items
-    +/[#(rest x) for x in items]
-  capwhich := capitalize which
-  prefix :=
-    count < 2 =>
-      names? => pluralSay(count,STRCONC(capwhich," Name"),nil)
-      pluralSay(count,capwhich,nil)
-    names? => pluralSay(count,nil,STRCONC(capwhich," Names"))
-    pluralSay(count,nil,pluralize capwhich)
-  [:prefix,'" for ",:heading]
-
-koaPageFilterByCategory1(htPage,i) ==
-  ancestor := htpProperty(htPage,'ancestors) . i
-  ancestorList := [ancestor,:ASSOCLEFT ancestorsOf(ancestor,nil)]
-  newOpAlist := nil
-  which    := htpProperty(htPage,'which)
-  opAlist  := htpProperty(htPage,'opAlist)
-  domname  := htpProperty(htPage,'domname)
-  conform  := htpProperty(htPage,'conform)
-  heading  := htpProperty(htPage,'heading)
-  docTable := dbDocTable(domname or conform)
-  for [op,:alist] in opAlist repeat
-    nalist := [[origin,:item] for item in alist | split]
-      where split ==
-        [sig,pred,:aux] := item
-        u := dbGetDocTable(op,sig,docTable,which,aux)
-        origin := IFCAR u
-        doc    := IFCDR u
-        true
-    for [origin,:item] in nalist | origin repeat
-      member(origin,ancestorList) =>
-        newEntry   := [item,:LASSOC(op,newOpAlist)]
-        newOpAlist := insertAlist(op,newEntry,newOpAlist)
-  falist := nil
-  for [op,:alist] in newOpAlist repeat
-    falist := [[op,:NREVERSE alist],:falist]
-  htpSetProperty(htPage,'fromcat,['" from category {\sf ",form2HtString ancestor,'"}"])
-  dbShowOperationsFromConform(htPage,which,falist)
-
---=======================================================================
---           New code for search operation alist for exact matches
---=======================================================================
-
-opPageFast opAlist == --called by oSearch
-  htPage := htInitPage(nil,nil)
-  htpSetProperty(htPage,'opAlist,opAlist)
-  htpSetProperty(htPage,'expandOperations,'lists)
-  which := '"operation"
---dbResetOpAlistCondition(htPage,which,opAlist)
-  dbShowOp1(htPage,opAlist,which,'names)
-
-opPageFastPath opstring ==
---return nil
-  x := STRINGIMAGE opstring
-  charPosition(char '_*,x,0) < #x => nil     --quit if name has * in it
-  op := (STRINGP x => INTERN x; x)
-  mmList := getAllModemapsFromDatabase(op,nil) or return nil
-  opAlist := [[op,:[item for mm in mmList]]] where item ==
-    [predList, origin, sig] := modemap2Sig(op, mm)
-    predicate := predList and MKPF(predList,'AND)
-    exposed? := isExposedConstructor opOf origin
-    [sig, predicate, origin, exposed?]
-  opAlist
-
-modemap2Sig(op,mm) ==
-  [dcSig, conds] := mm
-  [dc, :sig] := dcSig
-  partial? :=
-    conds is ['partial,:r] => conds := r
-    false
-  condlist := modemap2SigConds conds
-  [origin, vlist, flist] := getDcForm(dc, condlist) or return nil
-  subcondlist := SUBLISLIS(flist, vlist, condlist)
-  [predList,vlist, flist] := getSigSubst(subcondlist, nil, vlist, flist)
-  if partial? then
-    target := dcSig . 1
-    ntarget := ['Union, target, '"failed"]
-    dcSig := SUBST(ntarget, target, dcSig)
-  alist := findSubstitutionOrder? pairlis(vlist, flist) or systemError()
-  predList := substInOrder(alist, predList)
-  nsig := substInOrder(alist, sig)
-  if hasPatternVar nsig or hasPatternVar predList then
-    pp '"--------------"
-    pp op
-    pp predList
-    pp nsig
-    pp mm
-    $badStack := [[op, mm], :$badStack]
---pause nsig
-  [predList, origin, SUBST("%", origin, nsig)]
-
-modemap2SigConds conds ==
-  conds is ['OR,:r] => modemap2SigConds first r
-  conds is ['AND,:r] => r
-  [conds]
-
-hasPatternVar x ==
-  IDENTP x and (x ^= "**") => isPatternVar x
-  atom x => false
-  or/[hasPatternVar y for y in x]
-
-getDcForm(dc, condlist) ==
-  [ofWord,id,cform] := or/[x for x in condlist | x is [k,=dc,:.]
-     and MEMQ(k, '(ofCategory isDomain))] or return nil
-  conform := getConstructorForm opOf cform
-  ofWord = 'ofCategory =>
-    [conform, ["*1", :rest cform], ["%", :rest conform]]
-  ofWord = 'isDomain =>
-    [conform, ["*1", :rest cform], ["%", :rest conform]]
-  systemError()
-
-getSigSubst(u, pl, vl, fl) ==
-  u is [item, :r] =>
-    item is ['AND,:s] =>
-       [pl, vl, fl] := getSigSubst(s, pl, vl, fl)
-       getSigSubst(r, pl, vl, fl)
-    [key, v, f] := item
-    key = 'isDomain => getSigSubst(r, pl, [v, :vl], [f, :fl])
-    key = 'ofCategory => getSigSubst(r, pl, ['D, :vl], [f, :fl])
-    key = 'ofType    => getSigSubst(r, pl, vl, fl)
-    key = 'has => getSigSubst(r, [item, :pl], vl, fl)
-    key = 'not => getSigSubst(r, [item, :pl], vl, fl)
-    systemError()
-  [pl, vl, fl]
-
-
-pairlis(u,v) ==
-  null u or null v => nil
-  [[first u,:first v],:pairlis(rest u, rest v)]
-
-
-