1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
2-- All rights reserved.
3--
4-- Redistribution and use in source and binary forms, with or without
5-- modification, are permitted provided that the following conditions are
6-- met:
7--
8--     - Redistributions of source code must retain the above copyright
9--       notice, this list of conditions and the following disclaimer.
10--
11--     - Redistributions in binary form must reproduce the above copyright
12--       notice, this list of conditions and the following disclaimer in
13--       the documentation and/or other materials provided with the
14--       distribution.
15--
16--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
17--       names of its contributors may be used to endorse or promote products
18--       derived from this software without specific prior written permission.
19--
20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31
32)package "BOOT"
33
34--====================> WAS br-op2.boot <================================
35
36--=======================================================================
37--                   Operation Description
38--=======================================================================
39
40htSayConstructor(key, u) ==
41  u is ['CATEGORY,kind,:r] =>
42    htSayList(['"a ", kind, '" "])
43    htSayExplicitExports(r)
44  key = 'is =>
45    htSay '"the domain "
46    bcConform(u,true)
47  htSay
48    key = 'is => '"the domain "
49    kind := GETDATABASE(opOf u,'CONSTRUCTORKIND)
50    kind = 'domain => '"an element of "
51    '"a domain of "
52  u is ['Join,:middle,r] =>
53    rest middle =>
54      htSay '"categories "
55      bcConform(first middle,true)
56      for x in rest middle repeat
57        htSay '", "
58        bcConform(x,true)
59      r is ['CATEGORY,.,:r] =>
60        htSay '" and "
61        htSayExplicitExports(r)
62      htSay '" and "
63      bcConform(r,true)
64    htSay '"category "
65    bcConform(first middle,true)
66    r is ['CATEGORY,.,:r] =>
67     htSay '" "
68     htSayExplicitExports(r)
69    htSay '" and "
70    bcConform(r,true)
71  htSayList([kind, '" "])
72  bcConform(u, true)
73
74htSayExplicitExports r ==
75  htSay '"with explicit exports"
76  $displayReturnValue => nil
77  htSay '":"
78  for x in r repeat
79    htSay '"\newline "
80    x is ['SIGNATURE,op,sig] =>
81      ops := escapeSpecialChars STRINGIMAGE op
82      htMakePage [['bcLinks,[ops,'"",'oPage,ops]]]
83      htSay '": "
84      bcConform ['Mapping,:sig]
85    x is ['ATTRIBUTE, a] => BREAK()
86    x is ['IF,:.] =>
87      htSay('"{\em if ...}")
88    systemError()
89
90displayBreakIntoAnds pred ==
91  pred is [op,:u] and member(op,'(and AND)) => u
92  [pred]
93
94htSayValue t ==
95  t is ['Mapping,target,:source] =>
96      htSay('"a function from ")
97      htSayTuple source
98      htSay '" to "
99      htSayArgument target
100  t = '(Category) => htSay('"a category")
101  t is [op,:.] and MEMQ(op,'(Join CATEGORY)) or constructor? opOf t =>
102    htSayConstructor(nil,t)
103  htSay('"an element of domain ")
104  htSayArgument t                            --continue for operations
105
106htSayArgument t == --called only for operations not for constructors
107  null $signature => htSay ['"{\em ",t,'"}"]
108  MEMQ(t, '(_$ _%)) =>
109    $conkind = '"category" and $conlength > 20 =>
110      $generalSearch? => htSay '"{\em D} of the origin category"
111      addWhereList("$",'is,nil)
112      htSayStandard '"{\em $}"
113    htSayStandard '"{\em $}"
114  not IDENTP t => bcConform(t,true)
115  k := position(t,$conargs)
116  if k > -1 then
117    typeOfArg := (rest $signature).k
118    addWhereList(t,'member,typeOfArg)
119  htSayList(['"{\em ", t, '"}"])
120
121addWhereList(id,kind,typ) ==
122  $whereList := insert([id,kind,:typ],$whereList)
123
124htSayTuple t ==
125  null t => htSay '"()"
126  null rest t => htSayArgument first t
127  htSay '"("
128  htSayArgument first t
129  for d in rest t repeat
130    htSay '","
131    htSayArgument d
132  htSay '")"
133
134dbGetDisplayFormForOp(op,sig,doc) ==
135  dbGetFormFromDocumentation(op,sig,doc) or dbGetContrivedForm(op,sig)
136
137dbGetFormFromDocumentation(op,sig,x) ==
138  $ncMsgList : local := nil
139  $newcompErrorCount : local := 0
140  doc := (STRINGP x => x; first x)
141  STRINGP doc and
142     (stringPrefix?('"\spad{",doc) and (k := 6) or
143       stringPrefix?('"\s{",doc) and (k := 3)) =>
144    n := charPosition($charRbrace,doc,k)
145    s := SUBSTRING(doc,k,n - k)
146    parse := ncParseFromString s
147    parse is [=op,:.] and #parse = #sig => parse
148  nil
149
150dbMakeContrivedForm(op, sig) ==
151  $chooseDownCaseOfType : local := false
152  $NumberList : local := '(i j k l m n i1 j1 k1 l1 m1 n1 i2 j2 k2 l2 m2 n2 i3 j3 k3 l3 m3 n3 i4 j4 k4 l4 m4 n4 )
153  $ElementList: local := '(x y z u v w x1 y1 z1 u1 v1 w1 x2 y2 z2 u2 v2 w2 x3 y3 z3 u3 v3 w3 x4 y4 z4 u4 v4 w4 )
154  $FunctionList:local := '(f g h d e F G H)
155  $DomainList:  local := '(R S D E T A B C M N P Q U V W)
156  dbGetContrivedForm(op,sig)
157
158dbGetContrivedForm(op,sig) ==
159  op = '"0" => [0]
160  op = '"1" => [1]
161  [op,:[dbChooseOperandName s for s in rest sig]]
162
163dbChooseOperandName(typ) ==
164  typ is ['Mapping,:.] =>
165    x := first $FunctionList
166    $FunctionList := rest $FunctionList
167    x
168  name := opOf typ
169  kind :=
170    name = "$" => 'domain
171    GETDATABASE(name,'CONSTRUCTORKIND)
172  s := PNAME opOf typ
173  kind ~= 'category =>
174    anySubstring?('"Integer",s,0) or anySubstring?('"Number",s,0) =>
175      x := first $NumberList
176      $NumberList := rest $NumberList
177      x
178    x :=
179      $chooseDownCaseOfType =>
180        y := DOWNCASE typ
181        x :=
182          member(y,$ElementList) => y
183          first $ElementList
184      first $ElementList
185    $ElementList := delete(x,$ElementList)
186    x
187  x := first $DomainList
188  $DomainList := rest $DomainList
189  x
190
191getSubstSigIfPossible sig ==
192  getSubstSignature sig or sig
193
194--
195--  while (u := getSubstSignature sig) repeat
196--     sig := u
197--  sig
198
199fullSubstitute(x,y,z) ==  --substitutes deeply: x for y in list z
200  z = y => x
201  atom z => z
202  [fullSubstitute(x,y,u) for u in z]
203
204getSubstCandidates sig ==
205  candidates := nil
206  for x in sig for i in 1.. | x is [.,.,:.] repeat
207    getSubstQualify(x,i,sig) => candidates := getSubstInsert(x,candidates)
208    y := or/[getSubstQualify(y,i,sig) for y in rest x | y is [.,.,:.]] =>
209      candidates := insert(y,candidates)
210  candidates
211
212getSubstSignature sig ==
213    candidates := getSubstCandidates sig
214    null candidates => nil
215    D := first $DomainList
216    $DomainList := rest $DomainList
217    winner := first candidates
218    newsig := fullSubstitute(D,winner,sig)
219    sig :=
220      null rest candidates => newsig
221      count := NUMOFNODES newsig
222      for x in rest candidates repeat
223        trial := fullSubstitute(D,x,sig)
224        trialCount := NUMOFNODES trial
225        trialCount < count =>
226          newsig := trial
227          count  := trialCount
228          winner := x
229      newsig
230    addWhereList(D,'is,winner)
231    newsig
232
233getSubstQualify(x,i,sig) ==
234    or/[CONTAINED(x,y) for y in sig for j in 1.. | j ~= i] => x
235    false
236
237getSubstInsert(x,candidates) ==
238    return insert(x,candidates)
239    null candidates => [x]
240    or/[CONTAINED(x,y) for y in candidates] => candidates
241    y := or/[CONTAINED(y, x) for y in candidates] =>
242        substitute(x, y, candidates)
243    candidates
244
245
246--=======================================================================
247--                      Who Uses
248--=======================================================================
249whoUsesOperation(htPage,which,key) ==  --see dbPresentOps
250  key = 'filter => koaPageFilterByName(htPage,'whoUsesOperation)
251  opAlist := htpProperty(htPage,'opAlist)
252  conform := htpProperty(htPage,'conform)
253  conargs := rest conform
254  opl := nil
255  for [op,:alist] in opAlist repeat
256    for [sig,:.] in alist repeat
257      opl := [[op,:SUBLISLIS($FormalMapVariableList,rest conform,sig)],:opl]
258  opl := NREVERSE opl
259  u := whoUses(opl,conform)
260  prefix := pluralSay(#u,'"constructor uses",'"constructors use")
261  suffix :=
262    opAlist is [[op1,.]] =>
263      ['" operation {\em ",escapeSpecialChars STRINGIMAGE op1,'":",form2HtString ['Mapping,:sig],'"}"]
264    ['" these operations"]
265  page := htInitPage([:prefix,:suffix],htCopyProplist htPage)
266  nopAlist := nil
267  for [name,:opsigList] in u repeat
268    for opsig in opsigList repeat
269      sofar    := LASSOC(opsig,nopAlist)
270      nopAlist := insertAlist(opsig,[name,:LASSOC(opsig,nopAlist)],nopAlist)
271  usedList := nil
272  for [pair := [op,:sig],:namelist] in nopAlist repeat
273    ops := escapeSpecialChars STRINGIMAGE op
274    usedList := [pair,:usedList]
275    htSayList(['"Users of {\em ", ops, '": "])
276    bcConform ['Mapping,:sublisFormal(conargs,sig)]
277    htSay('"}\newline")
278    bcConTable listSort(function GLESSEQP,REMDUP namelist)
279  noOneUses := SETDIFFERENCE(opl,usedList)
280  if #noOneUses > 0 then
281    htSay('"No constructor uses the ")
282    htSay
283      #noOneUses = 1 => '"operation: "
284      [#noOneUses,'" operations:"]
285    htSay '"\newline "
286    for [op,:sig] in noOneUses repeat
287      htSayList(['"\tab{2}{\em ", escapeSpecialChars STRINGIMAGE op, '": "])
288      bcConform ['Mapping,:sublisFormal(conargs,sig)]
289      htSay('"}\newline")
290  htSayStandard '"\endscroll "
291  dbPresentOps(page,which,'usage)
292  htShowPageNoScroll()
293
294whoUses(opSigList,conform) ==
295  opList := REMDUP ASSOCLEFT opSigList
296  numOfArgsList := REMDUP [-1 + #sig for [.,:sig] in opSigList]
297  acc  := nil
298  $conname : local := first conform
299  domList := getUsersOfConstructor $conname
300  hash := MAKE_HASHTABLE('EQUAL)
301  for name in allConstructors() | MEMQ(name,domList) repeat
302    $infovec : local := dbInfovec name
303    null $infovec => 'skip           --category
304    template := $infovec . 0
305    found := false
306    opacc := nil
307    for i in 7..MAXINDEX template repeat
308      item := template . i
309      item isnt [n,:op] or not MEMQ(op,opList) => 'skip
310      index := n
311      numvec := getCodeVector()
312      numOfArgs := numvec . index
313      null member(numOfArgs,numOfArgsList) => 'skip
314      whereNumber := numvec.(index := index + 1)
315      template . whereNumber isnt [= $conname,:.] => 'skip
316      signumList := dcSig(numvec,index + 1,numOfArgs)
317      opsig := or/[pair for (pair := [op1,:sig]) in opSigList | op1 = op and whoUsesMatch?(signumList,sig,nil)]
318        => opacc := [opsig,:opacc]
319    if opacc then acc := [[name,:opacc],:acc]
320  acc
321
322whoUsesMatch?(signumList,sig,al) ==
323  #signumList = #sig and whoUsesMatch1?(signumList,sig,al)
324
325whoUsesMatch1?(signumList,sig,al) ==
326  signumList is [subject,:r] and sig is [pattern,:s] =>
327    x := LASSOC(pattern,al) =>
328      x = subject => whoUsesMatch1?(r,s,al)
329      false
330    pattern = '_$ =>
331      subject is [= $conname,:.] => whoUsesMatch1?(r,s,[['_$,:subject],:al])
332      false
333    whoUsesMatch1?(r,s,[[pattern,:subject],:al])
334  true
335
336--=======================================================================
337--                   Get Attribute/Operation Alist
338--=======================================================================
339
340koAttrs(conform,domname) ==
341  [conname,:args] := conform
342--asharpConstructorName? conname => nil  --assumed
343  'category = GETDATABASE(conname,'CONSTRUCTORKIND) =>
344      koCatAttrs(conform,domname)
345  $infovec: local := dbInfovec conname or return nil
346  $predvec: local :=
347    $domain => $domain . 3
348    GETDATABASE(conname,'PREDICATES)
349  u := [[a,:pred] for [a,:i] in $infovec . 2 | a ~= 'nil and (pred := sublisFormal(args,kTestPred i))]
350                                               ---------  CHECK for a = nil
351  listSort(function GLESSEQP,fn u) where fn u ==
352    alist := nil
353    for [a,:pred] in u repeat
354      op := opOf a
355      args := IFCDR a
356      alist := insertAlist(op,insertAlist(args,[pred],LASSOC(op,alist)),alist)
357    alist
358
359koOps(conform, domname) == main where
360--returns alist of form ((op (sig . pred) ...) ...)
361  main ==
362    $packageItem: local := nil
363    ours := fn(conform, domname)
364    listSort(function GLESSEQP,trim ours)
365  trim u == [pair for pair in u | IFCDR pair]
366  fn(conform,domname) ==
367    conform := domname or conform
368    [conname,:args] := conform
369    subargs: local := args
370    ----------> new <------------------
371    u := koCatOps(conform,domname) => u
372--    'category = GETDATABASE(conname,'CONSTRUCTORKIND) =>
373--        koCatOps(conform,domname)
374    asharpConstructorName? opOf conform => nil
375    ----------> new <------------------
376    $infovec: local := dbInfovec conname--------> removed 94/10/24
377    exposureTail :=
378      null $packageItem => '(NIL NIL)
379      isExposedConstructor opOf conform => [conform,:'(T)]
380      [conform,:'(NIL)]
381    for [op,:u] in getOperationAlistFromLisplib conname repeat
382      op1 := zeroOneConvert op
383      acc :=
384          [[op1, :[[sig, npred, :exposureTail]
385                    for [sig, slot, pred, key, :.] in sublisFormal(subargs,u)
386                   | npred := simpHasPred(pred)]], :acc]
387    acc
388  merge(alist,alist1) == --alist1 takes precedence
389    for [op,:al] in alist1 repeat
390      u := LASSOC(op,alist) =>
391        for [sig,:item] in al | not LASSOC(sig,u) repeat
392          u := insertAlist(sig,item,u)
393        alist := insertAlist(op,u,DELASC(op,alist)) --add the merge of two alists
394      alist := insertAlist(op,al,alist)  --add the whole inner alist
395    alist
396
397zeroOneConvert x ==
398  x = 'Zero => 0
399  x = 'One  => 1
400  x
401
402kFormatSlotDomain x == fn formatSlotDomain x where fn x ==
403  atom x => x
404  (op := first x) = '_$ => '_$
405  op = 'local => CADR x
406  op = ":" => [":",CADR x,fn CADDR x]
407  MEMQ(op,$Primitives) or constructor? op =>
408    [fn y for y in x]
409  INTEGERP op => op
410  op = 'QUOTE and atom CADR x => CADR x
411  x
412
413koCatOps(conform,domname) ==
414  conname := opOf conform
415  oplist := REVERSE GETDATABASE(conname,'OPERATIONALIST)
416  oplist := sublisFormal(IFCDR domname or IFCDR conform ,oplist)
417  --check below for INTEGERP key to avoid subsumed signatures
418  [[zeroOneConvert op,:nalist] for [op,:alist] in oplist | nalist := koCatOps1(alist)]
419
420koCatOps1 alist == [x for item in alist | x := pair] where
421  pair ==
422    [sig,:r] := item
423    null r => [sig,true]
424    [key,:options] := r
425    null (pred := IFCAR options) =>
426      IFCAR IFCDR options = 'ASCONST => [sig,'ASCONST]
427      [sig,true]
428    npred := simpHasPred pred => [sig,npred]
429    false
430
431koCatAttrs(catform,domname) ==
432  $if : local := MAKE_HASHTABLE('ID)
433  catname   := opOf catform
434  koCatAttrsAdd(domname or catform,true)
435  ancestors := ancestorsOf(catform,domname)
436  for [conform,:pred] in ancestors repeat koCatAttrsAdd(conform,pred)
437  hashTable2Alist $if
438
439hashTable2Alist tb ==
440  [[op,:HGET(tb,op)] for op in listSort(function GLESSEQP,HKEYS $if)]
441
442koCatAttrsAdd(catform,pred) ==
443  for [name, argl, :p] in first getConstructorExports(catform, false) repeat
444    npred  := quickAnd(pred,p)
445    exists := HGET($if,name)
446    if existingPred := LASSOC(argl,exists) then npred := quickOr(npred,existingPred)
447    if not MEMQ(name,'(nil nothing)) then HPUT($if,name,[[argl,simpHasPred npred],:exists])
448
449--=======================================================================
450--            Filter by Category
451--=======================================================================
452
453koaPageFilterByCategory(htPage,calledFrom) ==
454  opAlist := htpProperty(htPage,'opAlist)
455  which   := htpProperty(htPage,'which)
456  page := htInitPageNoScroll(htCopyProplist htPage,
457             dbHeading(opAlist,which,htpProperty(htPage,'heading)))
458  htSay('"Select a category ancestor below or ")
459  htMakePage [['bcLispLinks,['"filter",'"on:",calledFrom,'filter]]]
460  htMakePage [['bcStrings, [13,'"",'filter,'EM]]]
461  htSay('"\beginscroll ")
462  conform := htpProperty(htPage,'conform)
463  domname := htpProperty(htPage,'domname)
464  ancestors := ASSOCLEFT ancestorsOf(conform,domname)
465  htpSetProperty(page,'ancestors,listSort(function GLESSEQP,ancestors))
466  bcNameCountTable(ancestors, 'form2HtString, 'koaPageFilterByCategory1)
467  htShowPage()
468
469dbHeading(items, which, heading) ==
470  count := +/[#(rest x) for x in items]
471  capwhich := capitalize which
472  prefix :=
473    count < 2 =>
474      pluralSay(count,capwhich,nil)
475    pluralSay(count,nil,pluralize capwhich)
476  [:prefix,'" for ",:heading]
477
478koaPageFilterByCategory1(htPage,i) ==
479  ancestor := (htpProperty(htPage, 'ancestors)) . i
480  ancestorList := [ancestor,:ASSOCLEFT ancestorsOf(ancestor,nil)]
481  newOpAlist := nil
482  which    := htpProperty(htPage,'which)
483  opAlist  := htpProperty(htPage,'opAlist)
484  domname  := htpProperty(htPage,'domname)
485  conform  := htpProperty(htPage,'conform)
486  heading  := htpProperty(htPage,'heading)
487  docTable := dbDocTable(domname or conform)
488  for [op,:alist] in opAlist repeat
489    nalist := [[origin,:item] for item in alist | split]
490      where split ==
491        [sig,pred,:aux] := item
492        u := dbGetDocTable(op,sig,docTable,which,aux)
493        origin := IFCAR u
494        doc    := IFCDR u
495        true
496    for [origin,:item] in nalist | origin repeat
497      member(origin,ancestorList) =>
498        newEntry   := [item,:LASSOC(op,newOpAlist)]
499        newOpAlist := insertAlist(op,newEntry,newOpAlist)
500  falist := nil
501  for [op,:alist] in newOpAlist repeat
502    falist := [[op,:NREVERSE alist],:falist]
503  htpSetProperty(htPage,'fromcat,['" from category {\sf ",form2HtString ancestor,'"}"])
504  dbShowOperationsFromConform(htPage,which,falist)
505
506--=======================================================================
507--           New code for search operation alist for exact matches
508--=======================================================================
509
510opPageFast opAlist == --called by oSearch
511  htPage := htInitPage(nil,nil)
512  htpSetProperty(htPage,'opAlist,opAlist)
513  htpSetProperty(htPage,'expandOperations,'lists)
514  which := '"operation"
515  dbShowOp1(htPage,opAlist,which,'names)
516
517opPageFastPath opstring ==
518--return nil
519  x := STRINGIMAGE opstring
520  charPosition(char '_*,x,0) < #x => nil     --quit if name has * in it
521  op := (STRINGP x => INTERN x; x)
522  mmList := getAllModemapsFromDatabase(op,nil) or return nil
523  opAlist := [[op,:[item for mm in mmList]]] where item ==
524    [predList, origin, sig] := modemap2Sig(op, mm)
525    predicate := predList and MKPF(predList,'AND)
526    exposed? := isExposedConstructor opOf origin
527    [sig, predicate, origin, exposed?]
528  opAlist
529
530modemap2Sig(op,mm) ==
531  [dcSig, conds] := mm
532  [dc, :sig] := dcSig
533  partial? :=
534    conds is ['partial,:r] => conds := r
535    false
536  condlist := modemap2SigConds conds
537  [origin, vlist, flist] := getDcForm(dc, condlist) or return nil
538  subcondlist := SUBLISLIS(flist, vlist, condlist)
539  [predList,vlist, flist] := getSigSubst(subcondlist, nil, vlist, flist)
540  if partial? then
541      target := sig.0
542      ntarget := ['Union, target, '"failed"]
543      sig := substitute(ntarget, target, sig)
544  alist := findSubstitutionOrder? pairlis(vlist, flist) or systemError()
545  predList := substInOrder(alist, predList)
546  nsig := substInOrder(alist, sig)
547  if hasPatternVar nsig or hasPatternVar predList then
548    pp '"--------------"
549    pp op
550    pp predList
551    pp nsig
552    pp mm
553--pause nsig
554  [predList, origin, substitute("%", origin, nsig)]
555
556modemap2SigConds conds ==
557  conds is ['OR,:r] => modemap2SigConds first r
558  conds is ['AND,:r] => r
559  [conds]
560
561hasPatternVar x ==
562  IDENTP x and (x ~= "**") => isPatternVar x
563  atom x => false
564  or/[hasPatternVar y for y in x]
565
566getDcForm(dc, condlist) ==
567  -- FIXME: normally first condition on *1 gives origin, but not
568  -- always.  In particular, if we get category with no operations
569  -- than this is clearly wrong, so try next (happens with attributes).
570  -- We should make this reliable.
571  candidates := [x for x in condlist | x is [k,=dc,:.]
572                 and MEMQ(k, '(ofCategory isDomain))]
573  null(candidates) => nil
574  [ofWord,id,cform] := first(candidates)
575  if #candidates > 1 and ofWord = 'ofCategory and _
576       null(GETDATABASE(opOf cform, 'MODEMAPS)) then
577     [ofWord,id,cform] := first(rest(candidates))
578  conform := getConstructorForm opOf cform
579  ofWord = 'ofCategory =>
580    [conform, ["*1", :rest cform], ["%", :rest conform]]
581  ofWord = 'isDomain =>
582    [conform, ["*1", :rest cform], ["%", :rest conform]]
583  systemError()
584
585getSigSubst(u, pl, vl, fl) ==
586  u is [item, :r] =>
587    item is ['AND,:s] =>
588       [pl, vl, fl] := getSigSubst(s, pl, vl, fl)
589       getSigSubst(r, pl, vl, fl)
590    [key, v, f] := item
591    key = 'isDomain => getSigSubst(r, pl, [v, :vl], [f, :fl])
592    key = 'ofCategory => getSigSubst(r, pl, [$Dmarker, :vl], [f, :fl])
593    key = 'ofType    => getSigSubst(r, pl, vl, fl)
594    key = 'has => getSigSubst(r, [item, :pl], vl, fl)
595    key = 'not => getSigSubst(r, [item, :pl], vl, fl)
596    systemError()
597  [pl, vl, fl]
598
599
600pairlis(u,v) ==
601  null u or null v => nil
602  [[first u,:first v],:pairlis(rest u, rest v)]
603