aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-04-26 21:39:15 +0000
committerdos-reis <gdr@axiomatics.org>2011-04-26 21:39:15 +0000
commitb34b11df886a81fe707bb09677c1ecd9715dbe70 (patch)
tree94407560ce9444c2c9285aac81ac715e17a0e1c8
parent2ccdfe6c9be93b3e0ba28f28305de03db7eb4ad6 (diff)
downloadopen-axiom-b34b11df886a81fe707bb09677c1ecd9715dbe70.tar.gz
cleanup
-rw-r--r--src/interp/br-op1.boot144
-rw-r--r--src/interp/br-op2.boot63
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]