Initial population.

1 files changed, 1161 insertions, 0 deletions

diff --git a/src/interp/br-op1.boot.pamphlet b/src/interp/br-op1.boot.pamphlet
new file mode 100644
index 00000000..aea5b89b
--- /dev/null
+++ b/src/interp/br-op1.boot.pamphlet
@@ -0,0 +1,1161 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/br-op1.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>>
+
+--====================> WAS b-op1.boot <================================
+
+--=======================================================================
+--                   Operation Page Menu
+--=======================================================================
+--opAlist has form [[op,:alist],:.]  where each alist
+--        has form [sig,pred,origin,exposeFlag,comments]
+
+dbFromConstructor?(htPage) == htpProperty(htPage,'conform)
+
+dbPresentOps(htPage,which,:exclusions) ==
+  true => dbPresentOpsSaturn(htPage,which,exclusions)
+--Flags:
+--  fromConPage?:    came (originally) from a constructor page
+--  usage?:          display usage?
+--  star?:           display exposed/*=unexposed
+--  implementation?: display implementation?
+  htSay('"{\em Views:}")
+  asharp? := htpProperty(htPage,'isAsharpConstructor)
+  fromConPage? := (conname := opOf htpProperty(htPage,'conform))
+  usage? := $UserLevel = 'development and fromConPage? and which = '"operation"
+    and not (GETDATABASE(conname,'CONSTRUCTORKIND) = 'category)
+      and not asharp?
+  star? := not fromConPage? or which = '"package operation"
+  implementation? := not asharp? and
+    $UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed?
+  rightmost? := star? or (implementation? and not $includeUnexposed?)
+  tabs :=
+    which = '"attribute" => '("12" "12" "25" "40" 13)
+    star? => '("12" "19" "31" "43" 10)
+    implementation? => '("9" "16" "28" "44" 9)
+    '("9" "16" "28" "41" 12)
+  if INTEGERP first exclusions then exclusions := ['documentation]
+  htpSetProperty(htPage,'exclusion,first exclusions)
+  opAlist :=
+    which = '"operation" => htpProperty(htPage,'opAlist)
+    htpProperty(htPage,'attrAlist)
+  empty? := null opAlist
+  htTab
+   which = '"attribute" => tabs.1
+   tabs.0
+  if empty? or member('names,exclusions) or null KDR opAlist
+    then htSay '"{\em names}"
+    else htMakePage [['bcLispLinks,['"names",'"",'dbShowOps,which,'names]]]
+  if which ^= '"attribute" then
+    htTab tabs.1
+    if empty? or member('signatures,exclusions)
+      then htSay '"{\em signatures}"
+      else htMakePage [['bcLispLinks,['"signatures",'"",'dbShowOps,which,'signatures]]]
+  htTab tabs.2
+  if empty? or member('parameters,exclusions) --also test for some parameter
+      or not dbDoesOneOpHaveParameters? opAlist
+    then htSay '"{\em parameters}"
+    else htMakePage [['bcLispLinks,['"parameters",'"",'dbShowOps,which,'parameters]]]
+  htTab tabs.3
+  if not empty? and null IFCDR opAlist and not htpProperty(htPage,'noUsage)
+    then
+      if htpProperty(htPage,'conform)
+      then htMakePage
+             [['bcLinks,['"generalise",'"",'dbShowOps,which,'generalise]]]
+      else htMakePage
+             [['bcLinks,['"all domains",'"",'dbShowOps,which,'allDomains]]]
+    else
+      if empty? or MEMQ('usage,exclusions) or htpProperty(htPage,'noUsage) then htSay '"{\em filter}" else
+        htMakePage [['bcLinks,['"filter",'"",'dbShowOps,which,'filter]]]
+      htMakePage [['bcStrings, [tabs.4,'"",'filter,'EM]]]
+  htSay('"\newline ")
+  if star?
+  then
+    if $exposedOnlyIfTrue
+    then htMakePage
+           [['bcLinks,['"exposed",'" {\em only}",'dbShowOps,which,'exposureOff]]]
+    else
+      htSay('"*{\em =}")
+      htMakePage [['bcLinks,['"unexposed",'"",'dbShowOps,which,'exposureOn]]]
+--  else if (updown := dbCompositeWithMap htPage)
+--       then htMakePage [['bcLispLinks,[updown,'"",'dbShowUpDown,updown]]]
+  htTab tabs.0
+  if usage? then
+      if empty? or member('usage,exclusions) or GETDATABASE(conname,'CONSTRUCTORKIND) = 'category or HGET($defaultPackageNamesHT,conname) or htpProperty(htPage,'noUsage)
+      then htSay '"{\em usage}"
+      else htMakePage [['bcLispLinks,['"usage",'"",'whoUsesOperation,which,nil]]]
+  htTab tabs.1
+  if empty? or member('origins,exclusions)
+    then htSay '"{\em origins}"
+    else htMakePage [['bcLispLinks,['"origins",'"",'dbShowOps,which,'origins]]]
+  htTab tabs.2
+  if implementation? then
+    if member('implementation,exclusions) or which = '"attribute" or
+      ((conname := opOf htpProperty(htPage,'conform)) and GETDATABASE(conname,'CONSTRUCTORKIND) = 'category)
+    then htSay '"{\em implementation}"
+    else htMakePage [['bcLispLinks,['"implementation",'"",'dbShowOps,which,'implementation]]]
+  else if empty? or member('conditions,exclusions) or (htpProperty(htPage,'condition?) = 'no)
+      then htSay '"{\em conditions}"
+      else htMakePage [['bcLispLinks,['"conditions",'"",'dbShowOps,which,'conditions]]]
+  htTab tabs.3
+  if empty? or member('documentation,exclusions)
+    then htSay '"{\em description}"
+    else htMakePage [['bcLispLinks,['"description",'"",'dbShowOps,which,'documentation]]]
+  htShowPageNoScroll()
+
+htTab s == htSay('"\tab{",s,'"}")
+
+dbDoesOneOpHaveParameters? opAlist ==
+  or/[(or/[fn for x in items]) for [op,:items] in opAlist] where fn ==
+    STRINGP x => dbPart(x,2,1) ^= '"0"
+    KAR x
+--============================================================================
+--               Master Switch Functions for Operation Views
+--============================================================================
+
+dbShowOps(htPage,which,key,:options) ==
+  --NEXT LINE SHOULD BE REMOVED if we are sure that which is a string
+  which := STRINGIMAGE which
+  if MEMQ(key,'(extended basic all)) then
+    $groupChoice := key
+    key := htpProperty(htPage,'key) or 'names
+  opAlist  :=
+    which = '"operation" => htpProperty(htPage,'opAlist)
+--      al := reduceByGroup(htPage,htpProperty(htPage,'principalOpAlist))
+--      htpSetProperty(htPage,'opAlist,al)
+--      al
+    htpProperty(htPage,'attrAlist)
+  key = 'generalise =>
+    arg  := STRINGIMAGE CAAR opAlist
+    which = '"attribute" => aPage arg
+    oPage arg
+  key = 'allDomains => dbShowOpAllDomains(htPage,opAlist,which)
+  key = 'filter =>
+    --if $saturn, IFCAR options contains filter string
+    filter := IFCAR options or pmTransFilter(dbGetInputString htPage)
+    filter is ['error,:.] => bcErrorPage filter
+    opAlist:= [x for x in opAlist | superMatch?(filter,DOWNCASE STRINGIMAGE opOf x)]
+    null opAlist => emptySearchPage(which,filter)
+    htPage := htInitPageNoScroll(htCopyProplist htPage)
+    if which = '"operation"
+      then htpSetProperty(htPage,'opAlist,opAlist)
+      else htpSetProperty(htPage,'attrAlist,opAlist)
+    if not htpProperty(htPage,'condition?) = 'no then
+      dbResetOpAlistCondition(htPage,which,opAlist)
+    dbShowOps(htPage,which,htpProperty(htPage,'exclusion))
+  htpSetProperty(htPage,'key,key)
+  if MEMQ(key,'(exposureOn exposureOff)) then
+    $exposedOnlyIfTrue :=
+       key = 'exposureOn => 'T
+       nil
+    key := htpProperty(htPage,'exclusion)
+  dbShowOp1(htPage,opAlist,which,key)
+
+reduceByGroup(htPage,opAlist) ==
+  not dbFromConstructor?(htPage) or null $groupChoice => opAlist
+  dbExpandOpAlistIfNecessary(htPage,opAlist,'"operation",true,false)
+  bitNumber := HGET($topicHash,$groupChoice)
+  res := [[op,:newItems] for [op,:items] in opAlist | newItems] where
+    newItems ==
+      null bitNumber => items
+      [x for x in items | FIXP (code := myLastAtom x) and LOGBITP(bitNumber,code)]
+  res
+
+
+dbShowOp1(htPage,opAlist,which,key) ==
+  --set up for filtering below in dbGatherData
+  $which: local := which
+  if INTEGERP key then
+    opAlist := dbSelectData(htPage,opAlist,key)
+    ------> Jump out for constructor names in file <--------
+  INTEGERP key and opAlist is [[con,:.]] and htpProperty(htPage,'isFile)
+      and constructor? con => return conPageChoose con
+  if INTEGERP key then
+    htPage := htInitPageNoScroll(htCopyProplist htPage)
+    if which = '"operation"
+      then htpSetProperty(htPage,'opAlist,opAlist)
+      else htpSetProperty(htPage,'attrAlist,opAlist)
+    if not htpProperty(htPage,'condition?) = 'no then
+      dbResetOpAlistCondition(htPage,which,opAlist)
+  dbExpandOpAlistIfNecessary(htPage,opAlist,which,true,false)
+  if $exposedOnlyIfTrue and not dbFromConstructor?(htPage) then
+  --opAlist is expanded to form [[op,[sig,pred,origin,exposed,comments],...],...]
+    opAlist:=[item for [op,:items] in opAlist | item] where
+      item ==
+        acc := nil
+        for x in items | x.3 repeat acc:= [x,:acc]
+        null acc => nil
+        [op,:NREVERSE acc]
+  $conformsAreDomains : local := htpProperty(htPage,'domname)
+  opCount := opAlistCount(opAlist, which)
+  branch :=
+    INTEGERP key =>
+      opCount <= $opDescriptionThreshold => 'documentation
+      'names
+    key = 'names and null rest opAlist =>      --means a single op
+      opCount <= $opDescriptionThreshold => 'documentation
+      'names
+    key
+  [what,whats,fn] := LASSOC(branch,$OpViewTable)
+  data := dbGatherData(htPage,opAlist,which,branch)
+  dataCount := +/[1 for x in data | (what = '"Name" and $exposedOnlyIfTrue => atom x; true)]
+  namedPart :=
+    null rest opAlist =>
+      ops := escapeSpecialChars STRINGIMAGE CAAR opAlist
+      ['" {\em ",ops,'"}"]
+    nil
+  if what = '"Condition" and null KAR KAR data then dataCount := dataCount - 1
+  exposurePart :=
+    $exposedOnlyIfTrue => '(" Exposed ")
+    nil
+  firstPart :=
+    opCount = 0 => ['"No ",:exposurePart, pluralize capitalize which]
+    dataCount = 1 or dataCount = opCount =>
+      opCount = 1 => [:exposurePart, capitalize which,:namedPart]
+      [STRINGIMAGE opCount,'" ",:exposurePart,
+         pluralize capitalize which,:namedPart]
+    prefix := pluralSay(dataCount,what,whats)
+    [:prefix,'" for ",STRINGIMAGE opCount,'" ",pluralize capitalize which,:namedPart]
+  page := htInitPageNoScroll(htCopyProplist htPage)
+  ------------>above line used to call htInitPageHoHeading<----------
+  htAddHeading dbShowOpHeading([:firstPart,:fromHeading page], branch)
+  htpSetProperty(page,'data,data)
+  htpSetProperty(page,'branch,branch)
+  -- the only place where specialMessage property is set seems to be commented. out
+  if u := htpProperty(page,'specialMessage) then APPLY(first u,rest u)
+  htSayStandard('"\beginscroll ")
+  FUNCALL(fn,page,opAlist,which,data) --apply branch function
+  dbOpsExposureMessage()
+  htSayStandard("\endscroll ")
+  dbPresentOps(page,which,branch)
+  htShowPageNoScroll()
+
+opAlistCount(opAlist, which) == +/[foo for [op,:items] in opAlist] where foo ==
+  null $exposedOnlyIfTrue or which = '"attribute" => #items
+  --count if unexpanded---CDDR(w) = nil---or if w.3 = true
+  +/[1 for w in items | null (p := CDDR w) or p . 1]
+
+dbShowOpHeading(heading, branch) ==
+  suffix :=
+--  branch = 'signatures => '" viewed as signatures"
+    branch = 'parameters => '" viewed with parameters"
+    branch = 'origins    => '" organized by origins"
+    branch = 'conditions => '" organized by conditions"
+    '""
+  [:heading, suffix]
+
+dbOpsExposureMessage() ==
+  $atLeastOneUnexposed => htSay '"{\em *} = unexposed"
+
+fromHeading htPage ==
+  null htPage => '""
+  $pn := [htPage.0,'"}{"]
+  updomain := htpProperty(htPage,'updomain) =>
+    dnForm  := dbExtractUnderlyingDomain updomain
+    dnString:= form2StringList dnForm
+    dnFence := form2Fence  dnForm
+--  upString:= form2StringList updomain
+    upFence := form2Fence  updomain
+    upOp    := PNAME opOf  updomain
+    ['" {\em from} ",:dbConformGen dnForm,'" {\em under} \ops{",upOp,'"}{",:$pn,:upFence,'"}"]
+  domname  := htpProperty(htPage,'domname)
+  numberOfUnderlyingDomains := #[x for x in rest GETDATABASE(opOf domname,'COSIG) | x]
+--  numberOfUnderlyingDomains = 1 and
+--    KDR domname and (dn := dbExtractUnderlyingDomain domname) =>
+--      ['" {\em from} ",:pickitForm(domname,dn)]
+  KDR domname => ['" {\em from} ",:dbConformGen domname]
+  htpProperty(htPage,'fromHeading)
+
+pickitForm(form,uarg) ==
+  conform2StringList(form,FUNCTION dbConform,FUNCTION conformString,uarg)
+
+conformString(form) ==
+  KDR form =>
+    conform2StringList(form,FUNCTION conname2StringList,FUNCTION conformString,nil)
+  form2StringList form
+
+conform2StringList(form,opFn,argFn,exception) ==
+  exception := exception or '"%%%nothing%%%"
+  [op1,:args] := form
+  op := IFCAR HGET($lowerCaseConTb,op1) or op1
+  null args => APPLY(opFn,[op])
+  special := MEMQ(op,'(Union Record Mapping))
+  cosig :=
+    special => ['T for x in args]
+    rest GETDATABASE(op,'COSIG)
+  atypes :=
+    special => cosig
+    rest CDAR GETDATABASE(op,'CONSTRUCTORMODEMAP)
+  sargl := [fn for x in args for atype in atypes for pred in cosig] where fn ==
+    keyword :=
+      x is [":",y,t] =>
+        x := t
+        y
+      nil
+    res :=
+      x = exception => dbOpsForm exception
+      pred =>
+        STRINGP x => [x]
+        u := APPLY(argFn,[x])
+        atom u and [u] or u
+      typ := sublisFormal(args,atype)
+      if x is ['QUOTE,a] then x := a
+      u := mathform2HtString algCoerceInteractive(x,typ,'(OutputForm)) => [u]
+      NUMBERP x or STRINGP x => [x]
+      systemError()
+    keyword => [keyword,'": ",:res]
+    res
+  op = 'Mapping => dbMapping2StringList sargl
+  head :=
+    special => [op]
+    APPLY(opFn,[form])
+  [:head,'"(",:first sargl,:"append"/[[",",:y] for y in rest sargl],'")"]
+
+
+dbMapping2StringList [target,:sl] ==
+  null sl => target
+  restPart :=
+    null rest sl => nil
+    "append"/[[",",:y] for y in rest sl]
+  sourcePart :=
+    restPart => ['"(",:first sl,:restPart,'")"]
+    first sl
+  [:sourcePart,'" -> ",:target]
+
+dbOuttran form ==
+  if LISTP form then
+    [op,:args] := form
+  else
+    op := form
+    args := nil
+  cosig := rest GETDATABASE(op,'COSIG)
+  atypes := rest CDAR GETDATABASE(op,'CONSTRUCTORMODEMAP)
+  argl := [fn for x in args for atype in atypes for pred in cosig] where fn ==
+    pred => x
+    typ := sublisFormal(args,atype)
+    arg :=
+      x is ['QUOTE,a] => a
+      x
+    res := mathform2HtString algCoerceInteractive(arg,typ,'(OutputForm))
+    NUMBERP res or STRINGP res => res
+    ['QUOTE,res]
+  [op,:argl]
+
+dbOpsForm form ==
+--one button for the operations of a type
+--1st arg: like "Matrix(Integer)" or "UP('x,Integer)" <---all highlighted
+--2nd arg: like (|Matrix| (|Integer|)) and (|U..P..| (QUOTE |x|) (|Integer|))
+  ["\ops{",:conform2StringList(form,FUNCTION conname2StringList,FUNCTION conformString,nil),'"}{",:$pn,:form2Fence form,'"}"]
+
+dbConform form ==
+--------------------> OBSELETE <--------------------------
+--one button for the main constructor page of a type
+--NOTE: Next line should be as follows---but form2Fence form will
+--      put, e.g. '((2 1 . 0) (0 1 . 0)) instead of x**2 + 1
+  $saturn => ["\conf{",:form2StringList opOf form,
+     '"}{\lispLink{\verb!{(|conForm| '",:form2Fence dbOuttran form,'")!}}}"]
+  ["\conf{",:form2StringList opOf form,'"}{",:form2Fence dbOuttran form,'"}"]
+--["\conf{",:form2StringList opOf form,'"}{",:form2Fence opOf form,'"}"]
+
+
+dbConformGen form == dbConformGen1(form,true)
+--many buttons: one for the type and one for each inner type
+--NOTE: must only be called on types KNOWN to be correct
+
+dbConformGenUnder form == dbConformGen1(form,false)
+--same as above, except buttons only for the inner types
+
+dbConformGen1(form,opButton?) ==
+  opFunction :=
+    opButton? => FUNCTION dbConform
+    FUNCTION conname2StringList
+  originalOp := opOf form
+  op := unAbbreviateIfNecessary opOf form
+  args := IFCDR form
+  form :=
+    originalOp=op => form
+    [op, :args]
+  args => conform2StringList(form, opFunction,FUNCTION dbConformGen,nil)
+  APPLY(opFunction,[form])
+
+unAbbreviateIfNecessary op == IFCAR HGET($lowerCaseConTb, op) or op
+
+conname2StringList form == [PNAME unAbbreviateIfNecessary opOf form]
+
+--===========================================================================
+--               Data Gathering Code
+--============================================================================
+dbGatherData(htPage,opAlist,which,key) ==
+  key = 'implementation => dbGatherDataImplementation(htPage,opAlist)
+  dataFunction := LASSOC(key,table) where
+    table ==
+      $dbDataFunctionAlist or
+        ($dbDataFunctionAlist := [
+          ['signatures,:function dbMakeSignature],
+            ['parameters,:function dbContrivedForm],
+              ['origins,:function dbGetOrigin],
+                ['domains,:function dbGetOrigin],
+                  ['conditions,:function dbGetCondition]])
+  null dataFunction =>
+    --key= names or filter or documentation; do not expand
+    if $exposedOnlyIfTrue and not dbFromConstructor?(htPage) then
+      opAlist := --to get indexing correct
+         which = '"operation" => htpProperty(htPage,'opAlist)
+         htpProperty(htPage,'attrAlist)
+    acc := nil
+    initialExposure :=
+      htPage and htpProperty(htPage,'conform) and which ^= '"package operation"
+        => true
+      --never star ops from a constructor
+      nil
+    for [op,:alist] in opAlist repeat
+      exposureFlag := initialExposure
+      while alist repeat
+        item := first alist
+        isExposed? :=
+          STRINGP item => dbExposed?(item,char 'o)   --unexpanded case
+          null (r := rest rest item) => true      --assume true if unexpanded
+          r . 1                                   --expanded case
+        if isExposed? then return (exposureFlag := true)
+        alist := rest alist
+      node :=
+        exposureFlag => op
+        [op,nil]
+      acc := [node,:acc]
+    NREVERSE acc
+  data := nil
+  dbExpandOpAlistIfNecessary(htPage,opAlist,which,key in '(origins documentation),false)
+  --create data, a list of the form ((entry,exposeFlag,:entries)...)
+  for [op,:alist] in opAlist repeat
+    for item in alist repeat
+      entry := FUNCALL(dataFunction,op,item)--get key item
+      exposeFlag :=                         --is the current op-sig exposed?
+        null (r := rest rest item) => true  --not given, assume yes
+        r . 1                               --is  given, use value
+      tail :=
+        item is [.,'ASCONST,:.] => 'ASCONST
+        nil
+      newEntry :=
+        u := ASSOC(entry,data) =>           --key seen before? look on DATA
+          RPLACA(CDR u,CADR u or exposeFlag)--yes, expose if any 1 is exposed
+          u
+        data := [y := [entry,exposeFlag,:tail],:data]
+        y                                   --no, create new entry in DATA
+      if member(key,'(origins conditions)) then
+        r := CDDR newEntry
+        if atom r then r := nil             --clear out possible 'ASCONST
+        RPLACD(CDR newEntry,                --store op/sigs under key if needed
+          insert([dbMakeSignature(op,item),exposeFlag,:tail],r))
+  if member(key,'(origins conditions)) then
+    for entry in data repeat   --sort list of entries (after the 2nd)
+      tail := CDDR entry
+      tail :=
+        atom tail => tail
+        listSort(function LEXLESSEQP,tail)
+      RPLACD(CDR entry,tail)
+  data := listSort(function LEXLESSEQP,data)
+  data
+
+dbGatherDataImplementation(htPage,opAlist) ==
+--returns data, of form ((implementor exposed? entry entry...)...
+--  where entry has form ((op sig . implementor) . stuff)
+  conform := htpProperty(htPage,'conform)
+  domainForm  := htpProperty(htPage,'domname)
+  dom     := EVAL domainForm
+  which   := '"operation"
+  [nam,:$domainArgs] := domainForm
+  $predicateList: local := GETDATABASE(nam,'PREDICATES)
+  predVector := dom.3
+  u := getDomainOpTable(dom,true,ASSOCLEFT opAlist)
+  --u has form ((op,sig,:implementor)...)
+  --sort into 4 groups: domain exports, unexports, default exports, others
+
+  for (x := [.,.,:key]) in u for i in 0.. repeat
+    key = domainForm => domexports := [x,:domexports]
+    INTEGERP key => unexports := [x,:unexports]
+    isDefaultPackageForm? key => defexports := [x,:defexports]
+    key = 'nowhere => nowheres := [x,:nowheres]
+    key = 'constant =>constants := [x,:constants]
+    others := [x,:others]   --add chain domains go here
+  fn [nowheres,constants,domexports,SORTBY('CDDR,NREVERSE others),SORTBY('CDDR,
+               NREVERSE defexports),SORTBY('CDDR,NREVERSE unexports)] where
+    fn l ==
+      alist := nil
+      for u in l repeat
+        while u repeat
+          key := CDDAR u  --implementor
+          entries :=
+            [[CAR u,true],:[u and [CAR u,true] while key = CDDAR (u := rest u)]]
+          alist := [[key,gn key,:entries],:alist]
+      NREVERSE alist
+    gn key ==
+      atom key => true
+      isExposedConstructor CAR key
+
+dbSelectData(htPage,opAlist,key) ==
+  branch := htpProperty(htPage,'branch)
+  data   := htpProperty(htPage,'data)
+  MEMQ(branch,'(signatures parameters)) =>
+    dbReduceOpAlist(opAlist,data.key,branch)
+  MEMQ(branch,'(origins conditions implementation)) =>
+    key < 8192 => dbReduceOpAlist(opAlist,data.key,branch)
+    [newkey,binkey] := DIVIDE(key,8192)  --newkey is 1 too large
+    innerData := CDDR data.(newkey - 1)
+    dbReduceOpAlist(opAlist,innerData.binkey,'signatures)
+  [opAlist . key]
+
+dbReduceOpAlist(opAlist,data,branch) ==
+  branch = 'signatures => dbReduceBySignature(opAlist,CAAR data,CADAR data)
+  branch = 'origins => dbReduceBySelection(opAlist,CAR data,function CADDR)
+  branch = 'conditions => dbReduceBySelection(opAlist,CAR data,function CADR)
+  branch = 'implementation => dbReduceByOpSignature(opAlist,CDDR data)
+  branch = 'parameters => dbReduceByForm(opAlist,CAR data)
+  systemError ['"Unexpected branch: ",branch]
+
+dbReduceByOpSignature(opAlist,datalist) ==
+--reduces opAlist by implementation datalist, one of the form
+--    (((op,sig,:implementor),:stuff),...)
+  ops := [CAAR x for x in datalist] --x is [[op,sig,:implementor],:.]
+  acc := nil
+  for [op,:alist] in opAlist | MEMQ(op,ops) repeat
+    entryList := [entry for (entry := [sig,:.]) in alist | test] where test ==
+      or/[x for x in datalist | x is [[=op,=sig,:.],:.]]
+    entryList => acc := [[op,:NREVERSE entryList],:acc]
+  NREVERSE acc
+
+dbReduceBySignature(opAlist,op,sig) ==
+--reduces opAlist to one with a fixed op and sig
+  [[op,:[x for x in LASSOC(op,opAlist) | x is [=sig,:.]]]]
+
+dbReduceByForm(opAlist,form) ==
+  acc := nil
+  for [op,:alist] in opAlist repeat
+    items := [x for x in alist | dbContrivedForm(op,x) = form] =>
+      acc := [[op,:items],:acc]
+  NREVERSE acc
+
+dbReduceBySelection(opAlist,key,fn) ==
+  acc := nil
+  for [op,:alist] in opAlist repeat
+    items := [x for x in alist | FUNCALL(fn,x) = key] =>
+      acc := [[op,:items],:acc]
+  NREVERSE acc
+
+dbContrivedForm(op,[sig,:.]) ==
+  $which = '"attribute" => [op,sig]
+  dbMakeContrivedForm(op,sig)
+
+dbMakeSignature(op,[sig,:.]) == [op,sig]  --getDomainOpTable format
+
+dbGetOrigin(op,[.,.,origin,:.]) == origin
+
+dbGetCondition(op,[.,pred,:.]) == pred
+
+--dbInsertOpAlist(op,item,opAlist) ==
+--  insertAlist(op,[item,:LASSOC(op,opAlist)],opAlist)
+
+--dbSortOpAlist opAlist ==
+--  [[op,:listSort(function LEXLESSEQP,alist)]
+--    for [op,:alist] in listSort(function LEXLESSEQP,opAlist)]
+
+--============================================================================
+--               Branches of Views
+--============================================================================
+dbShowOpNames(htPage,opAlist,which,data) ==
+  single? := opAlist and null rest data
+  single? =>
+    ops := escapeSpecialChars STRINGIMAGE CAAR opAlist
+    htSayStandard('"Select a view below")
+    htSaySaturn '"Select a view with the right mouse button"
+  exposedOnly? := $exposedOnlyIfTrue and not dbFromConstructor?(htPage)
+  dbShowOpItems(which,data,exposedOnly?)
+
+dbShowOpItems(which,data,exposedOnly?) ==
+  htBeginTable()
+  firstTime := true
+  for i in 0.. for item in data repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&"
+    if atom item then
+      op := item
+      exposeFlag := true
+    else
+      [op,exposeFlag] := item
+    ops := escapeSpecialChars STRINGIMAGE op
+    exposeFlag or not exposedOnly? =>
+      htSay('"{")
+      bcStarSpaceOp(ops,exposeFlag)
+      htMakePage [['bcLinks,[ops,'"",'dbShowOps,which,i]]]
+      htSay('"}")
+  htEndTable()
+
+dbShowOpAllDomains(htPage,opAlist,which) ==
+  dbExpandOpAlistIfNecessary(htPage,opAlist,which,true,false)
+  catOriginAlist := nil --list of category origins
+  domOriginAlist := nil --list of domain origins
+  for [op,:items] in opAlist repeat
+    for [.,predicate,origin,:.] in items repeat
+      conname := CAR origin
+      GETDATABASE(conname,'CONSTRUCTORKIND) = 'category =>
+        pred := simpOrDumb(predicate,LASSQ(conname,catOriginAlist) or true)
+        catOriginAlist := insertAlist(conname,pred,catOriginAlist)
+      pred := simpOrDumb(predicate,LASSQ(conname,domOriginAlist) or true)
+      domOriginAlist := insertAlist(conname,pred,domOriginAlist)
+  --the following is similar to "domainsOf" but do not sort immediately
+  u := [COPY key for key in HKEYS _*HASCATEGORY_-HASH_*
+          | LASSQ(CDR key,catOriginAlist)]
+  for pair in u repeat
+    [dom,:cat] := pair
+    LASSQ(cat,catOriginAlist) = 'etc => RPLACD(pair,'etc)
+    RPLACD(pair,simpOrDumb(GETDATABASE(pair,'HASCATEGORY),true))
+  --now add all of the domains
+  for [dom,:pred] in domOriginAlist repeat
+    u := insertAlist(dom,simpOrDumb(pred,LASSQ(dom,u) or true),u)
+  cAlist := listSort(function GLESSEQP,u)
+  for pair in cAlist repeat RPLACA(pair,getConstructorForm first pair)
+  htpSetProperty(htPage,'cAlist,cAlist)
+  htpSetProperty(htPage,'thing,'"constructor")
+  htpSetProperty(htPage,'specialHeading,'"hoho")
+  dbShowCons(htPage,'names)
+
+simpOrDumb(new,old) ==
+  new = 'etc => 'etc
+  atom new => old
+  'etc
+
+dbShowOpOrigins(htPage,opAlist,which,data) ==
+  dbGatherThenShow(htPage,opAlist,which,data,true,'"from",function bcStarConform)
+
+dbShowOpImplementations(htPage,opAlist,which,data) ==
+  dbGatherThenShow(htPage,opAlist,which,data,true,'"by",function bcStarConform)
+
+dbShowOpConditions(htPage,opAlist,which,data) ==
+  dbGatherThenShow(htPage,opAlist,which,data,nil,nil,function bcPred)
+
+dbGatherThenShow(htPage,opAlist,which,data,constructorIfTrue,word,fn) ==
+-----------------> OBSELETE
+  single? := null rest data
+  htSay('"\beginmenu ")
+  bincount := 0
+  for [thing,exposeFlag,:items] in data repeat
+    htSay('"\item ")
+    if single? then htSay(menuButton())
+    else htMakePage [['bcLinks,[menuButton(),'"",'dbShowOps,which,bincount]]]
+    htSay '"{\em "
+    htSay
+      thing = 'nowhere => '"implemented nowhere"
+      thing = 'constant => '"constant"
+      thing = '_$ => '"by the domain"
+      INTEGERP thing => '"unexported"
+      constructorIfTrue =>
+        htSay word
+        atom thing => '" an unknown constructor"
+        '""
+      atom thing => '"unconditional"
+      '""
+    htSay '"}"
+    if null atom thing then
+      if constructorIfTrue then htSay('" {\em ",dbShowKind thing,'"}")
+      htSay '" "
+      FUNCALL(fn,thing)
+    htSay('":\newline ")
+    dbShowOpSigList(which,items,(1 + bincount) * 8192)
+    bincount := bincount + 1
+  htSay '"\endmenu "
+
+dbShowKind conform ==
+  conname := CAR conform
+  kind := GETDATABASE(conname,'CONSTRUCTORKIND)
+  kind = 'domain =>
+    (s := PNAME conname).(MAXINDEX s) = '_& => '"default package"
+    '"domain"
+  PNAME kind
+
+dbShowOpSignatures(htPage,opAlist,which,data) == dbShowOpSigList(which,data,0)
+
+dbShowOpSigList(which,dataItems,count) ==
+--dataItems is (((op,sig,:.),exposureFlag,...)
+  single? := null rest dataItems
+  htBeginTable()
+  firstTime := true
+  for [[op,sig,:.],exposureFlag,:tail] in dataItems repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&";
+    ops := escapeSpecialChars STRINGIMAGE op
+    htSay '"{"
+--  if single? then htSay('"{\em ",ops,'"}") else.....
+    htSayExpose(ops,exposureFlag)
+    htMakePage [['bcLinks,[ops,'"",'dbShowOps,which,count]]]
+    if which = '"attribute" then htSay args2HtString (sig and [sig]) else
+      htSay '": "
+      tail = 'ASCONST => bcConform first sig
+      bcConform ['Mapping,:sig]
+    htSay '"}"
+    count := count + 1
+  htEndTable()
+  count
+
+dbShowOpParameters(htPage,opAlist,which,data) ==
+  single? := null rest data
+  count := 0
+  htBeginTable()
+  firstTime := true
+  for item in data repeat
+    if firstTime then firstTime := false
+    else htSaySaturn '"&"
+    [opform,exposeFlag,:tail] := item
+    op := intern IFCAR opform
+    args := IFCDR opform
+    ops := escapeSpecialChars STRINGIMAGE op
+    htSay '"{"
+    htSayExpose(ops,exposeFlag)
+    n := #opform
+    do
+      n = 2 and LASSOC('Nud,PROPLIST op) =>
+        dbShowOpParameterJump(ops,which,count,single?)
+        htSay('" {\em ",KAR args,'"}")
+      n = 3 and LASSOC('Led,PROPLIST op) =>
+        htSay('"{\em ",KAR args,'"} ")
+        dbShowOpParameterJump(ops,which,count,single?)
+        htSay('" {\em ",KAR KDR args,'"}")
+      dbShowOpParameterJump(ops,which,count,single?)
+      tail = 'ASCONST or member(op,'(0 1)) or which = '"attribute" and null IFCAR args => 'skip
+      htSay('"(")
+      if IFCAR args then htSay('"{\em ",IFCAR args,'"}")
+      for x in IFCDR args repeat
+        htSay('",{\em ",x,'"}")
+      htSay('")")
+    htSay '"}"
+    count := count + 1
+  htEndTable()
+
+dbShowOpParameterJump(ops,which,count,single?) ==
+  single? => htSay('"{\em ",ops,'"}")
+  htMakePage [['bcLinks,[ops,'"",'dbShowOps,which,count]]]
+
+dbShowOpDocumentation(htPage,opAlist,which,data) ==
+  if $exposedOnlyIfTrue and not dbFromConstructor?(htPage) then
+    opAlist :=
+      which = '"operation" => htpProperty(htPage,'opAlist)
+      htpProperty(htPage,'attrAlist)
+    --NOTE: this line is necessary to get indexing right.
+    --The test below for $exposedOnlyIfTrue causes unexposed items
+    --to be skipped.
+  newWhich :=
+    conform := htpProperty(htPage,'domname) or htpProperty(htPage,'conform)
+    which = '"package operation" => '"operation"
+    which
+  expand := dbExpandOpAlistIfNecessary(htPage,opAlist,which,true,false)
+  if expand then
+    condata := dbGatherData(htPage,opAlist,which,'conditions)
+    htpSetProperty(htPage,'conditionData,condata)
+  base := -8192
+  exactlyOneOpSig := opAlist is [[.,.]] --checked by displayDomainOp
+  htSaySaturn '"\begin{description}"
+  for [op,:alist] in opAlist repeat
+    base := 8192 + base
+    for item in alist for j in 0.. repeat
+      [sig,predicate,origin,exposeFlag,comments] := item
+      exposeFlag or not $exposedOnlyIfTrue =>
+        if comments ^= '"" and STRINGP comments and (k := string2Integer comments) then
+          comments :=
+            MEMQ(k,'(0 1)) => '""
+            dbReadComments k
+          tail := CDDDDR item
+          RPLACA(tail,comments)
+        doc := (STRINGP comments and comments ^= '"" => comments; nil)
+        pred := predicate or true
+        index := (exactlyOneOpSig => nil; base + j)
+        if which = '"package operation" then
+          sig    := SUBST(conform,'_$,sig)
+          origin := SUBST(conform,'_$,origin)
+        displayDomainOp(htPage,newWhich,origin,op,sig,pred,doc,index,'dbChooseDomainOp,null exposeFlag,true)
+  htSaySaturn '"\end{description}"
+
+dbChooseDomainOp(htPage,which,index) ==
+  [opKey,entryKey] := DIVIDE(index,8192)
+  opAlist :=
+    which = '"operation" => htpProperty(htPage,'opAlist)
+    htpProperty(htPage,'attrAlist)
+  [op,:entries] := opAlist . opKey
+  entry := entries . entryKey
+  htPage := htInitPageNoScroll(htCopyProplist htPage)
+  if which = '"operation"
+    then htpSetProperty(htPage,'opAlist,[[op,entry]])
+    else htpSetProperty(htPage,'attrAlist,[[op,entry]])
+  if not htpProperty(htPage,'condition?) = 'no then
+    dbResetOpAlistCondition(htPage,which,opAlist)
+  dbShowOps(htPage,which,'documentation)
+
+htSayExpose(op,flag) ==
+  $includeUnexposed? =>
+    flag => htBlank()
+    op.0 = char '_* => htSay '"{\em *} "
+    htSayUnexposed()
+  htSay '""
+--============================================================================
+--               Branch-in From Other Places
+--============================================================================
+dbShowOperationsFromConform(htPage,which,opAlist) ==  --branch in with lists
+  $groupChoice := nil
+  conform := htpProperty(htPage,'conform)
+  --prepare opAlist for possible filtering of groups
+  if null BOUNDP '$topicHash then
+    $topicHash := MAKE_-HASHTABLE 'ID
+    for [x,:c] in '((extended . 0) (basic . 1) (hidden . 2)) repeat
+      HPUT($topicHash,x,c)
+  if domform := htpProperty(htPage,'domname) then
+    $conformsAreDomains : local := true
+    reduceOpAlistForDomain(opAlist,domform,conform)
+  conform := domform or conform
+  kind := capitalize htpProperty(htPage,'kind)
+  exposePart :=
+    isExposedConstructor opOf conform => '""
+    '" Unexposed "
+  fromPart :=
+    domform => evalableConstructor2HtString domform
+    form2HtString conform
+  heading :=
+    ['" from ",exposePart,kind,'" {\em ",fromPart,'"}"]
+  expandProperty :=
+    which = '"operation" => 'expandOperations
+    'expandAttributes
+  htpSetProperty(htPage,expandProperty,'lists)
+  htpSetProperty(htPage,'fromHeading,heading)
+  reducedOpAlist :=
+    which = '"operation" =>  reduceByGroup(htPage,opAlist)
+    opAlist
+  if which = '"operation"
+    then
+      htpSetProperty(htPage,'principalOpAlist,opAlist)
+      htpSetProperty(htPage,'opAlist,reducedOpAlist)
+    else htpSetProperty(htPage,'attrAlist,opAlist)
+  if domform
+   then htpSetProperty(htPage,'condition?,'no)
+   else dbResetOpAlistCondition(htPage,which,opAlist)
+  dbShowOp1(htPage,reducedOpAlist,which,'names)
+
+reduceOpAlistForDomain(opAlist,domform,conform) ==
+--destructively simplify all predicates; filter out any that fail
+  form1 := [domform,:rest domform]
+  form2 := ['$,:rest conform]
+  for pair in opAlist repeat
+    RPLACD(pair,[test for item in rest pair | test]) where test ==
+      [head,:tail] := item
+      CAR tail = true => item
+      pred := simpHasPred SUBLISLIS(form1,form2,QCAR tail)
+      null pred => false
+      RPLACD(item,[pred])
+      item
+  opAlist
+
+dbShowOperationLines(which,linelist) ==  --branch in with lines
+  htPage := htInitPage(nil,nil)  --create empty page
+  opAlist := nil
+  lines := linelist
+  while lines repeat
+    name := dbName (x := first lines)
+    pile := [x]
+    while (lines := rest lines) and name = dbName (x := first lines) repeat
+      pile := [x,:pile]
+    opAlist := [[name,:NREVERSE pile],:opAlist]
+  opAlist := listSort(function LEXLESSEQP,NREVERSE opAlist)
+  if which = '"operation"
+    then htpSetProperty(htPage,'opAlist,opAlist)
+    else htpSetProperty(htPage,'attrAlist,opAlist)
+  expandProperty :=
+    which = '"operation" => 'expandOperations
+    'expandAttributes
+  htpSetProperty(htPage,expandProperty,'strings)
+  dbResetOpAlistCondition(htPage,which,opAlist)
+  if which = '"attribute" and BOUNDP '$attributeArgs and $attributeArgs then
+    --code needed to handle commutative("*"); called from aPage
+    --must completely expand the opAlist then check for those with
+    --arguments equal to $attributeArgs
+    --here: opAlist is [[op,:itemlist]]
+    dbExpandOpAlistIfNecessary(htPage,opAlist,which,false,false)
+    opAlist := [[CAAR opAlist,:[item for item in CDAR opAlist | first item = $attributeArgs]]]
+  dbShowOp1(htPage,opAlist,which,'names)
+
+--============================================================================
+--                Code to Expand opAlist
+--============================================================================
+dbResetOpAlistCondition(htPage,which,opAlist) ==
+  value := dbExpandOpAlistIfNecessary(htPage,opAlist,which,false,true)
+  htpSetProperty(htPage,'condition?,(value => 'yes; 'no))
+  value
+
+dbSetOpAlistCondition(htPage,opAlist,which) ==
+--called whenever a new opAlist is needed
+--property can only be inherited if 'no (a subset says NO if whole says NO)
+  condition := htpProperty(htPage,'condition?)
+  MEMQ(condition,'(yes no)) => condition = 'yes
+  value := dbExpandOpAlistIfNecessary(htPage,opAlist,which,false,true)
+  htpSetProperty(htPage,'condition?,(value => 'yes; 'no))
+  value
+
+dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) ==
+--if condition? = true, stop when you find a non-trivial predicate
+--otherwise, expand in full
+--RETURNS:
+--  non-trivial predicate, if condition? = true and it finds one
+--  nil,                   otherwise
+--SIDE-EFFECT: this function references the "expand" property (set elsewhere):
+--  'strings, if not fully expanded and it contains strings
+--            i.e. opAlist is ((op . (string ...))...) if unexpanded
+--  'lists,   if not fully expanded and it contains lists
+--            i.e. opAlist is ((op . ((sig pred) ...))...) if unexpanded
+    condition? := condition? and not $exposedOnlyIfTrue
+    value      := nil  --return value
+    expandProperty :=
+      which = '"operation" => 'expandOperations
+      'expandAttributes
+    expandFlag := htpProperty(htPage,expandProperty)
+    expandFlag = 'fullyExpanded => nil
+    expandFlag = 'strings => --strings are partially expanded
+      for pair in opAlist repeat
+        [op,:lines] := pair
+        acc := nil
+        for line in lines repeat
+        --NOTE: we must expand all lines here for a given op
+        --      since below we will change opAlist
+        --Case 1: Already expanded; just cons it onto ACC
+          null STRINGP line => --already expanded
+            if condition? then --this could have been expanded at a lower level
+              if null atom (pred := CADR line) then value := pred
+            acc := [line,:acc] --this one is already expanded; record it anyway
+        --Case 2: unexpanded; expand it then cons it onto ACC
+          [name,nargs,xflag,sigs,conname,pred,comments] := dbParts(line,7,1)
+          predicate := ncParseFromString pred
+          if condition? and null atom predicate then value := predicate
+          sig := ncParseFromString sigs --is (Mapping,:.)
+          if which = '"operation" then
+            if sig isnt ['Mapping,:.]
+            then sayBrightly ['"Unexpected signature for ",name,'": ",sigs]
+            else sig := rest sig
+          conname := intern dbNewConname line
+          origin := [conname,:getConstructorArgs conname]
+          exposeFlag := dbExposed?(line,char 'o)
+          acc := [[sig,predicate,origin,exposeFlag,comments],:acc]
+        --always store the fruits of our labor:
+        RPLACD(pair,NREVERSE acc)             --at least partially expand it
+        condition? and value => return value  --early exit
+      value => value
+      condition? => nil
+      htpSetProperty(htPage,expandProperty,'fullyExpanded)
+    expandFlag = 'lists => --lists are partially expanded
+      -- entry is [sig, predicate, origin, exposeFlag, comments]
+      $value: local := nil
+      $docTableHash := MAKE_-HASHTABLE 'EQUAL
+      packageSymbol := false
+      domform := htpProperty(htPage,'domname) or htpProperty(htPage,'conform)
+      if isDefaultPackageName opOf domform then
+         catname := intern SUBSTRING(s := PNAME opOf domform,0,MAXINDEX s)
+         packageSymbol := first rest domform
+         domform := [catname,:rest rest domform]  --skip first argument ($)
+      docTable:= dbDocTable domform
+      for [op,:alist] in opAlist repeat
+        for [sig,:tail] in alist repeat
+          condition? => --the only purpose here is to find a non-trivial pred
+            null atom (pred := CAR tail) => return ($value := pred)
+            'skip
+          u :=
+            tail is [.,origin,:.] and origin =>
+--  must change any % into $ otherwise we will not pick up comments properly
+--  delete the SUBLISLIS when we fix on % or $ 
+              dbGetDocTable(op,SUBLISLIS(['$],['%],sig),dbDocTable origin,which,nil)
+            if packageSymbol then sig := SUBST('_$,packageSymbol,sig)
+            dbGetDocTable(op,sig,docTable,which,nil)
+          origin := IFCAR u or origin
+          docCode := IFCDR u   --> (doc . code)
+--        if null FIXP CDR docCode then harhar(op) -->
+          if null doc and which = '"attribute" then doc := getRegistry(op,sig)
+          RPLACD(tail,[origin,isExposedConstructor opOf origin,:docCode])
+        $value => return $value
+      $value => $value
+      condition? => nil
+      htpSetProperty(htPage,expandProperty,'fullyExpanded)
+    'done
+
+getRegistry(op,sig) ==
+  u := GETDATABASE('AttributeRegistry,'DOCUMENTATION)
+  v := LASSOC(op,u)
+  match := or/[y for y in v | y is [['attribute,: =sig],:.]] => CADR match
+  '""
+
+evalableConstructor2HtString domform ==
+  if VECP domform then domform := devaluate domform
+  conname := first domform
+  coSig   := rest GETDATABASE(conname,'COSIG)
+  --entries are T for arguments which are domains; NIL for computational objects
+  and/[x for x in coSig] => form2HtString(domform,nil,true)
+  arglist := [unquote x for x in rest domform] where
+    unquote arg  ==
+      arg is [f,:args] =>
+        f = 'QUOTE => first args
+        [f,:[unquote x for x in args]]
+      arg
+  fargtypes:=CDDAR GETDATABASE(conname,'CONSTRUCTORMODEMAP)
+--argtypes:= sublisFormal(arglist,fargtypes)
+  form2HtString([conname,:[fn for arg in arglist for x in coSig
+                   for ftype in fargtypes]],nil,true) where
+    fn ==
+      x => arg
+      typ := sublisFormal(arglist,ftype)
+      mathform2HtString algCoerceInteractive(arg,typ,'(OutputForm))
+
+mathform2HtString form == escapeString
+  $fortInts2Floats: local := false
+  form := niladicHack form
+  form is ['QUOTE,a] => STRCONC('"'","STRCONC"/fortexp0 a)
+  form is ['BRACKET,['AGGLST,:arg]] =>
+    if arg is ['construct,:r] then arg := r
+    arg :=
+      atom arg => [arg]
+      [y for x in arg | y := (x is ['QUOTE,a] => a; x)]
+    tailPart := "STRCONC"/[STRCONC('",",STRINGIMAGE x) for x in rest arg]
+    STRCONC('"[",STRINGIMAGE first arg,tailPart,'"]")
+  form is ['BRACKET,['AGGLST,'QUOTE,arg]] =>
+    if atom arg then arg := [arg]
+    tailPart := "STRCONC"/[STRCONC('",",x) for x in rest arg]
+    STRCONC('"[",first arg,tailPart,'"]")
+  atom form => form
+  "STRCONC"/fortexp0 form
+
+niladicHack form ==
+  atom form => form
+  form is [x] and GETL(x,'NILADIC) => x
+  [niladicHack x for x in form]
+
+--============================================================================
+--                Getting Operations from Domain
+--============================================================================
+
+getDomainOpTable(dom,fromIfTrue,:options) ==
+  ops := KAR options
+  $predEvalAlist : local := nil
+  $returnNowhereFromGoGet: local := true
+  domname := dom.0
+  conname := CAR domname
+  abb := getConstructorAbbreviation conname
+  opAlist := getOperationAlistFromLisplib conname
+  "append"/[REMDUP [[op1,:fn] for [sig,slot,pred,key,:.] in u
+              | key ^= 'Subsumed and ((null ops and (op1 := op)) or (op1 := memq(op,ops)))]
+                 for [op,:u] in opAlist] where
+    memq(op,ops) ==   --dirty trick to get 0 and 1 instead of Zero and One
+      MEMQ(op,ops) => op
+      EQ(op,'One)  => MEMQ(1,ops) and 1
+      EQ(op,'Zero) => MEMQ(0,ops) and 0
+      false
+    fn ==
+      sig1 := sublisFormal(rest domname,sig)
+      predValue := evalDomainOpPred(dom,pred)
+      info :=
+        null predValue =>
+          1   -- signifies not exported
+        null fromIfTrue => nil
+        cell := compiledLookup(op,sig1,dom) =>
+          [f,:r] := cell
+          f = 'nowhere => 'nowhere           --see replaceGoGetSlot
+          f = 'makeSpadConstant => 'constant
+          f = function IDENTITY => 'constant
+          f = 'newGoGet => SUBST('_$,domname,devaluate CAR r)
+          null VECP r => systemError devaluateList r
+          SUBST('_$,domname,devaluate r)
+        'nowhere
+      [sig1,:info]
+
+evalDomainOpPred(dom,pred) == process(dom,pred) where
+  process(dom,pred) ==
+    u := convert(dom,pred)
+    u = 'T => true
+    evpred(dom,u)
+  convert(dom,pred) ==
+    pred is [op,:argl] =>
+      MEMQ(op,'(AND and)) => ['AND,:[convert(dom,x) for x in argl]]
+      MEMQ(op,'(OR or))   => ['OR,:[convert(dom,x) for x in argl]]
+      MEMQ(op,'(NOT not)) => ['NOT,convert(dom,first argl)]
+      op = 'has =>
+        [arg,p] := argl
+        p is ['ATTRIBUTE,a] => ['HasAttribute,arg,MKQ a]
+        ['HasCategory,arg,convertCatArg p]
+      systemError '"unknown predicate form"
+    pred = 'T => true
+    systemError nil
+  convertCatArg p ==
+    atom p or #p = 1 => MKQ p
+    ['LIST,MKQ first p,:[convertCatArg x for x in rest p]]
+  evpred(dom,pred) ==
+    k := POSN1(pred,$predicateList) => testBitVector(dom.3,k + 1)
+    evpred1(dom,pred)
+  evpred1(dom,pred) ==
+    pred is [op,:argl] =>
+      MEMQ(op,'(AND and)) => "and"/[evpred1(dom,x) for x in argl]
+      MEMQ(op,'(OR or))   =>  "or"/[evpred1(dom,x) for x in argl]
+      op = 'NOT => not evpred1(dom,first argl)
+      k := POSN1(pred,$predicateList) => testBitVector(dom.3,k + 1)
+      op = 'HasAttribute =>
+        [arg,[.,a]] := argl
+        attPredIndex := LASSOC(a,dom.2)
+        null attPredIndex  => nil
+        attPredIndex = 0 => true
+        testBitVector(dom.3,attPredIndex)
+      nil
+    pred = 'T => true
+    systemError '"unknown atomic predicate form"
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}