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