remove pamphlets - part 4

1 files changed, 0 insertions, 1161 deletions

diff --git a/src/interp/br-op1.boot.pamphlet b/src/interp/br-op1.boot.pamphlet
deleted file mode 100644
index aea5b89b..00000000
--- a/src/interp/br-op1.boot.pamphlet
+++ /dev/null
@@ -1,1161 +0,0 @@
-\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}