diff options
| -rw-r--r-- | src/interp/br-op1.boot | 144 | ||||
| -rw-r--r-- | src/interp/br-op2.boot | 63 |
2 files changed, 101 insertions, 106 deletions
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 25243200..aa0be712 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -35,8 +35,6 @@ import bc_-util namespace BOOT ---====================> WAS b-op1.boot <================================ - --======================================================================= -- Operation Page Menu --======================================================================= @@ -47,7 +45,7 @@ dbFromConstructor?(htPage) == htpProperty(htPage,'conform) dbDoesOneOpHaveParameters? opAlist == or/[(or/[fn for x in items]) for [op,:items] in opAlist] where fn() == - string? x => dbPart(x,2,1) ~= '"0" + string? x => dbPart(x,2,1) isnt '"0" KAR x --============================================================================ -- Master Switch Functions for Operation Views @@ -60,33 +58,33 @@ dbShowOps(htPage,which,key,:options) == $groupChoice := key key := htpProperty(htPage,'key) or 'names opAlist := - which = '"operation" => htpProperty(htPage,'opAlist) + which is '"operation" => htpProperty(htPage,'opAlist) -- al := reduceByGroup(htPage,htpProperty(htPage,'principalOpAlist)) -- htpSetProperty(htPage,'opAlist,al) -- al htpProperty(htPage,'attrAlist) - key = 'generalise => + key is 'generalise => arg := STRINGIMAGE CAAR opAlist - which = '"attribute" => aPage arg + which is '"attribute" => aPage arg oPage arg - key = 'allDomains => dbShowOpAllDomains(htPage,opAlist,which) - key = 'filter => + key is 'allDomains => dbShowOpAllDomains(htPage,opAlist,which) + key is '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" + if which is '"operation" then htpSetProperty(htPage,'opAlist,opAlist) else htpSetProperty(htPage,'attrAlist,opAlist) - if not htpProperty(htPage,'condition?) = 'no then + if htpProperty(htPage,'condition?) isnt 'no then dbResetOpAlistCondition(htPage,which,opAlist) dbShowOps(htPage,which,htpProperty(htPage,'exclusion)) htpSetProperty(htPage,'key,key) if key in '(exposureOn exposureOff) then $exposedOnlyIfTrue := - key = 'exposureOn => 'T + key is 'exposureOn => 'T nil key := htpProperty(htPage,'exclusion) dbShowOp1(htPage,opAlist,which,key) @@ -112,10 +110,10 @@ dbShowOp1(htPage,opAlist,which,key) == and constructor? con => return conPageChoose con if integer? key then htPage := htInitPageNoScroll(htCopyProplist htPage) - if which = '"operation" + if which is '"operation" then htpSetProperty(htPage,'opAlist,opAlist) else htpSetProperty(htPage,'attrAlist,opAlist) - if not htpProperty(htPage,'condition?) = 'no then + if htpProperty(htPage,'condition?) isnt 'no then dbResetOpAlistCondition(htPage,which,opAlist) dbExpandOpAlistIfNecessary(htPage,opAlist,which,true,false) if $exposedOnlyIfTrue and not dbFromConstructor?(htPage) then @@ -132,19 +130,19 @@ dbShowOp1(htPage,opAlist,which,key) == integer? key => opCount <= $opDescriptionThreshold => 'documentation 'names - key = 'names and null rest opAlist => --means a single op + key is '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)] + dataCount := +/[1 for x in data | (what is '"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 + if what is '"Condition" and null KAR KAR data then dataCount := dataCount - 1 exposurePart := $exposedOnlyIfTrue => '(" Exposed ") nil @@ -171,16 +169,16 @@ dbShowOp1(htPage,opAlist,which,key) == htShowPageNoScroll() opAlistCount(opAlist, which) == +/[foo for [op,:items] in opAlist] where foo() == - null $exposedOnlyIfTrue or which = '"attribute" => #items + null $exposedOnlyIfTrue or which is '"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" +-- branch is 'signatures => '" viewed as signatures" + branch is 'parameters => '" viewed with parameters" + branch is 'origins => '" organized by origins" + branch is 'conditions => '" organized by conditions" '"" [:heading, suffix] @@ -245,7 +243,7 @@ conform2StringList(form,opFn,argFn,exception) == systemError() keyword => [keyword,'": ",:res] res - op = 'Mapping => dbMapping2StringList sargl + op is 'Mapping => dbMapping2StringList sargl head := special => [op] apply(opFn,[form]) @@ -316,7 +314,7 @@ conname2StringList form == -- Data Gathering Code --============================================================================ dbGatherData(htPage,opAlist,which,key) == - key = 'implementation => dbGatherDataImplementation(htPage,opAlist) + key is 'implementation => dbGatherDataImplementation(htPage,opAlist) dataFunction := LASSOC(key,table) where table() == $dbDataFunctionAlist or @@ -330,11 +328,11 @@ dbGatherData(htPage,opAlist,which,key) == --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) + which is '"operation" => htpProperty(htPage,'opAlist) htpProperty(htPage,'attrAlist) acc := nil initialExposure := - htPage and htpProperty(htPage,'conform) and which ~= '"package operation" + htPage and htpProperty(htPage,'conform) and which isnt '"package operation" => true --never star ops from a constructor nil @@ -395,7 +393,7 @@ dbGatherDataImplementation(htPage,opAlist) == which := '"operation" [nam,:$domainArgs] := domainForm $predicateList: local := getConstructorPredicatesFromDB nam - predVector := dom.3 + predVector := vectorRef(dom,3) u := getDomainOpTable(dom,true,ASSOCLEFT opAlist) --u has form ((op,sig,:implementor)...) --sort into 4 groups: domain exports, unexports, default exports, others @@ -404,8 +402,8 @@ dbGatherDataImplementation(htPage,opAlist) == key = domainForm => domexports := [x,:domexports] integer? key => unexports := [x,:unexports] isDefaultPackageForm? key => defexports := [x,:defexports] - key = 'nowhere => nowheres := [x,:nowheres] - key = 'constant =>constants := [x,:constants] + key is 'nowhere => nowheres := [x,:nowheres] + key is 'constant =>constants := [x,:constants] others := [x,:others] --add chain domains go here fn [nowheres,constants,domexports,SORTBY('CDDR,reverse! others),SORTBY('CDDR, reverse! defexports),SORTBY('CDDR,reverse! unexports)] where @@ -435,11 +433,11 @@ dbSelectData(htPage,opAlist,key) == [opAlist . key] dbReduceOpAlist(opAlist,data,branch) == - branch = 'signatures => dbReduceBySignature(opAlist,CAAR data,CADAR data) - branch = 'origins => dbReduceBySelection(opAlist,first data,function third) - branch = 'conditions => dbReduceBySelection(opAlist,first data,function second) - branch = 'implementation => dbReduceByOpSignature(opAlist,CDDR data) - branch = 'parameters => dbReduceByForm(opAlist,first data) + branch is 'signatures => dbReduceBySignature(opAlist,CAAR data,CADAR data) + branch is 'origins => dbReduceBySelection(opAlist,first data,function third) + branch is 'conditions => dbReduceBySelection(opAlist,first data,function second) + branch is 'implementation => dbReduceByOpSignature(opAlist,CDDR data) + branch is 'parameters => dbReduceByForm(opAlist,first data) systemError ['"Unexpected branch: ",branch] dbReduceByOpSignature(opAlist,datalist) == @@ -472,7 +470,7 @@ dbReduceBySelection(opAlist,key,fn) == reverse! acc dbContrivedForm(op,[sig,:.]) == - $which = '"attribute" => [op,sig] + $which is '"attribute" => [op,sig] dbMakeContrivedForm(op,sig) dbMakeSignature(op,[sig,:.]) == [op,sig] --getDomainOpTable format @@ -536,7 +534,7 @@ dbShowOpAllDomains(htPage,opAlist,which) == | LASSQ(rest key,catOriginAlist)] for pair in u repeat [dom,:cat] := pair - LASSQ(cat,catOriginAlist) = 'etc => pair.rest := 'etc + LASSQ(cat,catOriginAlist) is 'etc => pair.rest := 'etc pair.rest := simpOrDumb(constructorHasCategoryFromDB pair,true) --now add all of the domains for [dom,:pred] in domOriginAlist repeat @@ -550,7 +548,7 @@ dbShowOpAllDomains(htPage,opAlist,which) == dbShowCons(htPage,'names) simpOrDumb(new,old) == - new = 'etc => 'etc + new is 'etc => 'etc atom new => old 'etc @@ -566,7 +564,7 @@ dbShowOpConditions(htPage,opAlist,which,data) == dbShowKind conform == conname := first conform kind := getConstructorKindFromDB conname - kind = "domain" => + kind is "domain" => isDefaultPackageName conname => '"default package" '"domain" symbolName kind @@ -587,9 +585,9 @@ dbShowOpSigList(which,dataItems,count) == -- 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 + if which is '"attribute" then htSay args2HtString (sig and [sig]) else htSay '": " - tail = 'ASCONST => bcConform first sig + tail is 'ASCONST => bcConform first sig bcConform ['Mapping,:sig] htSay '"}" count := count + 1 @@ -620,7 +618,7 @@ dbShowOpParameters(htPage,opAlist,which,data) == dbShowOpParameterJump(ops,which,count,single?) htSay('" {\em ",KAR KDR args,'"}") dbShowOpParameterJump(ops,which,count,single?) - tail = 'ASCONST or op in '(0 1) or which = '"attribute" and null IFCAR args => 'skip + tail is 'ASCONST or op in '(0 1) or which is '"attribute" and null IFCAR args => 'skip htSay('"(") if IFCAR args then htSay('"{\em ",IFCAR args,'"}") for x in IFCDR args repeat @@ -637,14 +635,14 @@ dbShowOpParameterJump(ops,which,count,single?) == dbShowOpDocumentation(htPage,opAlist,which,data) == if $exposedOnlyIfTrue and not dbFromConstructor?(htPage) then opAlist := - which = '"operation" => htpProperty(htPage,'opAlist) + which is '"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 is '"package operation" => '"operation" which expand := dbExpandOpAlistIfNecessary(htPage,opAlist,which,true,false) if expand then @@ -658,16 +656,16 @@ dbShowOpDocumentation(htPage,opAlist,which,data) == for item in alist for j in 0.. repeat [sig,predicate,origin,exposeFlag,comments] := item exposeFlag or not $exposedOnlyIfTrue => - if comments ~= '"" and string? comments and (k := string2Integer comments) then + if comments isnt '"" and string? comments and (k := string2Integer comments) then comments := k in '(0 1) => '"" dbReadComments k tail := CDDDDR item tail.first := comments - doc := (string? comments and comments ~= '"" => comments; nil) + doc := (string? comments and comments isnt '"" => comments; nil) pred := predicate or true index := (exactlyOneOpSig => nil; base + j) - if which = '"package operation" then + if which is '"package operation" then sig := substitute(conform,'_$,sig) origin := substitute(conform,'_$,origin) displayDomainOp(htPage,newWhich,origin,op,sig,pred,doc,index,'dbChooseDomainOp,null exposeFlag,true) @@ -676,15 +674,15 @@ dbShowOpDocumentation(htPage,opAlist,which,data) == dbChooseDomainOp(htPage,which,index) == [opKey,entryKey] := DIVIDE(index,8192) opAlist := - which = '"operation" => htpProperty(htPage,'opAlist) + which is '"operation" => htpProperty(htPage,'opAlist) htpProperty(htPage,'attrAlist) [op,:entries] := opAlist . opKey entry := entries . entryKey htPage := htInitPageNoScroll(htCopyProplist htPage) - if which = '"operation" + if which is '"operation" then htpSetProperty(htPage,'opAlist,[[op,entry]]) else htpSetProperty(htPage,'attrAlist,[[op,entry]]) - if not htpProperty(htPage,'condition?) = 'no then + if htpProperty(htPage,'condition?) isnt 'no then dbResetOpAlistCondition(htPage,which,opAlist) dbShowOps(htPage,which,'documentation) @@ -714,14 +712,14 @@ dbShowOperationsFromConform(htPage,which,opAlist) == --branch in with lists heading := ['" from ",exposePart,kind,'" {\em ",fromPart,'"}"] expandProperty := - which = '"operation" => 'expandOperations + which is '"operation" => 'expandOperations 'expandAttributes htpSetProperty(htPage,expandProperty,'lists) htpSetProperty(htPage,'fromHeading,heading) reducedOpAlist := - which = '"operation" => reduceByGroup(htPage,opAlist) + which is '"operation" => reduceByGroup(htPage,opAlist) opAlist - if which = '"operation" + if which is '"operation" then htpSetProperty(htPage,'principalOpAlist,opAlist) htpSetProperty(htPage,'opAlist,reducedOpAlist) @@ -758,15 +756,15 @@ dbShowOperationLines(which,linelist) == --branch in with lines pile := [x,:pile] opAlist := [[name,:reverse! pile],:opAlist] opAlist := listSort(function LEXLESSEQP,reverse! opAlist) - if which = '"operation" + if which is '"operation" then htpSetProperty(htPage,'opAlist,opAlist) else htpSetProperty(htPage,'attrAlist,opAlist) expandProperty := - which = '"operation" => 'expandOperations + which is '"operation" => 'expandOperations 'expandAttributes htpSetProperty(htPage,expandProperty,'strings) dbResetOpAlistCondition(htPage,which,opAlist) - if which = '"attribute" and $attributeArgs then + if which is '"attribute" 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 @@ -787,7 +785,7 @@ 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?) - condition in '(yes no) => condition = 'yes + condition in '(yes no) => condition is 'yes value := dbExpandOpAlistIfNecessary(htPage,opAlist,which,false,true) htpSetProperty(htPage,'condition?,(value => 'yes; 'no)) value @@ -806,11 +804,11 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == condition? := condition? and not $exposedOnlyIfTrue value := nil --return value expandProperty := - which = '"operation" => 'expandOperations + which is '"operation" => 'expandOperations 'expandAttributes expandFlag := htpProperty(htPage,expandProperty) - expandFlag = 'fullyExpanded => nil - expandFlag = 'strings => --strings are partially expanded + expandFlag is 'fullyExpanded => nil + expandFlag is 'strings => --strings are partially expanded for pair in opAlist repeat [op,:lines] := pair acc := nil @@ -827,7 +825,7 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == predicate := ncParseFromString pred if condition? and cons? predicate then value := predicate sig := ncParseFromString sigs --is (Mapping,:.) - if which = '"operation" then + if which is '"operation" then if sig isnt ['Mapping,:.] then sayBrightly ['"Unexpected signature for ",name,'": ",sigs] else sig := rest sig @@ -841,7 +839,7 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == value => value condition? => nil htpSetProperty(htPage,expandProperty,'fullyExpanded) - expandFlag = 'lists => --lists are partially expanded + expandFlag is 'lists => --lists are partially expanded -- entry is [sig, predicate, origin, exposeFlag, comments] $value: local := nil $docTableHash := hashTable 'EQUAL @@ -867,7 +865,7 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == origin := IFCAR u or origin docCode := IFCDR u --> (doc . code) -- if not integer? rest docCode then harhar(op) --> - if null doc and which = '"attribute" then doc := getRegistry(op,sig) + if null doc and which is '"attribute" then doc := getRegistry(op,sig) tail.rest := [origin,isExposedConstructor opOf origin,:docCode] $value => return $value $value => $value @@ -890,7 +888,7 @@ evalableConstructor2HtString domform == arglist := [unquote x for x in rest domform] where unquote arg == arg is [f,:args] => - f = 'QUOTE => first args + f is 'QUOTE => first args [f,:[unquote x for x in args]] arg fargtypes:=CDDAR getConstructorModemapFromDB conname @@ -938,12 +936,12 @@ getDomainOpTable(dom,fromIfTrue,:options) == abb := getConstructorAbbreviation conname opAlist := getConstructorOperationsFromDB conname "append"/[removeDuplicates [[op1,:fn] for [sig,slot,pred,key,:.] in u - | key ~= 'Subsumed and ((null ops and (op1 := op)) or (op1 := memq(op,ops)))] + | key isnt '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 symbolMember?(op,ops) => op - op = 'One => symbolMember?("1",ops) and "1" - op = 'Zero => symbolMember?("0",ops) and "0" + op is 'One => symbolMember?("1",ops) and "1" + op is 'Zero => symbolMember?("0",ops) and "0" false fn() == sig1 := sublisFormal(rest domname,sig) @@ -954,10 +952,10 @@ getDomainOpTable(dom,fromIfTrue,:options) == not fromIfTrue => nil cell := compiledLookup(op,sig1,dom) => [f,:r] := cell - f = 'nowhere => 'nowhere --see replaceGoGetSlot - f = 'makeSpadConstant => 'constant + f is 'nowhere => 'nowhere --see replaceGoGetSlot + f is 'makeSpadConstant => 'constant f = function IDENTITY => 'constant - f = 'newGoGet => substitute('_$,domname,devaluate first r) + f is 'newGoGet => substitute('_$,domname,devaluate first r) not vector? r => systemError devaluateList r substitute('_$,domname,devaluate r) 'nowhere @@ -966,7 +964,7 @@ getDomainOpTable(dom,fromIfTrue,:options) == evalDomainOpPred(dom,pred) == process(dom,pred) where process(dom,pred) == u := convert(dom,pred) - u = 'T => true + u is 'T => true evpred(dom,u) convert(dom,pred) == pred is [op,:argl] => @@ -978,7 +976,7 @@ evalDomainOpPred(dom,pred) == process(dom,pred) where p is ['ATTRIBUTE,a] => ['HasAttribute,arg,MKQ a] ['HasCategory,arg,convertCatArg p] systemError '"unknown predicate form" - pred = 'T => true + pred is 'T => true systemError nil convertCatArg p == atom p or #p = 1 => MKQ p @@ -990,16 +988,16 @@ evalDomainOpPred(dom,pred) == process(dom,pred) where pred is [op,:argl] => op in '(AND and) => "and"/[evpred1(dom,x) for x in argl] op in '(OR or) => "or"/[evpred1(dom,x) for x in argl] - op = 'NOT => not evpred1(dom,first argl) + op is 'NOT => not evpred1(dom,first argl) k := POSN1(pred,$predicateList) => testBitVector(dom.3,k + 1) - op = 'HasAttribute => + op is 'HasAttribute => [arg,[.,a]] := argl attPredIndex := LASSOC(a,dom.2) null attPredIndex => nil attPredIndex = 0 => true testBitVector(dom.3,attPredIndex) nil - pred = 'T => true + pred is 'T => true systemError '"unknown atomic predicate form" diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index 9aba11b7..f8fc5cc9 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -35,8 +35,6 @@ import br_-op1 namespace BOOT ---====================> WAS br-op2.boot <================================ - --======================================================================= -- Operation Description --======================================================================= @@ -46,13 +44,13 @@ htSayConstructor(key,u) == u is ['CATEGORY,kind,:r] => htSay('"a ",kind,'" ") htSayExplicitExports(r) - key = 'is => + key is "is" => htSay '"the domain " bcConform(u,true) htSay - key = 'is => '"the domain " + key is "is" => '"the domain " kind := getConstructorKindFromDB opOf u - kind = "domain" => '"an element of " + kind is "domain" => '"an element of " '"a domain of " u is ['Join,:middle,r] => rest middle => @@ -104,7 +102,7 @@ htSayValue t == htSayTuple source htSay '" to " htSayArgument target - t = '(Category) => htSay('"a category") + t is '(Category) => htSay('"a category") t is [op,:.] and op in '(Join CATEGORY) or constructor? opOf t => htSayConstructor(nil,t) htSay('"an element of domain ") @@ -163,8 +161,8 @@ dbMakeContrivedForm(op,sig,:options) == dbGetContrivedForm(op,sig) dbGetContrivedForm(op,sig) == - op = '"0" => [0] - op = '"1" => [1] + op is '"0" => [0] + op is '"1" => [1] [op,:[dbChooseOperandName s for s in rest sig]] dbChooseOperandName(typ) == @@ -174,10 +172,10 @@ dbChooseOperandName(typ) == x name := opOf typ kind := - name = "$" => 'domain + name is "$" => 'domain getConstructorKindFromDB name s := symbolName opOf typ - kind ~= 'category => + kind isnt 'category => anySubstring?('"Integer",s,0) or anySubstring?('"Number",s,0) => x := first $NumberList $NumberList := rest $NumberList @@ -253,7 +251,7 @@ getSubstInsert(x,candidates) == -- Who Uses --======================================================================= whoUsesOperation(htPage,which,key) == --see dbPresentOps - key = 'filter => koaPageFilterByName(htPage,'whoUsesOperation) + key is 'filter => koaPageFilterByName(htPage,'whoUsesOperation) opAlist := htpProperty(htPage,'opAlist) conform := htpProperty(htPage,'conform) conargs := rest conform @@ -303,7 +301,6 @@ whoUses(opSigList,conform) == acc := nil $conname : local := first conform domList := getUsersOfConstructor $conname - hash := MAKE_-HASH_-TABLE() for name in allConstructors() | symbolMember?(name,domList) repeat $infovec : local := dbInfovec name null $infovec => 'skip --category @@ -311,14 +308,14 @@ whoUses(opSigList,conform) == found := false opacc := nil for i in 7..maxIndex template repeat - item := template . i + item := vectorRef(template,i) item isnt [n,:op] or not symbolMember?(op,opList) => 'skip index := n numvec := getCodeVector() - numOfArgs := numvec . index - null member(numOfArgs,numOfArgsList) => 'skip - whereNumber := numvec.(index := index + 1) - template . whereNumber isnt [= $conname,:.] => 'skip + numOfArgs := arrayRef(numvec,index) + not scalarMember?(numOfArgs,numOfArgsList) => 'skip + whereNumber := arrayRef(numvec,index := index + 1) + vectorRef(template,whereNumber) isnt [= $conname,:.] => 'skip signumList := dcSig(numvec,index + 1,numOfArgs) opsig := or/[pair for (pair := [op1,:sig]) in opSigList | op1 = op and whoUsesMatch?(signumList,sig,nil)] => opacc := [opsig,:opacc] @@ -333,7 +330,7 @@ whoUsesMatch1?(signumList,sig,al) == x := LASSOC(pattern,al) => x = subject => whoUsesMatch1?(r,s,al) false - pattern = '_$ => + pattern is '_$ => subject is [= $conname,:.] => whoUsesMatch1?(r,s,[['_$,:subject],:al]) false whoUsesMatch1?(r,s,[[pattern,:subject],:al]) @@ -350,9 +347,9 @@ koAttrs(conform,domname) == koCatAttrs(conform,domname) $infovec: local := dbInfovec conname or return nil $predvec: local := - $domain => $domain . 3 + $domain => vectorRef($domain,3) getConstructorPredicatesFromDB conname - u := [[a,:pred] for [a,:i] in $infovec . 2 | a ~= 'nil and (pred := sublisFormal(args,kTestPred i))] + u := [[a,:pred] for [a,:i] in $infovec . 2 | a isnt 'nil and (pred := sublisFormal(args,kTestPred i))] --------- CHECK for a = nil listSort(function GLESSEQP,fn u) where fn u == alist := nil @@ -415,18 +412,18 @@ koOps(conform,domname,:options) == main where alist zeroOneConvert x == - x = 'Zero => 0 - x = 'One => 1 + x is 'Zero => 0 + x is 'One => 1 x kFormatSlotDomain x == fn formatSlotDomain x where fn x == atom x => x - (op := first x) = '_$ => '_$ - op = 'local => second x - op = ":" => [":",second x,fn third x] + (op := first x) is '_$ => '_$ + op is 'local => second x + op is ":" => [":",second x,fn third x] isConstructorName op => [fn y for y in x] integer? op => op - op = 'QUOTE and atom second x => second x + op is 'QUOTE and atom second x => second x x koCatOps(conform,domname) == @@ -594,9 +591,9 @@ getDcForm(dc, condlist) == [ofWord,id,cform] := or/[x for x in condlist | x is [k,=dc,:.] and k in '(ofCategory isDomain)] or return nil conform := getConstructorForm opOf cform - ofWord = 'ofCategory => + ofWord is 'ofCategory => [conform, ["*1", :rest cform], ["%", :rest conform]] - ofWord = 'isDomain => + ofWord is 'isDomain => [conform, ["*1", :rest cform], ["%", :rest conform]] systemError() @@ -606,10 +603,10 @@ getSigSubst(u, pl, vl, fl) == [pl, vl, fl] := getSigSubst(s, pl, vl, fl) getSigSubst(r, pl, vl, fl) [key, v, f] := item - key = 'isDomain => getSigSubst(r, pl, [v, :vl], [f, :fl]) - key = 'ofCategory => getSigSubst(r, pl, ['D, :vl], [f, :fl]) - key = 'ofType => getSigSubst(r, pl, vl, fl) - key = "has" => getSigSubst(r, [item, :pl], vl, fl) - key = 'not => getSigSubst(r, [item, :pl], vl, fl) + key is 'isDomain => getSigSubst(r, pl, [v, :vl], [f, :fl]) + key is 'ofCategory => getSigSubst(r, pl, ['D, :vl], [f, :fl]) + key is 'ofType => getSigSubst(r, pl, vl, fl) + key is "has" => getSigSubst(r, [item, :pl], vl, fl) + key is 'not => getSigSubst(r, [item, :pl], vl, fl) systemError() [pl, vl, fl] |