diff options
| author | dos-reis <gdr@axiomatics.org> | 2009-09-25 20:48:45 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2009-09-25 20:48:45 +0000 |
| commit | 489cfd14dccfcaf7b0ebd41e9d0f8e081a9d1d9f (patch) | |
| tree | 84a87ab3bdba58fe9fd2975efc829d1ed10b8781 /src/interp | |
| parent | 7704713134cb251be6129f38833930228e09eee2 (diff) | |
| download | open-axiom-489cfd14dccfcaf7b0ebd41e9d0f8e081a9d1d9f.tar.gz | |
* boot/ast.boot (bfMember): Improve a bit.
* boot/tokens.boot: Don't rename 'is' and 'inst'.
* boot/parser.boot: Use 'in' instead of 'MEMQ' where approrpriate.
* interp/: Likewise.
Diffstat (limited to 'src/interp')
69 files changed, 354 insertions, 355 deletions
diff --git a/src/interp/as.boot b/src/interp/as.boot index 68e0b01f..3452a559 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -261,11 +261,11 @@ asyDisplay(con,alist) == asGetModemaps(opAlist,oform,kind,modemap) == acc:= nil rpvl:= - MEMQ(kind, '(category function)) => rest $PatternVariableList -- *1 is special for $ + kind in '(category function) => rest $PatternVariableList -- *1 is special for $ $PatternVariableList form := [opOf oform,:[y for x in KDR oform for y in rpvl]] dc := - MEMQ(kind, '(category function)) => "*1" + kind in '(category function) => "*1" form pred1 := kind = 'category => [["*1",form]] @@ -388,7 +388,7 @@ hackToRemoveAnd p == asyAncestors x == x is ['Apply,:r] => asyAncestorList r - x is [op,y,:.] and MEMQ(op, '(PretendTo RestrictTo)) => asyAncestors y + x is [op,y,:.] and op in '(PretendTo RestrictTo) => asyAncestors y atom x => x = '_% => '_$ MEMQ(x, $niladics) => [x] @@ -450,7 +450,7 @@ asytranDeclaration(dform,levels,predlist,local?) == newsig := asytranForm(form,[idForm,:levels],local?) key := levels is ['top,:.] => - MEMQ(id,'(%% Category Type)) => 'constant + id in '(%% Category Type) => 'constant asyLooksLikeCatForm? form => 'category form is ['Apply, '_-_>,.,u] => if u is ['Apply, construc,:.] then u:= construc @@ -485,10 +485,10 @@ asyLooksLikeCatForm? x == -- comments := LASSOC('documentation,r) or '"" -- newsig := asytranForm(form,[idForm,:levels],local?) -- key := --- MEMQ(id,'(%% Category Type)) => 'constant +-- id in '(%% Category Type) => 'constant -- form is ['Apply,'Third,:.] => 'category -- form is ['Apply,.,.,target] and target is ['Apply,name,:.] --- and MEMQ(name,'(Third Join)) => 'category +-- and name in '(Third Join) => 'category -- 'domain -- record := [newsig,asyMkpred predlist,key,true,comments,:$asyFile] -- if not local? then @@ -534,7 +534,7 @@ asytranForm1(form,levels,local?) == form is ['Declare,:.] => asytranDeclaration(form,levels,nil,local?) form is ['Comma,:r] => ['Comma,:[asytranForm(x,levels,local?) for x in r]] --form is ['_-_>,:s] => asytranMapping(s,levels,local?) - form is [op,a,b] and MEMQ(a,'(PretendTo RestrictTo)) => + form is [op,a,b] and a in '(PretendTo RestrictTo) => asytranForm1(a,levels,local?) form is ['LitInteger,s] => READ_-FROM_-STRING(s) @@ -552,7 +552,7 @@ asytranForm1(form,levels,local?) == [asytranForm(x,levels,local?) for x in form] asytranApply(['Apply,name,:arglist],levels,local?) == - MEMQ(name,'(Record Union)) => + name in '(Record Union) => [name,:[asytranApplySpecial(x, levels, local?) for x in arglist]] null arglist => [name] name is [ 'RestrictTo, :.] => @@ -630,7 +630,7 @@ asytranCategoryItem(x,levels,predlist,local?) == predicate is ['Test,r] => r predicate asytranCategory(item,levels,[pred,:predlist],local?) - MEMQ(KAR x,'(Default Foreign)) => nil + KAR x in '(Default Foreign) => nil x is ['Declare,:.] => asytranDeclaration(x,levels,predlist,local?) x @@ -799,7 +799,7 @@ asySig1(u,name?,target?) == u x is [fn,:r] => fn = 'Join => asyTypeJoin r ---------> jump out to newer code 4/94 - MEMQ(fn, '(RestrictTo PretendTo)) => asySig(first r,name?) + fn in '(RestrictTo PretendTo) => asySig(first r,name?) asyComma? fn => u := [asySig(x,name?) for x in r] target? => @@ -847,7 +847,7 @@ asyMapping([a,b],name?) == asyType x == x is [fn,:r] => fn = 'Join => asyTypeJoin r - MEMQ(fn, '(RestrictTo PretendTo)) => asyType first r + fn in '(RestrictTo PretendTo) => asyType first r asyComma? fn => u := [asyType x for x in r] u @@ -915,7 +915,7 @@ asyTypeMapping([a,b]) == asyTypeUnit x == x is [fn,:r] => fn = 'Join => systemError 'Join ----->asyTypeJoin r - MEMQ(fn, '(RestrictTo PretendTo)) => asyTypeUnit first r + fn in '(RestrictTo PretendTo) => asyTypeUnit first r asyComma? fn => u := [asyTypeUnit x for x in r] u @@ -1014,7 +1014,7 @@ asyPredTran p == asyPredTran1 asyJoinPart p asyPredTran1 p == p is ['Has,x,y] => ["has",x, simpCattran y] p is ['Test, q] => asyPredTran1 q - p is [op,:r] and MEMQ(op,'(AND OR NOT)) => + p is [op,:r] and op in '(AND OR NOT) => [op,:[asyPredTran1 q for q in r]] p @@ -1091,7 +1091,7 @@ asyTypeItem x == --============================================================================ -- Utilities --============================================================================ -asyComma? op == MEMQ(op,'(Comma Multi)) +asyComma? op == op in '(Comma Multi) hput(table,name,value) == diff --git a/src/interp/ax.boot b/src/interp/ax.boot index f9614d7e..0a15dd87 100644 --- a/src/interp/ax.boot +++ b/src/interp/ax.boot @@ -230,8 +230,8 @@ axFormatType(typeform) == ['Apply, op, :[['PretendTo, axFormatType a, axFormatType t] for a in args for t in argtypes]] - MEMQ(op, '(SquareMatrix SquareMatrixCategory DirectProduct - DirectProductCategory RadixExpansion)) and + op in '(SquareMatrix SquareMatrixCategory DirectProduct + DirectProductCategory RadixExpansion) and getConstructorModemapFromDB op is [[.,target,arg1type,:restargs],.] => ['Apply, op, ['PretendTo, axFormatType first args, axFormatType arg1type], diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index d8499ed6..4454b5ec 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -271,7 +271,7 @@ domainDescendantsOf(conform,domform) == main where --called by kargPage listSort(function GLESSEQP, alist) catScreen(r,alist) == for x in r repeat - x isnt [op1,:.] and MEMQ(op1,'(ATTRIBUTE SIGNATURE)) => systemError x + x isnt [op1,:.] and op1 in '(ATTRIBUTE SIGNATURE) => systemError x alist := [[item,:npred] for [item,:pred] in alist | (pred1 := simpHasPred ["has",item,x]) and (npred := quickAnd(pred1,pred))] alist @@ -945,7 +945,7 @@ dbShowCons(htPage,key,:options) == htPage := htInitPageNoScroll(htCopyProplist htPage) htpSetProperty(htPage,'cAlist,u) dbShowCons(htPage,htpProperty(htPage,'exclusion)) - if MEMQ(key,'(exposureOn exposureOff)) then + if key in '(exposureOn exposureOff) then $exposedOnlyIfTrue := key = 'exposureOn => 'T NIL diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 4e16780f..f137ecaa 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -423,7 +423,7 @@ mkUsersHashTable() == --called by buildDatabase (database.boot) for x in allConstructors() repeat for conform in getImports x repeat name := opOf conform - if not MEMQ(name,'(QUOTE)) then + if not (name in '(QUOTE)) then HPUT($usersTb,name,insert(x,HGET($usersTb,name))) for k in HKEYS $usersTb repeat HPUT($usersTb,k,listSort(function GLESSEQP,HGET($usersTb,k))) @@ -473,7 +473,7 @@ getImports conname == --called by mkUsersHashTable u := [doImport(i,template) for i in 5..(MAXINDEX template) | test] where test() == template.i is [op,:.] and IDENTP op - and not MEMQ(op,'(Mapping Union Record Enumeration CONS QUOTE local)) + and not (op in '(Mapping Union Record Enumeration CONS QUOTE local)) doImport(x,template) == x is [op,:args] => op = 'QUOTE or op = 'NRTEVAL => CAR args @@ -550,12 +550,12 @@ explodeIfs x == main where --called by getParents, getParentsForDomain folks u == --called by getParents and getParentsForDomain atom u => nil - u is [op,:v] and MEMQ(op,'(Join PROGN)) + u is [op,:v] and op in '(Join PROGN) or u is ['CATEGORY,a,:v] => "append"/[folks x for x in v] u is ['SIGNATURE,:.] => nil u is ['TYPE,:.] => nil u is ['ATTRIBUTE,a] => - PAIRP a and constructor? opOf a => folks a + CONSP a and constructor? opOf a => folks a nil u is ['IF,p,q,r] => q1 := folks q diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 9348194d..61ccfd58 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -56,7 +56,7 @@ dbDoesOneOpHaveParameters? opAlist == dbShowOps(htPage,which,key,:options) == --NEXT LINE SHOULD BE REMOVED if we are sure that which is a string which := STRINGIMAGE which - if MEMQ(key,'(extended basic all)) then + if key in '(extended basic all) then $groupChoice := key key := htpProperty(htPage,'key) or 'names opAlist := @@ -84,7 +84,7 @@ dbShowOps(htPage,which,key,:options) == dbResetOpAlistCondition(htPage,which,opAlist) dbShowOps(htPage,which,htpProperty(htPage,'exclusion)) htpSetProperty(htPage,'key,key) - if MEMQ(key,'(exposureOn exposureOff)) then + if key in '(exposureOn exposureOff) then $exposedOnlyIfTrue := key = 'exposureOn => 'T nil @@ -219,7 +219,7 @@ conform2StringList(form,opFn,argFn,exception) == [op1,:args] := form op := IFCAR HGET($lowerCaseConTb,op1) or op1 null args => APPLY(opFn,[op]) - special := MEMQ(op,'(Union Record Mapping)) + special := op in '(Union Record Mapping) cosig := special => ['T for x in args] rest getDualSignatureFromDB op @@ -424,9 +424,9 @@ dbGatherDataImplementation(htPage,opAlist) == dbSelectData(htPage,opAlist,key) == branch := htpProperty(htPage,'branch) data := htpProperty(htPage,'data) - MEMQ(branch,'(signatures parameters)) => + branch in '(signatures parameters) => dbReduceOpAlist(opAlist,data.key,branch) - MEMQ(branch,'(origins conditions implementation)) => + branch in '(origins conditions implementation) => key < 8192 => dbReduceOpAlist(opAlist,data.key,branch) [newkey,binkey] := DIVIDE(key,8192) --newkey is 1 too large innerData := CDDR data.(newkey - 1) @@ -784,7 +784,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?) - MEMQ(condition,'(yes no)) => condition = 'yes + condition in '(yes no) => condition = 'yes value := dbExpandOpAlistIfNecessary(htPage,opAlist,which,false,true) htpSetProperty(htPage,'condition?,(value => 'yes; 'no)) value @@ -939,8 +939,8 @@ getDomainOpTable(dom,fromIfTrue,:options) == for [op,:u] in opAlist] where memq(op,ops) == --dirty trick to get 0 and 1 instead of Zero and One MEMQ(op,ops) => op - EQ(op,'One) => MEMQ(1,ops) and 1 - EQ(op,'Zero) => MEMQ(0,ops) and 0 + op = 'One => MEMQ(1,ops) and 1 + op = 'Zero => MEMQ(0,ops) and 0 false fn() == sig1 := sublisFormal(rest domname,sig) @@ -967,9 +967,9 @@ evalDomainOpPred(dom,pred) == process(dom,pred) where evpred(dom,u) convert(dom,pred) == pred is [op,:argl] => - MEMQ(op,'(AND and)) => ['AND,:[convert(dom,x) for x in argl]] - MEMQ(op,'(OR or)) => ['OR,:[convert(dom,x) for x in argl]] - MEMQ(op,'(NOT not)) => ['NOT,convert(dom,first argl)] + op in '(AND and) => ['AND,:[convert(dom,x) for x in argl]] + op in '(OR or) => ['OR,:[convert(dom,x) for x in argl]] + op in '(NOT not) => ['NOT,convert(dom,first argl)] op = "has" => [arg,p] := argl p is ['ATTRIBUTE,a] => ['HasAttribute,arg,MKQ a] @@ -985,8 +985,8 @@ evalDomainOpPred(dom,pred) == process(dom,pred) where evpred1(dom,pred) evpred1(dom,pred) == pred is [op,:argl] => - MEMQ(op,'(AND and)) => "and"/[evpred1(dom,x) for x in argl] - MEMQ(op,'(OR or)) => "or"/[evpred1(dom,x) for x in argl] + op 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) k := POSN1(pred,$predicateList) => testBitVector(dom.3,k + 1) op = 'HasAttribute => diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index c89e727d..f82cea01 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -105,14 +105,14 @@ htSayValue t == htSay '" to " htSayArgument target t = '(Category) => htSay('"a category") - t is [op,:.] and MEMQ(op,'(Join CATEGORY)) or constructor? opOf t => + t is [op,:.] and op in '(Join CATEGORY) or constructor? opOf t => htSayConstructor(nil,t) htSay('"an element of domain ") htSayArgument t --continue for operations htSayArgument t == --called only for operations not for constructors null $signature => htSay ['"{\em ",t,'"}"] - MEMQ(t, '(_$ _%)) => + t in '(_$ _%) => $conkind = '"category" and $conlength > 20 => $generalSearch? => htSay '"{\em D} of the origin category" addWhereList("$",'is,nil) @@ -464,7 +464,7 @@ koCatAttrsAdd(catform,pred) == exists := HGET($if,name) if existingPred := LASSOC(argl,exists)_ then npred := quickOr(npred,existingPred) - if not MEMQ(name,'(nil nothing)) _ + if not (name in '(nil nothing)) _ then HPUT($if,name,[[argl,simpHasPred npred],:exists]) --======================================================================= @@ -592,7 +592,7 @@ hasPatternVar x == getDcForm(dc, condlist) == [ofWord,id,cform] := or/[x for x in condlist | x is [k,=dc,:.] - and MEMQ(k, '(ofCategory isDomain))] or return nil + and k in '(ofCategory isDomain)] or return nil conform := getConstructorForm opOf cform ofWord = 'ofCategory => [conform, ["*1", :rest cform], ["%", :rest conform]] diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index b096c6f8..a67261bd 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -151,12 +151,12 @@ htSayBind(x, options) == bcHt line == $newPage => --this path affects both saturn and old lines text := - PAIRP line => [['text, :line]] + CONSP line => [['text, :line]] STRINGP line => line [['text, line]] if $saturn then htpAddToPageDescription($saturnPage, text) if $standard then htpAddToPageDescription($curPage, text) - PAIRP line => + CONSP line => $htLineList := NCONC(nreverse mapStringize COPY_-LIST line, $htLineList) $htLineList := [basicStringize line, :$htLineList] @@ -409,7 +409,7 @@ htMakePage1 itemList == systemError '"unexpected branch" saturnTran x == - x is [[kind, [s1, s2, :callTail]]] and MEMQ(kind,'(bcLinks bcLispLinks)) => + x is [[kind, [s1, s2, :callTail]]] and kind in '(bcLinks bcLispLinks) => text := saturnTranText s2 fs := getCallBackFn callTail y := isMenuItemStyle? s1 => ----> y is text for button in 2nd column @@ -1307,7 +1307,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, htSayIndentRel(-15) htSaySaturn '"\\" ----------------------------------------------------------- - if not MEMQ(predicate,'(T ASCONST)) then + if not (predicate in '(T ASCONST)) then pred := sublisFormal(KDR conform,predicate) count := #pred htSaySaturn '"{\em Conditions:}" diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index c3c997f0..4bb062b4 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -53,7 +53,7 @@ grepConstruct(s,key,:options) == --key = a o c d p x k (all) . (aok) w (doc) lines := grepConstruct1(s,key) lines is ["error",:.] => lines IFCAR options => grepSplit(lines,key = 'w) --leave now if a constructor - MEMQ(key,'(o a)) => dbScreenForDefaultFunctions lines --kill default lines if a/o + key in '(o a) => dbScreenForDefaultFunctions lines --kill default lines if a/o lines grepConstruct1(s,key) == @@ -151,7 +151,7 @@ checkPmParse parse == STRINGP parse => parse (fn parse => parse) where fn(u) == u is [op,:args] => - MEMQ(op,'(and or not)) and "and"/[checkPmParse x for x in args] + op in '(and or not) and "and"/[checkPmParse x for x in args] STRINGP u => true false nil @@ -265,7 +265,7 @@ mkGrepPattern1(x,:options) == --called by mkGrepPattern (and grepConstructName?) h(sl,res) == --helper for wild cards sl is [s,:r] => h(r,[$wild1,s,:res]) res := rest res - if not MEMQ('w,$options) then + if not ('w in $options) then if first res ~= '"" then res := ['"`",:res] else if res is [.,p,:r] and p = $wild1 then res := r "STRCONC"/NREVERSE res @@ -684,7 +684,7 @@ conSpecialString?(filter,:options) == false null parse => nil form := conLowerCaseConTran parse - MEMQ(KAR form,'(and or not)) or CONTAINED("*",form) => nil + KAR form in '(and or not) or CONTAINED("*",form) => nil filter = '"Mapping" =>nil u := kisValidType form => u secondTime => false @@ -844,7 +844,7 @@ generalSearchDo(htPage,flag) == form := mkDetailedGrepPattern(kindCode,name,nargs,npat) lines := applyGrep(form,'libdb) --lines := dbReadLines resultFile - if MEMQ(which,'(ops attrs)) then lines := dbScreenForDefaultFunctions lines + if which in '(ops attrs) then lines := dbScreenForDefaultFunctions lines kind := which = 'cons => n = 1 => @@ -955,7 +955,7 @@ grepSource key == key = 'gloss => STRCONC(systemRootDirectory(),'"doc/glosskey.text") key = $localLibdb => $localLibdb mkGrepTextfile - MEMQ(key, '(_. a c d k o p x)) => 'libdb + key in '(_. a c d k o p x) => 'libdb 'comdb mkGrepTextfile s == @@ -981,7 +981,7 @@ grepFile(pattern,:options) == -----AIX Version---------- target := getTempPath 'target casepart := - MEMQ('iv,options)=> '"-vi" + 'iv in options => '"-vi" '"-i" command := STRCONC('"grep ",casepart,'" _'",pattern,'"_' ",source) obey @@ -990,7 +990,7 @@ grepFile(pattern,:options) == STRCONC(command, '" > ",target) dbReadLines target ----Windows Version------ - invert? := MEMQ('iv, options) + invert? := 'iv in options GREP(source, pattern, false, not invert?) dbUnpatchLines lines diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index 92f05311..ca0e004d 100644 --- a/src/interp/br-util.boot +++ b/src/interp/br-util.boot @@ -153,7 +153,7 @@ htPred2English(x,:options) == IDENTP x and not MEMQ(x,$emList) => htSay escapeSpecialIds PNAME x htSay form2HtString(x,$emList) gn(x,op,l,prec) == - MEMQ(op,'(NOT not)) => + op in '(NOT not) => htSay('"not ") fn(first l,0) op = 'HasCategory => @@ -164,7 +164,7 @@ htPred2English(x,:options) == bcConform(first l,$emList) htSay('" has ") fnAttr CADADR l - MEMQ(op,'(has ofCategory)) => + op in '(has ofCategory) => bcConform(first l,$emList) htSay('" has ") [a,b] := l @@ -446,7 +446,7 @@ extractHasArgs pred == x := find pred or return nil where find x == x is [op,:argl] => op = 'hasArgs => x - MEMQ(op,'(AND OR NOT)) => or/[find y for y in argl] + op in '(AND OR NOT) => or/[find y for y in argl] nil nil [rest x,:simpBool substitute('T,x,pred)] diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index bc417364..34e16794 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -109,7 +109,7 @@ Record(:args) == RecordEqual(x,y,dom) == nargs := #rest(dom.0) - PAIRP x => + CONSP x => b:= SPADCALL(first x, first y, first(dom.(nargs + 9)) or first RPLACA(dom.(nargs + 9),findEqualFun(dom.$FirstParamSlot))) diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 3bf1365f..131897fd 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -57,7 +57,7 @@ getDoc(conName,op,modemap) == ++ argument to the ofCategory predicate it contains. Return ++ nil otherwise. getOfCategoryArgument pred == - pred is [fn,:.] and MEMQ(fn,'(AND OR NOT)) => + pred is [fn,:.] and fn in '(AND OR NOT) => or/[getOfCategoryArgument x for x in rest pred] pred is ['ofCategory,'_*1,form] => form nil diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 91bafd3e..dbc3789a 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -618,7 +618,7 @@ decExitLevel u == adjExitLevel(x,seqnum,inc) == atom x => x - x is [op,:l] and MEMQ(op,'(SEQ REPEAT COLLECT)) => + x is [op,:l] and op in '(SEQ REPEAT COLLECT) => for u in l repeat adjExitLevel(u,seqnum+1,inc) x is ["exit",n,u] => (adjExitLevel(u,seqnum,inc); seqnum>n => x; rplac(CADR x,n+inc)) @@ -1441,7 +1441,7 @@ declareGlobalVariables vars == simplifySEQ form == isAtomicForm form => form - form is ["SEQ",[op,a]] and MEMQ(op, '(EXIT RETURN)) => simplifySEQ a + form is ["SEQ",[op,a]] and op in '(EXIT RETURN) => simplifySEQ a for stmts in tails form repeat rplac(first stmts, simplifySEQ first stmts) form diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index 2c8129b8..10afbecd 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -103,7 +103,7 @@ simpHasPred(pred,:options) == main where op = 'HasAttribute => form := ["has",a := CAR r,['ATTRIBUTE,b := simpDevaluate CADR r]] simpHasAttribute(form,a,b) - MEMQ(op,'(AND OR NOT)) => + op in '(AND OR NOT) => null (u := MKPF([simp p for p in r],op)) => nil u is '(QUOTE T) => true simpBool u diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 58e056fb..2246f87d 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -83,8 +83,8 @@ compClam(op,argl,body,$clamList) == $clamList:= nil --clear to avoid looping if u:= S_-(options,'(shift count)) then keyedSystemError("S2GE0006",[op,:u]) - shiftFl := MEMQ('shift,options) - countFl := MEMQ('count,options) + shiftFl := 'shift in options + countFl := 'count in options if #argl > 1 and eqEtc= 'EQ then keyedSystemError("S2GE0007",[op]) (not IDENTP kind) and (not INTEGERP kind or kind < 1) => @@ -183,7 +183,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == if null argl then null cacheNameOrNil => keyedSystemError("S2GE0011",[op]) nil - (not cacheNameOrNil) and (not MEMQ(eqEtc,'(EQ CVEC UEQUAL))) => + (not cacheNameOrNil) and not (eqEtc in '(EQ CVEC UEQUAL)) => keyedSystemError("S2GE0012",[op]) --withWithout := (countFl => "with"; "without") --middle:= @@ -281,7 +281,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == compHashGlobal(op,argl,body,cacheName,eqEtc,countFl) == --Note: when cacheNameOrNil~=nil, it names a global hashtable - if (not MEMQ(eqEtc,'(UEQUAL))) then + if (not (eqEtc in '(UEQUAL))) then sayBrightly "for hash option, only EQ, CVEC, and UEQUAL are allowed" auxfn:= INTERNL(op,'";") g1:= GENSYM() --argument or argument list @@ -372,7 +372,7 @@ displayHashtable x == cacheStats() == for [fn,kind,:u] in $clamList repeat - not MEMQ('count,u) => + not ('count in u) => sayBrightly ["%b",fn,"%d","does not keep reference counts"] INTEGERP kind => reportCircularCacheStats(fn,kind) kind = 'hash => reportHashCacheStats fn diff --git a/src/interp/clammed.boot b/src/interp/clammed.boot index b4927b8f..0f84aac3 100644 --- a/src/interp/clammed.boot +++ b/src/interp/clammed.boot @@ -210,7 +210,7 @@ isLegitimateMode(t,hasPolyMode,polyVarList) == underDomainOf t == t = $RationalNumber => $Integer - not PAIRP t => NIL + atom t => NIL d := deconstructT t 1 = #d => NIL u := getUnderModeOf(t) => u diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 8666c1ff..6f85c84c 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1042,7 +1042,7 @@ replaceExitEtc(x,tag,opFlag,opMode) == rplac(CADR x,tag) rplac(CADDR x,(convertOrCroak(t,opMode)).expr) true => rplac(CADR x,CADR x-1) - x is [key,n,t] and MEMQ(key,'(TAGGEDreturn TAGGEDexit)) => + x is [key,n,t] and key in '(TAGGEDreturn TAGGEDexit) => rplac(first t,replaceExitEtc(first t,tag,opFlag,opMode)) replaceExitEtc(first x,tag,opFlag,opMode) replaceExitEtc(rest x,tag,opFlag,opMode) @@ -1437,7 +1437,7 @@ compSignatureImport(["%SignatureImport",id,type,home],m,e) == stackAndThrow('"%1bp takes exactly one argument",["Foreign"]) not IDENTP lang => stackAndThrow('"Argument to %1bp must be an identifier",["Foreign"]) - not MEMQ(lang, '(Builtin C)) => + not (lang in '(Builtin C)) => stackAndThrow('"Sorry: Only %1bp is valid at the moment",["Foreign C"]) -- 2. Make sure this import is not subverting anything we know id' := checkExternalEntity(id,type,lang,e) @@ -1918,7 +1918,7 @@ compViableModemap(op,argTl,mm) == -- an exterior domain (it is calculating the displacement based on view -- information which is no longer valid; thus ignore this index and -- store the signature instead. - f is [op1,.,.] and MEMQ(op1,'(ELT CONST Subsumed)) => + f is [op1,.,.] and op1 in '(ELT CONST Subsumed) => [genDeltaEntry [op,:mm],argTl] [f,argTl] @@ -2349,7 +2349,7 @@ compRepeatOrCollect(form,m,e) == ["%CollectV",localReferenceIfThere m',:itl',body'] [repeatOrCollect,:itl',body'] m'' := - aggr is [c,.] and MEMQ(c,'(List PrimitiveArray Vector)) => [c,m'] + aggr is [c,.] and c in '(List PrimitiveArray Vector) => [c,m'] m' T := coerceExit([form',m'',e'],targetMode) or return nil -- iterator variables and other variables declared in @@ -2447,12 +2447,12 @@ compIterator(it,e) == nil --isAggregateMode(m,e) == --- m is [c,R] and MEMQ(c,'(Vector List)) => R +-- m is [c,R] and c in '(Vector List) => R -- name:= -- m is [fn,:.] => fn -- m="$" => "Rep" -- m --- get(name,"value",e) is [c,R] and MEMQ(c,'(Vector List)) => R +-- get(name,"value",e) is [c,R] and c in '(Vector List) => R modeIsAggregateOf(agg,m,e) == m is [ =agg,R] => [m,R] diff --git a/src/interp/compress.boot b/src/interp/compress.boot index 60634498..a196e3e2 100644 --- a/src/interp/compress.boot +++ b/src/interp/compress.boot @@ -44,7 +44,7 @@ minimalise x == min x == y:=HGET($hash,x) y => y - PAIRP x => + CONSP x => x = '(QUOTE T) => '(QUOTE T) -- copes with a particular Lucid-ism, God knows why -- This circular way of doing things is an attempt to deal with Lucid diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot index 074d3510..d6cdfeda 100644 --- a/src/interp/cparse.boot +++ b/src/interp/cparse.boot @@ -372,7 +372,7 @@ npSymbolVariable()== npName()==npId() or npSymbolVariable() npConstTok() == - MEMQ(tokType $stok, '(integer string char float command)) => + tokType $stok in '(integer string char float command) => npPush $stok npNext() npEqPeek "'" => diff --git a/src/interp/database.boot b/src/interp/database.boot index 622f1051..1eefebfd 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -297,7 +297,7 @@ orderPredTran(oldList,sig,skip) == ----- (op *target ..) when *target does not appear later in sig ----- (isDomain *1 ..) for pred in oldList repeat - ((pred is [op,pvar,.] and MEMQ(op,'(isDomain ofCategory)) + ((pred is [op,pvar,.] and op in '(isDomain ofCategory) and pvar=first sig and not (pvar in rest sig)) or (not skip and pred is ['isDomain,pvar,.] and pvar="*1")) => oldList:=delete(pred,oldList) @@ -651,7 +651,7 @@ updateDatabase(fname,cname,systemdir?) == REMOVER(lst,item) == --destructively removes item from lst - not PAIRP lst => + atom lst => lst=item => nil lst first lst=item => rest lst @@ -662,7 +662,7 @@ allLASSOCs(op,alist) == loadDependents fn == isExistingFile [fn,$spadLibFT,"*"] => - MEMQ("dependents",RKEYIDS(fn,$spadLibFT)) => + "dependents" in RKEYIDS(fn,$spadLibFT) => stream:= readLib1(fn,$spadLibFT,"*") l:= rread('dependents,stream,nil) RSHUT stream @@ -778,7 +778,7 @@ isExposedConstructor name == -- slot 1: list of constructors explicitly exposed -- slot 2: list of constructors explicitly hidden -- check if it is explicitly hidden - MEMQ(name,'(Union Record Mapping)) => true + name in '(Union Record Mapping) => true MEMQ(name,$localExposureData.2) => false -- check if it is explicitly exposed MEMQ(name,$localExposureData.1) => true diff --git a/src/interp/define.boot b/src/interp/define.boot index b74fc64a..a9900f74 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -418,7 +418,7 @@ makeCategoryPredicates(form,u) == u is ['Join,:.,a] => fn(a,pl) u is ["IF",p,:x] => fnl(x,insert(EQSUBSTLIST($mvl,$tvl,p),pl)) u is ["has",:.] => insert(EQSUBSTLIST($mvl,$tvl,u),pl) - u is [op,:.] and MEMQ(op,'(SIGNATURE ATTRIBUTE)) => pl + u is [op,:.] and op in '(SIGNATURE ATTRIBUTE) => pl atom u => pl fnl(u,pl) fnl(u,pl) == @@ -748,7 +748,7 @@ compFunctorBody(body,m,e,parForm) == else backendCompile foldExportedFunctionReferences $capsuleFunctionStack clearCapsuleDirectory() -- release storage. - body is [op,:.] and MEMQ(op,'(add CAPSULE)) => T + body is [op,:.] and op in '(add CAPSULE) => T $NRTaddForm := body is ["SubDomain",domainForm,predicate] => domainForm body @@ -1647,7 +1647,7 @@ DomainSubstitutionFunction(parameters,body) == --For categories, bound and used in compDefineCategory MKQ g first body="QUOTE" => body - PAIRP $definition and + CONSP $definition and isFunctor first body and first body ~= first $definition => ['QUOTE,optimize body] diff --git a/src/interp/format.boot b/src/interp/format.boot index d3d974f9..8cc64896 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -182,7 +182,7 @@ reportOpSymbol op1 == sayKeyedMsg("S2IF0010",[op1]) if SIZE PNAME op1 < 3 then x := UPCASE queryUserKeyedMsg("S2IZ0060",[op1]) - null MEMQ(STRING2ID_-N(x,1),'(Y YES)) => + null (STRING2ID_-N(x,1) in '(Y YES)) => ok := nil sayKeyedMsg("S2IZ0061",[op1]) ok => apropos [op1] @@ -419,7 +419,7 @@ form2String1 u == null argl => [ '":" ] null rest argl => [ '":", form2String1 first argl ] formDecl2String(argl.0,argl.1) - op = "#" and PAIRP argl and LISTP CAR argl => + op = "#" and CONSP argl and LISTP CAR argl => STRINGIMAGE SIZE CAR argl op = 'Join => formJoin2String argl op = "ATTRIBUTE" => form2String1 first argl @@ -461,7 +461,7 @@ formArguments2String(argl,ml) == [fn(x,m) for x in argl for m in ml] where x=$EmptyMode or x=$quadSymbol => specialChar 'quad STRINGP(x) or IDENTP(x) => x x is [ ='_:,:.] => form2String1 x - isValidType(m) and PAIRP(m) and + isValidType(m) and CONSP(m) and (getConstructorKindFromDB first(m) = "domain") => (x' := coerceInteractive(objNewWrap(x,m),$OutputForm)) => form2String1 objValUnwrap x' @@ -559,7 +559,7 @@ tuple2String argl == script2String s == null s => '"" -- just to be safe - if not PAIRP s then s := [s] + if atom s then s := [s] linearFormatForm(CAR s, CDR s) linearFormatName x == @@ -734,7 +734,7 @@ object2String x == STRINGP x => x IDENTP x => PNAME x NULL x => '"" - PAIRP x => STRCONC(object2String first x, object2String rest x) + CONSP x => STRCONC(object2String first x, object2String rest x) WRITE_-TO_-STRING x object2Identifier x == @@ -745,7 +745,7 @@ object2Identifier x == blankList x == "append"/[[BLANK,y] for y in x] pkey keyStuff == - if not PAIRP keyStuff then keyStuff := [keyStuff] + if atom keyStuff then keyStuff := [keyStuff] allMsgs := ['" "] while not null keyStuff repeat dbN := NIL @@ -753,7 +753,7 @@ pkey keyStuff == key := first keyStuff keyStuff := IFCDR keyStuff next := IFCAR keyStuff - while PAIRP next repeat + while CONSP next repeat if CAR next = 'dbN then dbN := CADR next else argL := next keyStuff := IFCDR keyStuff diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot index d568e729..054e8e84 100644 --- a/src/interp/fortcall.boot +++ b/src/interp/fortcall.boot @@ -750,7 +750,7 @@ multiToUnivariate f == -- Take an AnonymousFunction, replace the bound variables by references to -- elements of a vector, and compile it. (first f) ~= "+->" => error "in multiToUnivariate: not an AnonymousFunction" - if PAIRP CADR f then + if CONSP CADR f then vars := CDADR f -- throw away '%Comma at start of variable list else vars := [CADR f] @@ -767,7 +767,7 @@ functionAndJacobian f == -- Take a mapping into n functions of n variables, produce code which will -- evaluate function and jacobian values. (first f) ~= "+->" => error "in functionAndJacobian: not an AnonymousFunction" - if PAIRP CADR f then + if CONSP CADR f then vars := CDADR f -- throw away '%Comma at start of variable list else vars := [CADR f] @@ -795,7 +795,7 @@ vectorOfFunctions f == -- Take a mapping into n functions of m variables, produce code which will -- evaluate function values. (first f) ~= "+->" => error "in vectorOfFunctions: not an AnonymousFunction" - if PAIRP CADR f then + if CONSP CADR f then vars := CDADR f -- throw away '%Comma at start of variable list else vars := [CADR f] diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 3c97b449..a5779a50 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -135,7 +135,7 @@ PacPrint v == $Sublis:= [first Sublis,:$Sublis] $WhereList:= [[name,:vv.j],:$WhereList] vv.j:= name - if PAIRP vv.j and REFVECP(u:=CDR vv.j) then + if CONSP vv.j and REFVECP(u:=CDR vv.j) then l:= ASSQ(keyItem u,Sublis) if l then name:= rest l @@ -228,7 +228,7 @@ compCategories1(u,v) == NewbFVectorCopy(u,domName) == v:= newShell SIZE u for i in 0..5 repeat v.i:= u.i - for i in 6..MAXINDEX v | PAIRP u.i repeat v.i:= [function Undef,[domName,i],:first u.i] + for i in 6..MAXINDEX v | CONSP u.i repeat v.i:= [function Undef,[domName,i],:first u.i] v mkVector u == @@ -551,10 +551,10 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) == if update(u,copyvec,[]) then code:=delete(u,code)) where update(code,copyvec,sofar) == ATOM code =>nil - MEMQ(QCAR code,'(getShellEntry ELT QREFELT)) => + QCAR code in '(getShellEntry ELT QREFELT) => copyvec.(CADDR code):=union(copyvec.(CADDR code), sofar) true - code is [x,name,number,u'] and MEMQ(x,'(setShellEntry SETELT QSETREFV)) => + code is [x,name,number,u'] and x in '(setShellEntry SETELT QSETREFV) => update(u',copyvec,[[name,:number],:sofar]) for i in 6..n repeat for u in copyvec.i repeat @@ -705,7 +705,7 @@ SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding" --a special marker generated by SigListUnion then if mode='original - then if truename is [fn,:.] and MEMQ(fn,'(Zero One)) + then if truename is [fn,:.] and fn in '(Zero One) then nil --hack by RDJ 8/90 else body:= SetFunctionSlots(truename,body,nil,mode) else nil diff --git a/src/interp/g-boot.boot b/src/interp/g-boot.boot index 8151d16f..1d9507a2 100644 --- a/src/interp/g-boot.boot +++ b/src/interp/g-boot.boot @@ -57,7 +57,7 @@ nakedEXIT? c == IDENTP a => a = 'EXIT => true a = 'QUOTE => NIL - MEMQ(a,'(SEQ PROG LAMBDA MLAMBDA LAM)) => NIL + a in '(SEQ PROG LAMBDA MLAMBDA LAM) => NIL nakedEXIT?(d) nakedEXIT?(a) or nakedEXIT?(d) @@ -68,7 +68,7 @@ mergeableCOND x == ok := true while (cls and ok) repeat [[p,:r],:cls] := cls - PAIRP QCDR r => ok := NIL + CONSP QCDR r => ok := NIL CAR(r) isnt ['EXIT,.] => ok := NIL NULL(cls) and ATOM(p) => ok := NIL NULL(cls) and (p = ''T) => ok := NIL @@ -80,8 +80,8 @@ mergeCONDsWithEXITs l == -- (COND (bar (EXIT b))) -- into one COND NULL l => NIL - ATOM l => l - NULL PAIRP QCDR l => l + atom l => l + atom QCDR l => l a := QCAR l if a is ['COND,:.] then a := flattenCOND a am := mergeableCOND a @@ -283,18 +283,18 @@ defLET2(lhs,rhs) == a := defLET2(a,rhs) null (b := defLET2(b,rhs)) => a ATOM b => [a,b] - PAIRP QCAR b => CONS(a,b) + CONSP QCAR b => CONS(a,b) [a,b] lhs is ['CONS,var1,var2] => var1 = "." or (var1 is ["QUOTE",:.]) => defLET2(var2,addCARorCDR('CDR,rhs)) l1 := defLET2(var1,addCARorCDR('CAR,rhs)) - MEMQ(var2,'(NIL _.)) => l1 - if PAIRP l1 and ATOM CAR l1 then l1 := cons(l1,nil) + var2 in '(NIL _.) => l1 + if CONSP l1 and ATOM CAR l1 then l1 := cons(l1,nil) IDENTP var2 => [:l1,defLetForm(var2,addCARorCDR('CDR,rhs))] l2 := defLET2(var2,addCARorCDR('CDR,rhs)) - if PAIRP l2 and ATOM CAR l2 then l2 := cons(l2,nil) + if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil) APPEND(l1,l2) lhs is ['APPEND,var1,var2] => patrev := defISReverse(var2,var1) @@ -302,7 +302,7 @@ defLET2(lhs,rhs) == g := INTERN STRCONC('"LETTMP#",STRINGIMAGE $letGenVarCounter) $letGenVarCounter := $letGenVarCounter + 1 l2 := defLET2(patrev,g) - if PAIRP l2 and ATOM CAR l2 then l2 := cons(l2,nil) + if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil) var1 = "." => [[$LET,g,rev],:l2] last l2 is [=$LET, =var1, val1] => [[$LET,g,rev],:REVERSE CDR REVERSE l2, @@ -322,7 +322,7 @@ defLET(lhs,rhs) == defLET1(lhs,rhs) addCARorCDR(acc,expr) == - NULL PAIRP expr => [acc,expr] + atom expr => [acc,expr] acc = 'CAR and expr is ["REVERSE",:.] => cons('last,QCDR expr) funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR @@ -368,35 +368,35 @@ defIS1(lhs,rhs) == ['AND,defIS1(lhs,d),MKPROGN [l,''T]] rhs is ['EQUAL,a] => ['EQUAL,lhs,a] - PAIRP lhs => + CONSP lhs => g := INTERN STRCONC('"ISTMP#",STRINGIMAGE $isGenVarCounter) $isGenVarCounter := $isGenVarCounter + 1 MKPROGN [[$LET,g,lhs],defIS1(g,rhs)] rhs is ['CONS,a,b] => a = "." => NULL b => - ['AND,['PAIRP,lhs], + ['AND,['CONSP,lhs], ['EQ,['QCDR,lhs],'NIL]] - ['AND,['PAIRP,lhs], + ['AND,['CONSP,lhs], defIS1(['QCDR,lhs],b)] NULL b => - ['AND,['PAIRP,lhs], + ['AND,['CONSP,lhs], ['EQ,['QCDR,lhs],'NIL],_ defIS1(['QCAR,lhs],a)] b = "." => - ['AND,['PAIRP,lhs],defIS1(['QCAR,lhs],a)] + ['AND,['CONSP,lhs],defIS1(['QCAR,lhs],a)] a1 := defIS1(['QCAR,lhs],a) b1 := defIS1(['QCDR,lhs],b) a1 is ['PROGN,c,''T] and b1 is ['PROGN,:cls] => - ['AND,['PAIRP,lhs],MKPROGN [c,:cls]] - ['AND,['PAIRP,lhs],a1,b1] + ['AND,['CONSP,lhs],MKPROGN [c,:cls]] + ['AND,['CONSP,lhs],a1,b1] rhs is ['APPEND,a,b] => patrev := defISReverse(b,a) g := INTERN STRCONC('"ISTMP#",STRINGIMAGE $isGenVarCounter) $isGenVarCounter := $isGenVarCounter + 1 - rev := ['AND,['PAIRP,lhs],['PROGN,[$LET,g,['REVERSE,lhs]],''T]] + rev := ['AND,['CONSP,lhs],['PROGN,[$LET,g,['REVERSE,lhs]],''T]] l2 := defIS1(g,patrev) - if PAIRP l2 and ATOM CAR l2 then l2 := cons(l2,nil) + if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil) a = "." => ['AND,rev,:l2] ['AND,rev,:l2,['PROGN,defLetForm(a,['NREVERSE,a]),''T]] SAY '"WARNING (defIS1): possibly bad IS code being generated" diff --git a/src/interp/g-error.boot b/src/interp/g-error.boot index f0774be7..3b5c67d6 100644 --- a/src/interp/g-error.boot +++ b/src/interp/g-error.boot @@ -95,7 +95,7 @@ errorSupervisor1(errorType,errorMsg,$BreakMode) == '"Error with unknown classification" msg := errorMsg is ['mathprint, :.] => errorMsg - not PAIRP errorMsg => ['" ", errorMsg] + atom errorMsg => ['" ", errorMsg] needsToSplitMessage errorMsg => rest [:['%l,'" ",u] for u in errorMsg] ['" ",:errorMsg] sayErrorly(errorLabel, msg) diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 12cdc4c7..808c3d31 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -115,7 +115,7 @@ subrname u == nil changeThrowToExit(s,g) == - atom s or MEMQ(first s,'(QUOTE SEQ REPEAT COLLECT)) => nil + atom s or first s in '(QUOTE SEQ REPEAT COLLECT) => nil s is ["THROW", =g,:u] => (rplac(first s,"EXIT"); rplac(rest s,u)) changeThrowToExit(first s,g) changeThrowToExit(rest s,g) @@ -166,7 +166,7 @@ optCall (x is ["call",:u]) == atom fn => (RPLAC(rest x,a); RPLAC(first x,fn)) fn is ["applyFun",name] => (RPLAC(first x,"SPADCALL"); RPLAC(rest x,[:a,name]); x) - fn is [q,R,n] and MEMQ(q,'(getShellEntry ELT QREFELT CONST)) => + fn is [q,R,n] and q in '(getShellEntry ELT QREFELT CONST) => not $bootStrapMode and (w:= optCallSpecially(q,x,n,R)) => w q="CONST" => ["spadConstant",R,n] emitIndirectCall(fn,a,x) @@ -259,7 +259,7 @@ optCond (x is ['COND,:l]) == AssocBarGensym(key,l) == for x in l repeat - PAIRP x => + CONSP x => EqualBarGensym(key,CAR x) => return x EqualBarGensym(x,y) == @@ -322,7 +322,7 @@ optSEQ ["SEQ",:l] == null aft => ["COND",:transform,'((QUOTE T) (conderr))] true => ["COND",:transform,['(QUOTE T),optSEQ ["SEQ",:aft]]] tryToRemoveSEQ l == - l is ["SEQ",[op,a]] and MEMQ(op,'(EXIT RETURN THROW)) => a + l is ["SEQ",[op,a]] and op in '(EXIT RETURN THROW) => a l optRECORDELT ["RECORDELT",name,ind,len] == @@ -429,7 +429,7 @@ findVMFreeVars form == ++ in `form'. varIsAssigned(var,form) == isAtomicForm form => false - form is [op,=var,:.] and MEMQ(op,'(%LET LETT SETQ)) => true + form is [op,=var,:.] and op in '(%LET LETT SETQ) => true or/[varIsAssigned(var,f) for f in form] ++ Subroutine of optLET. Return true if the variable `var' locally @@ -513,9 +513,9 @@ optCollectVector form == index := nil -- loop/vector index. for iter in iters while not fromList repeat [op,:.] := iter - MEMQ(op,'(SUCHTHAT WHILE UNTIL)) => fromList := true - MEMQ(op,'(IN ON)) => vecSize := [["SIZE",third iter],:vecSize] - MEMQ(op,'(STEP ISTEP)) => + op in '(SUCHTHAT WHILE UNTIL) => fromList := true + op in '(IN ON) => vecSize := [["SIZE",third iter],:vecSize] + op in '(STEP ISTEP) => -- pick a loop variable that we can use as the loop index. [.,var,lo,inc,:etc] := iter if lo = 0 and inc = 1 then diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index b01fbcf5..c6241500 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -152,7 +152,7 @@ ScanOrPairVec(f, ob) == CATCH('ScanOrPairVecAnswer, ScanOrInner(f, ob)) where ScanOrInner(f, ob) == HGET($seen, ob) => nil - PAIRP ob => + CONSP ob => HPUT($seen, ob, true) ScanOrInner(f, QCAR ob) ScanOrInner(f, QCDR ob) @@ -332,9 +332,9 @@ getUnionOrRecordTags u == Identity x == x -length1? l == PAIRP l and not PAIRP QCDR l +length1? l == CONSP l and not CONSP QCDR l -length2? l == PAIRP l and PAIRP (l := QCDR l) and not PAIRP QCDR l +length2? l == CONSP l and CONSP (l := QCDR l) and not CONSP QCDR l pairList(u,v) == [[x,:y] for x in u for y in v] @@ -498,8 +498,8 @@ listOfPatternIds x == isPatternVar v == -- a pattern variable consists of a star followed by a star or digit(s) - IDENTP(v) and MEMQ(v,'(_*_* _*1 _*2 _*3 _*4 _*5 _*6 _*7 _*8 _*9 _*10 - _*11 _*12 _*13 _*14 _*15 _*16 _*17 _*18 _*19 _*20)) and true + IDENTP(v) and v in '(_*_* _*1 _*2 _*3 _*4 _*5 _*6 _*7 _*8 _*9 _*10 + _*11 _*12 _*13 _*14 _*15 _*16 _*17 _*18 _*19 _*20) and true removeZeroOne x == -- replace all occurrences of (Zero) and (One) with @@ -715,7 +715,7 @@ augProplistOf(var,prop,val,e) == semchkProplist(x,proplist,prop,val) == prop="isLiteral" => LASSOC("value",proplist) or LASSOC("mode",proplist) => warnLiteral x - MEMQ(prop,'(mode value)) => + prop in '(mode value) => LASSOC("isLiteral",proplist) => warnLiteral x addBinding(var,proplist,e is [[curContour,:tailContour],:tailEnv]) == @@ -804,7 +804,7 @@ intern x == x isDomain a == - PAIRP a and VECP(CAR a) and + CONSP a and VECP(CAR a) and member(CAR(a).0, $domainTypeTokens) -- variables used by browser diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot index 77e2424a..c840f667 100644 --- a/src/interp/ht-util.boot +++ b/src/interp/ht-util.boot @@ -210,12 +210,12 @@ htpSetPageDescription(htPage, pageDescription) == iht line == -- issue a single hyperteTeX line, or a group of lines $newPage => nil - PAIRP line => + CONSP line => $htLineList := NCONC(nreverse mapStringize COPY_-LIST line, $htLineList) $htLineList := [basicStringize line, :$htLineList] bcIssueHt line == - PAIRP line => htMakePage1 line + CONSP line => htMakePage1 line iht line mapStringize l == @@ -404,7 +404,7 @@ htMakeTemplates(templateList, numLabels) == templateList := [templateParts template for template in templateList] [[substLabel(i, template) for template in templateList] for i in 1..numLabels] where substLabel(i, template) == - PAIRP template => + CONSP template => INTERN CONCAT(first template, PRINC_-TO_-STRING i, rest template) template @@ -520,7 +520,7 @@ checkCondition(s1, string, condList) == condErrorMsg type == typeString := form2String type - if PAIRP typeString then typeString := APPLY(function CONCAT, typeString) + if CONSP typeString then typeString := APPLY(function CONCAT, typeString) CONCAT('"Error: Could not make your input into a ", typeString) parseAndEval string == diff --git a/src/interp/htsetvar.boot b/src/interp/htsetvar.boot index 5b20b0da..57e66688 100644 --- a/src/interp/htsetvar.boot +++ b/src/interp/htsetvar.boot @@ -266,7 +266,7 @@ htSetNotAvailable(htPage,whatToType) == htDoNothing(htPage,command) == nil htCheck(checker,value) == - PAIRP checker => htCheckList(checker,parseWord value) + CONSP checker => htCheckList(checker,parseWord value) FUNCALL(checker,value) parseWord x == diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index 3f2ba6d3..6789b78e 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -166,7 +166,7 @@ pushDownTargetInfo(op,target,arglist) == pushDownOnArithmeticVariables(op,target,arglist) == -- tries to push appropriate target information onto variable -- occurring in arithmetic expressions - PAIRP(target) and CAR(target) = 'Variable => NIL + CONSP(target) and CAR(target) = 'Variable => NIL not MEMQ(op,'(_+ _- _* _*_* _/)) => NIL not containsPolynomial(target) => NIL for x in arglist for i in 1.. repeat @@ -175,7 +175,7 @@ pushDownOnArithmeticVariables(op,target,arglist) == getValue(x) or (xn = $immediateDataSymbol) => NIL t := getMinimalVariableTower(xn,target) or target if not getTarget(x) then putTarget(x,t) - PAIRP(x) => -- node + CONSP(x) => -- node [op',:arglist'] := x pushDownOnArithmeticVariables(getUnname op',target,arglist') arglist @@ -754,7 +754,7 @@ bottomUpFormRetract(t,op,opName,argl,amsl) == (i = 1) and (opName = "set!") => a := [x,:a] ms := [m,:ms] - if PAIRP(m) and CAR(m) = $EmptyMode then return NIL + if CONSP(m) and CAR(m) = $EmptyMode then return NIL object:= retract getValue x a:= [x,:a] object="failed" => diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index a6012574..612fa4db 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -696,7 +696,7 @@ absolutelyCannotCoerce(t1,t2) == (t1 = QFI) and int2 => true num2 := int2 or MEMQ(n2,scalars) or (t2 = QFI) - isVar1 := MEMQ(n1,'(Variable Symbol)) + isVar1 := n1 in '(Variable Symbol) num2 and isVar1 => true num2 and MEMQ(n1,$univariateDomains) => true @@ -902,7 +902,7 @@ coerceInt1(triple,t2) == NIL NIL - EQ(CAR(t1),'Variable) and PAIRP(t2) and + EQ(CAR(t1),'Variable) and CONSP(t2) and (isEqualOrSubDomain(t2,$Integer) or (t2 = [$QuotientField, $Integer]) or MEMQ(CAR(t2), '(RationalNumber BigFloat NewFloat Float DoubleFloat))) => NIL diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index da2d49db..b3249958 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -197,7 +197,7 @@ selectMms2(op,tar,args1,args2,$Coerce) == if tar and not isPartialMode tar then if xx := underDomainOf(tar) then a := cons(xx,a) for x in args1 repeat - PAIRP(x) and CAR(x) in '(List Vector Stream FiniteSet Array) => + CONSP(x) and CAR(x) in '(List Vector Stream FiniteSet Array) => xx := underDomainOf(x) => a := cons(xx,a) -- now extend this list with those from the arguments to @@ -221,7 +221,7 @@ selectMms2(op,tar,args1,args2,$Coerce) == (xm := get(name,'mode,$e)) and not isPartialMode xm => a' := cons(xm,a') a := append(a,REMDUP a') - a := [x for x in a | PAIRP(x)] + a := [x for x in a | CONSP(x)] -- step 1. see if we have one without coercing a' := a @@ -453,7 +453,7 @@ defaultTargetFE(a,:options) == IFCAR options => [$FunctionalExpression, ['Complex, $Integer]] [$FunctionalExpression, $Integer] a is ['Complex,uD] => defaultTargetFE(uD, true) - a is [D,uD] and MEMQ(D, '(Polynomial RationalFunction Fraction)) => + a is [D,uD] and D in '(Polynomial RationalFunction Fraction) => defaultTargetFE(uD, IFCAR options) a is [=$FunctionalExpression,.] => a IFCAR options => [$FunctionalExpression, ['Complex, a]] @@ -529,11 +529,11 @@ CONTAINEDisDomain(symbol,cond) == -- looks for [isSubDomain,symbol,[domain]] in cond: returning T or NIL -- with domain being one of PositiveInteger and NonNegativeInteger ATOM cond => false - MEMQ(QCAR cond,'(AND OR and or)) => + QCAR cond in '(AND OR and or) => or/[CONTAINEDisDomain(symbol, u) for u in QCDR cond] EQ(QCAR cond,'isDomain) => - EQ(symbol,CADR cond) and PAIRP(dom:=CADDR cond) and - MEMQ(dom,'(PositiveInteger NonNegativeInteger)) + EQ(symbol,CADR cond) and CONSP(dom:=CADDR cond) and + dom in '(PositiveInteger NonNegativeInteger) false selectDollarMms(dc,name,types1,types2) == @@ -875,7 +875,7 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == -- in the domain of computation dc -- tar may be NIL (= unknown) dcName:= CAR dc - not MEMQ(dcName,'(Record Union Enumeration)) => NIL + not (dcName in '(Record Union Enumeration)) => NIL fun:= NIL -- cat := constructorCategory dc makeFunc := GETL(dcName,"makeFunctionList") or @@ -887,7 +887,7 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == for [a,b,d] in funlist repeat not EQ(a,op) => nil d is ['XLAM,xargs,:.] => - if PAIRP(xargs) then maxargs := MAX(maxargs,#xargs) + if CONSP(xargs) then maxargs := MAX(maxargs,#xargs) else maxargs := MAX(maxargs,1) impls := cons([b,nil,true,d],impls) impls := cons([b,d,true,d],impls) @@ -988,7 +988,7 @@ filterModemapsFromPackages(mms, names, op) == isFreeFunctionFromMm(mm) => bad := cons(mm, bad) type := getDomainFromMm mm null type => bad := cons(mm,bad) - if PAIRP type then type := first type + if CONSP type then type := first type getConstructorKindFromDB type = "category" => bad := cons(mm,bad) name := object2String type found := nil @@ -1004,7 +1004,7 @@ filterModemapsFromPackages(mms, names, op) == isTowerWithSubdomain(towerType,elem) == - not PAIRP towerType => NIL + atom towerType => NIL dt := deconstructT towerType 2 ~= #dt => NIL s := underDomainOf(towerType) @@ -1175,7 +1175,7 @@ evalMmStack(mmC) == evalMmStack CONS('AND,[['ofCategory,pvar,c] for c in args]) mmC is ['ofType,:.] => [NIL] mmC is ["has",pat,x] => - MEMQ(x,'(ATTRIBUTE SIGNATURE)) => + x in '(ATTRIBUTE SIGNATURE) => [[['ofCategory,pat,['CATEGORY,'unknown,x]]]] [['ofCategory,pat,x]] [[mmC]] @@ -1190,7 +1190,7 @@ evalMmStackInner(mmC) == mmC is ['ofType,:.] => NIL mmC is ['isAsConstant] => NIL mmC is ["has",pat,x] => - MEMQ(x,'(ATTRIBUTE SIGNATURE)) => + x in '(ATTRIBUTE SIGNATURE) => [['ofCategory,pat,['CATEGORY,'unknown,x]]] [['ofCategory,pat,x]] [mmC] @@ -1244,7 +1244,7 @@ doReplaceSharpCalls t == noSharpCallsHere t == t isnt [con, :args] => true - MEMQ(con,'(construct _#)) => NIL + con in '(construct _#) => NIL and/[noSharpCallsHere u for u in args] coerceTypeArgs(t1, t2, SL) == @@ -1610,7 +1610,7 @@ hasAtt(dom,att,SL) == $domPvar: local := nil fun:= CAR dom => atts:= subCopy(getConstructorAttributesFromDB fun,constructSubst dom) => - PAIRP (u := getInfovec CAR dom) => + CONSP (u := getInfovec CAR dom) => --UGH! New world has attributes stored as pairs not as lists!! for [x,:cond] in atts until not (S='failed) repeat S:= unifyStruct(x,att,copy SL) diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index 739bde15..3c8eda00 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -223,7 +223,7 @@ mkAtree3(x,op,argl) == r := mkAtreeValueOf r v := null arg => VECTOR(NIL,NIL,NIL) - PAIRP arg and rest arg and first arg ~= "|" => + CONSP arg and rest arg and first arg ~= "|" => collectDefTypesAndPreds ["tuple",:arg] null rest arg => collectDefTypesAndPreds first arg collectDefTypesAndPreds arg @@ -240,7 +240,7 @@ mkAtree3(x,op,argl) == a is [op,:arg] => v := null arg => VECTOR(NIL,NIL,NIL) - PAIRP arg and rest arg and first arg ~= "|" => + CONSP arg and rest arg and first arg ~= "|" => collectDefTypesAndPreds ["tuple",:arg] null rest arg => collectDefTypesAndPreds first arg collectDefTypesAndPreds arg @@ -395,7 +395,7 @@ getValueFromEnvironment(x,mode) == objValUnwrap v getValueFromSpecificEnvironment(id,mode,e) == - PAIRP e => + CONSP e => u := get(id,'value,e) => objMode(u) = $EmptyMode => systemErrorHere ["getValueFromSpecificEnvironment",id] diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index 0b2807df..f755f036 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -88,7 +88,7 @@ addDefMap(['DEF,lhs,mapsig,.,rhs],pred) == -- next check is for bad forms on the lhs of the ==, such as -- numbers, constants. - if not PAIRP lhs then + if atom lhs then op := lhs putHist(op,'isInterpreterRule,true,$e) putHist(op,'isInterpreterFunction,false,$e) @@ -717,7 +717,7 @@ genMapCode(op,body,sig,fnName,parms,isRecursive) == op if $verbose then if get(op,'isInterpreterRule,$e) then - sayKeyedMsg("S2IM0014",[op0,(PAIRP sig =>prefix2String CAR sig;'"?")]) + sayKeyedMsg("S2IM0014",[op0,(CONSP sig =>prefix2String CAR sig;'"?")]) else sayKeyedMsg("S2IM0015",[op0,formatSignature sig]) $whereCacheList := [op,:$whereCacheList] @@ -915,7 +915,7 @@ nonRecursivePart1(opName, funBody) == funBody is [op,:argl] => op=opName => '%noMapVal args:= [nonRecursivePart1(opName,arg) for arg in argl] - MEMQ('%noMapVal,args) => '%noMapVal + '%noMapVal in args => '%noMapVal [op,:args] funBody @@ -1022,7 +1022,7 @@ findLocalVars1(op,form) == form is ['is,l,pattern] => findLocalVars1(op,l) for var in listOfVariables CDR pattern repeat mkLocalVar(op,var) - form is [oper,:itrl,body] and MEMQ(oper,'(REPEAT COLLECT)) => + form is [oper,:itrl,body] and oper in '(REPEAT COLLECT) => findLocalsInLoop(op,itrl,body) form is [y,:argl] => y is "Record" or (y is "Union" and argl is [[":",.,.],:.]) => @@ -1067,7 +1067,7 @@ listOfVariables pat == IDENTP pat => (pat='_. => nil ; [pat]) pat is ['_:,var] or pat is ['_=,var] => (var='_. => NIL ; [var]) - PAIRP pat => REMDUP [:listOfVariables p for p in pat] + CONSP pat => REMDUP [:listOfVariables p for p in pat] nil getMapBody(op,mapDef) == diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot index 593b2d08..e9c4386d 100644 --- a/src/interp/i-object.boot +++ b/src/interp/i-object.boot @@ -288,7 +288,7 @@ getUnname1 x == ++ returns the mode-set of VAT node x. getModeSet x == - x and PAIRP x => getModeSet first x + x and CONSP x => getModeSet first x VECP x => y:= x.aModeSet => (y = [$EmptyMode]) and ((m := getMode x) is ['Mapping,:.]) => @@ -320,7 +320,7 @@ getModeOrFirstModeSetIfThere x == NIL getModeSetUseSubdomain x == - x and PAIRP x => getModeSetUseSubdomain first x + x and CONSP x => getModeSetUseSubdomain first x VECP(x) => -- don't play subdomain games with retracted args getAtree(x,'retracted) => getModeSet x diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index 3ff2f418..23d9e6cb 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -494,7 +494,7 @@ outputTran x == x x is [c,var,mode] and c in '(_pretend _: _:_: _@) => var := outputTran var - if PAIRP var then var := ['PAREN,var] + if CONSP var then var := ['PAREN,var] ['CONCATB,var,c,obj2String prefix2String mode] x is ['ADEF,vars,.,.,body] => vars := @@ -1195,7 +1195,7 @@ LargeMatrixp(u,width, dist) == op:=CAAR u op = 'MATRIX => largeMatrixAlist u --We already know the structure is more than 'width' wide - MEMQ(op,'(%LET RARROW SEGMENT _- CONCAT CONCATB PAREN BRACKET BRACE)) => + op in '(%LET RARROW SEGMENT _- CONCAT CONCATB PAREN BRACKET BRACE) => --Each of these prints the arguments in a width 3 smaller dist:=dist-3 width:=width-3 @@ -1206,7 +1206,7 @@ LargeMatrixp(u,width, dist) == dist<0 => return nil ans --Relying that falling out of a loop gives nil - MEMQ(op,'(_+ _* )) => + op in '(_+ _* ) => --Each of these prints the first argument in a width 3 smaller (ans:=LargeMatrixp(CADR u,width-3,dist)) => largeMatrixAlist ans n:=3+WIDTH CADR u @@ -1736,7 +1736,7 @@ charyTrouble1(u,v,start,linelength) == NUMBERP u => outputNumber(start,linelength,atom2String u) atom u => outputString(start,linelength,atom2String u) EQ(x:= keyp u,'_-) => charyMinus(u,v,start,linelength) - MEMQ(x,'(_+ _* AGGLST)) => charySplit(u,v,start,linelength) + x in '(_+ _* AGGLST) => charySplit(u,v,start,linelength) x='EQUATNUM => charyEquatnum(u,v,start,linelength) d := GETL(x,'INFIXOP) => charyBinary(d,u,v,start,linelength) x = 'OVER => diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot index 35ca24ce..03baca9e 100644 --- a/src/interp/i-resolv.boot +++ b/src/interp/i-resolv.boot @@ -164,7 +164,7 @@ resolveTTSpecial(t1,t2) == -- things. (RSS 1/-86) -- following is just an efficiency hack - (t1 = $Symbol or t1 is ['OrderedVariableList,.]) and PAIRP(t2) and + (t1 = $Symbol or t1 is ['OrderedVariableList,.]) and CONSP(t2) and CAR(t2) in '(Polynomial RationalFunction) => t2 (t1 = $Symbol) and ofCategory(t2, '(IntegerNumberSystem)) => @@ -344,7 +344,7 @@ resolveTTRed3(t) == for x in t for cs in getDualSignatureFromDB first t ] interpOp?(op) == - PAIRP(op) and + CONSP(op) and CAR(op) in '(Incl SetDiff SetComp SetInter SetUnion VarEqual SetEqual) --% Resolve Type with Category @@ -410,7 +410,7 @@ getConditionsForCategoryOnType(t,cat) == getConditionalCategoryOfType(t,[NIL],['ATTRIBUTE,cat]) getConditionalCategoryOfType(t,conditions,match) == - if PAIRP t then t := first t + if CONSP t then t := first t t in '(Union Mapping Record) => NIL conCat := getConstructorCategoryFromDB t REMDUP CDR getConditionalCategoryOfType1(conCat,conditions,match,[NIL]) @@ -447,8 +447,8 @@ matchUpToPatternVars(pat,form,patAlist) == (p := assoc(pat,patAlist)) => EQUAL(form,CDR p) patAlist := [[pat,:form],:patAlist] true - PAIRP(pat) => - not (PAIRP form) => NIL + CONSP(pat) => + atom form => NIL matchUpToPatternVars(CAR pat, CAR form,patAlist) and matchUpToPatternVars(CDR pat, CDR form,patAlist) NIL @@ -595,7 +595,7 @@ resolveTMSpecial(t,m) == t = $AnonymousFunction and m is ['Mapping,:.] => m t is ['Variable,x] and m is ['OrderedVariableList,le] => isPatternVar le => ['OrderedVariableList,[x]] - PAIRP(le) and member(x,le) => le + CONSP(le) and member(x,le) => le NIL t is ['Fraction, ['Complex, t1]] and m is ['Complex, m1] => resolveTM1(['Complex, ['Fraction, t1]], m) @@ -682,13 +682,13 @@ resolveTMRed1(t) == t is ['Resolve,a,b] => ( a := resolveTMRed1 a ) and ( b := resolveTMRed1 b ) and resolveTM1(a,b) - t is ['Incl,a,b] => PAIRP b and member(a,b) and b - t is ['Diff,a,b] => PAIRP a and member(b,a) and SETDIFFERENCE(a,[b]) - t is ['SetIncl,a,b] => PAIRP b and "and"/[member(x,b) for x in a] and b - t is ['SetDiff,a,b] => PAIRP b and PAIRP b and + t is ['Incl,a,b] => CONSP b and member(a,b) and b + t is ['Diff,a,b] => CONSP a and member(b,a) and SETDIFFERENCE(a,[b]) + t is ['SetIncl,a,b] => CONSP b and "and"/[member(x,b) for x in a] and b + t is ['SetDiff,a,b] => CONSP b and CONSP b and intersection(a,b) and SETDIFFERENCE(a,b) t is ['VarEqual,a,b] => (a = b) and b - t is ['SetComp,a,b] => PAIRP a and PAIRP b and + t is ['SetComp,a,b] => CONSP a and CONSP b and "and"/[member(x,a) for x in b] and SETDIFFERENCE(a,b) t is ['SimpleAlgebraicExtension,a,b,p] => -- this is a hack. RSS ['SimpleAlgebraicExtension, resolveTMRed1 a, resolveTMRed1 b,p] @@ -711,7 +711,7 @@ equiType(t) == t getUnderModeOf d == - not PAIRP d => NIL + not CONSP d => NIL -- n := LASSOC(first d,$underDomainAlist) => d.n ----> $underDomainAlist NOW always NIL for a in rest d for m in rest destructT d repeat if m then return a diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index 76ff6c4b..6851de3c 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -965,7 +965,7 @@ upconstruct t == tar is ['Record,:types] => upRecordConstruct(op,l,tar) isTaggedUnion tar => upTaggedUnionConstruct(op,l,tar) aggs := '(List) - if tar and PAIRP(tar) and not isPartialMode(tar) then + if tar and CONSP(tar) and not isPartialMode(tar) then CAR(tar) in aggs => ud := (l is [[realOp, :.]]) and (getUnname(realOp) = 'COLLECT) => tar @@ -1150,7 +1150,7 @@ declare(var,mode) == -- otherwise it looks like (tuple #1 #2 ...) nargs := null margs => 0 - PAIRP margs => -1 + #margs + CONSP margs => -1 + #margs 1 nargs ~= #args => throwKeyedMsg("S2IM0008",[var]) if $compilingMap then mkLocalVar($mapName,var) @@ -1196,8 +1196,8 @@ isDomainValuedVariable form == -- returns the value of form if form is a variable with a type value IDENTP form and (val := ( get(form,'value,$InteractiveFrame) or _ - (PAIRP($env) and get(form,'value,$env)) or _ - (PAIRP($e) and get(form,'value,$e)))) and + (CONSP($env) and get(form,'value,$env)) or _ + (CONSP($e) and get(form,'value,$e)))) and (member(m := objMode(val),'((Domain) (Category))) or conceptualType m = $Category) => objValUnwrap(val) @@ -1236,25 +1236,25 @@ isPolynomialMode m == -- variables, and nil otherwise m is [op,a,:rargs] => a := removeQuote a - MEMQ(op,'(Polynomial RationalFunction AlgebraicFunction Expression + op in '(Polynomial RationalFunction AlgebraicFunction Expression ElementaryFunction LiouvillianFunction FunctionalExpression - CombinatorialFunction ))=> 'all + CombinatorialFunction) => 'all op = 'UnivariatePolynomial => LIST a op = 'Variable => LIST a - MEMQ(op,'(MultivariatePolynomial DistributedMultivariatePolynomial - HomogeneousDistributedMultivariatePolynomial)) => a + op in '(MultivariatePolynomial DistributedMultivariatePolynomial + HomogeneousDistributedMultivariatePolynomial) => a NIL NIL containsPolynomial m == - not PAIRP(m) => NIL + atom m => NIL [d,:.] := m d in $univariateDomains or d in $multivariateDomains or d in '(Polynomial RationalFunction) => true (m' := underDomainOf m) and containsPolynomial m' containsVariables m == - not PAIRP(m) => NIL + atom m => NIL [d,:.] := m d in $univariateDomains or d in $multivariateDomains => true (m' := underDomainOf m) and containsVariables m' diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot index a82579b9..10fff2dc 100644 --- a/src/interp/i-spec2.boot +++ b/src/interp/i-spec2.boot @@ -138,7 +138,7 @@ upDollar t == if x then putTarget(y,x) putAtree(first form,"dollar",t) ms := bottomUp form - f in '(One Zero) and PAIRP(ms) and CAR(ms) = $OutputForm => + f in '(One Zero) and CONSP (ms) and CAR(ms) = $OutputForm => throwKeyedMsg("S2IS0021",[f,t]) putValue(op,getValue first form) putModeSet(op,ms) @@ -500,7 +500,7 @@ up%LET t == -- binding t isnt [op,lhs,rhs] => nil $declaredMode: local := NIL - PAIRP lhs => + CONSP lhs => var:= getUnname first lhs var = "construct" => upLETWithPatternOnLhs t var = "QUOTE" => throwKeyedMsg("S2IS0027",['"A quoted form"]) @@ -619,7 +619,7 @@ upLETWithPatternOnLhs(t := [op,pattern,a]) == evalLETchangeValue(name,value) == -- write the value of name into the environment, clearing dependent -- maps if its type changes from its last value - localEnv := PAIRP $env + localEnv := CONSP $env clearCompilationsFlag := val:= (localEnv and get(name,'value,$env)) or get(name,'value,$e) null val => @@ -1075,7 +1075,7 @@ uptuple t == null l => upNullTuple(op,l,tar) isTaggedUnion tar => upTaggedUnionConstruct(op,l,tar) aggs := '(List) - if tar and PAIRP(tar) and not isPartialMode(tar) then + if tar and CONSP(tar) and not isPartialMode(tar) then CAR(tar) in aggs => ud := CADR tar for x in l repeat if not getTarget(x) then putTarget(x,ud) diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index b81e1a2a..2305ecda 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -249,7 +249,7 @@ abbreviationsSpad2Cmd l == listConstructorAbbreviations() == x := UPCASE queryUserKeyedMsg("S2IZ0056",NIL) - MEMQ(STRING2ID_-N(x,1),'(Y YES)) => + STRING2ID_-N(x,1) in '(Y YES) => whatSpad2Cmd '(categories) whatSpad2Cmd '(domains) whatSpad2Cmd '(packages) @@ -362,7 +362,7 @@ clearCmdParts(l is [opt,:vl]) == option='properties => if isMap x then (lm := get(x,'localModemap,$InteractiveFrame)) => - PAIRP lm => untraceMapSubNames [CADAR lm] + CONSP lm => untraceMapSubNames [CADAR lm] NIL for p2 in CDR p1 repeat prop:= CAR p2 @@ -405,7 +405,7 @@ close args == sockSendInt($SessionManager, $currentFrameNum) closeInterpreterFrame(NIL) x := UPCASE queryUserKeyedMsg('"S2IZ0072", nil) - MEMQ(STRING2ID_-N(x,1), '(YES Y)) => + STRING2ID_-N(x,1) in '(YES Y) => coreQuit() -- ??? should be coreQuit errorCount() nil @@ -833,7 +833,7 @@ compileSpad2Cmd args == fullopt = "optimize" => setCompilerOptimizations first optargs fullopt = "report" => null optargs => throwKeyedMsg("S2IZ0037",['")report"]) - if MEMQ("insn",optargs) then + if "insn" in optargs then $reportOptimization := true throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)]) @@ -1121,7 +1121,7 @@ getWorkspaceNames() == displayOperations l == null l => x := UPCASE queryUserKeyedMsg("S2IZ0058",NIL) - if MEMQ(STRING2ID_-N(x,1),'(Y YES)) + if STRING2ID_-N(x,1) in '(Y YES) then for op in allOperations() repeat reportOpSymbol op else sayKeyedMsg("S2IZ0059",NIL) nil @@ -1377,13 +1377,13 @@ frameSpad2Cmd args == if args is [a] then args := a if ATOM args then args := object2Identifier args arg = 'drop => - args and PAIRP(args) => throwKeyedMsg("S2IZ0017",[args]) + args and CONSP(args) => throwKeyedMsg("S2IZ0017",[args]) closeInterpreterFrame(args) arg = "import" => importFromFrame args arg = "last" => previousInterpreterFrame() arg = "names" => displayFrameNames() arg = "new" => - args and PAIRP(args) => throwKeyedMsg("S2IZ0017",[args]) + args and CONSP(args) => throwKeyedMsg("S2IZ0017",[args]) addNewInterpreterFrame(args) arg = "next" => nextInterpreterFrame() @@ -1523,7 +1523,7 @@ importFromFrame args == fenv := frameEnvironment fname null args => x := UPCASE queryUserKeyedMsg("S2IZ0076",[fname]) - MEMQ(STRING2ID_-N(x,1),'(Y YES)) => + STRING2ID_-N(x,1) in '(Y YES) => vars := NIL for [v,:props] in CAAR fenv repeat v = "--macros" => @@ -1620,7 +1620,7 @@ historySpad2Cmd() == initHistList() sayKeyedMsg("S2IH0008",NIL) x := UPCASE queryUserKeyedMsg("S2IH0009",NIL) - MEMQ(STRING2ID_-N(x,1),'(Y YES)) => + STRING2ID_-N(x,1) in '(Y YES) => histFileErase histFileName() $HiFiAccess:= true $options := nil @@ -2054,7 +2054,7 @@ writify ob == null ob => nil (e := HGET($seen, ob)) => e - PAIRP ob => + CONSP ob => qcar := QCAR ob qcdr := QCDR ob (name := spadClosure? ob) => @@ -2127,7 +2127,7 @@ writify ob == unwritable? ob == - PAIRP ob or VECP ob => false -- first for speed + CONSP ob or VECP ob => false -- first for speed COMPILED_-FUNCTION_-P ob or HASHTABLEP ob => true PLACEP ob or READTABLEP ob => true FLOATP ob => true @@ -2161,7 +2161,7 @@ dewritify ob == null ob => nil e := HGET($seen, ob) => e - PAIRP ob and CAR ob = 'WRITIFIED_!_! => + CONSP ob and CAR ob = 'WRITIFIED_!_! => type := ob.1 type = 'SELF => 'WRITIFIED_!_! @@ -2213,7 +2213,7 @@ dewritify ob == fval error '"Unknown type to de-writify." - PAIRP ob => + CONSP ob => qcar := QCAR ob qcdr := QCDR ob nob := CONS(qcar, qcdr) @@ -2321,7 +2321,7 @@ quitSpad2Cmd() == '" Please select Exit from the File Menu instead."]) $quitCommandType ~= 'protected => leaveScratchpad() x := UPCASE queryUserKeyedMsg("S2IZ0031",NIL) - MEMQ(STRING2ID_-N(x,1),'(Y YES)) => leaveScratchpad() + STRING2ID_-N(x,1) in '(Y YES) => leaveScratchpad() sayKeyedMsg("S2IZ0032",NIL) TERSYSCOMMAND () @@ -2867,7 +2867,7 @@ whatSpad2Cmd l == DOWNCASE x key = 'things => for opt in $whatOptions repeat - not MEMQ(opt,'(things)) => whatSpad2Cmd [opt,:args] + not (opt in '(things)) => whatSpad2Cmd [opt,:args] key = 'categories => filterAndFormatConstructors('category,'"Categories",args) key = 'commands => diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot index c05893f4..0a9563b3 100644 --- a/src/interp/i-toplev.boot +++ b/src/interp/i-toplev.boot @@ -302,7 +302,7 @@ interpretTopLevel(x, posnForm) == c interpret(x, :restargs) == - posnForm := if PAIRP restargs then CAR restargs else restargs + posnForm := if CONSP restargs then CAR restargs else restargs --type analyzes and evaluates expression x, returns object $env:local := [[nil]] $eval:local := true --generate code-- don't just type analyze diff --git a/src/interp/interop.boot b/src/interp/interop.boot index e56e396a..8005b868 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -131,7 +131,7 @@ makeLazyOldAxiomDispatchDomain domform == dd makeOldAxiomDispatchDomain dom == - PAIRP dom => dom + CONSP dom => dom [$oldAxiomDomainDispatch,hashTypeForm(dom.0,0),:dom] closeOldAxiomFunctor(name) == @@ -453,7 +453,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) == (success ~= 'failed) and success => if $monitorNewWorld then sayLooking1('"<----",uu) where uu() == - PAIRP success => [first success,:devaluate rest success] + CONSP success => [first success,:devaluate rest success] success success subsumptionSig and (u:= basicLookup(op,subsumptionSig,domain,dollar)) => u @@ -603,7 +603,7 @@ HasCategory(domain,catform') == slot4 := domain.4 catlist := slot4.1 member(catform,catlist) or - MEMQ(opOf(catform),'(Object Type)) or --temporary hack + opOf(catform) in '(Object Type) or --temporary hack or/[compareSigEqual(catform,cat,domain0,domain) for cat in catlist] --systemDependentMkAutoload(fn,cnam) == diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 0dd20228..8e52317a 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -290,7 +290,7 @@ unloadOneConstructor(cnam,fn) == compileConstructorLib(l,op,editFlag,traceFlag) == --this file corresponds to /C,1 - MEMQ('_?,l) => return editFile '(_/C TELL _*) + '_? in l => return editFile '(_/C TELL _*) optionList:= _/OPTIONS l funList:= TRUNCLIST(l,optionList) or [_/FN] options:= [[UPCASE CAR x,:CDR x] for x in optionList] @@ -645,9 +645,9 @@ isFunctor x == not IDENTP op => false $InteractiveMode => MEMQ(op,$DomainNames) => true - MEMQ(getConstructorKindFromDB op,'(domain package)) + getConstructorKindFromDB op in '(domain package) u:= get(op,'isFunctor,$CategoryFrame) - or MEMQ(op,'(SubDomain Union Record Enumeration)) => u + or op in '(SubDomain Union Record Enumeration) => u ab := getConstructorAbbreviationFromDB op => if getConstructorKindFromDB op = "category" then updateCategoryFrameForCategory op diff --git a/src/interp/mark.boot b/src/interp/mark.boot index 84430fb6..575d3d08 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -238,7 +238,7 @@ markInValue(y ,e) == [y', m, e] := T := comp(y1, $EmptyMode, e) or return nil markImport m m = "$" and LASSOC('value,getProplist('Rep,e)) is [a,:.] and - MEMQ(opOf a,'(List Vector)) => [markRepper('rep, y'), 'Rep, e] + opOf a in '(List Vector) => [markRepper('rep, y'), 'Rep, e] T markReduceIn(it, pr) == markReduceIterator("in",it,pr) @@ -263,7 +263,7 @@ markRepeat(form, T) == [mkWi("repeat", 'WI,form,CAR T), :CDR T] markTran(form,form',[dc,:sig],env) == --from compElt/compFormWithModemap - dc ~= 'Rep or not MEMQ('_$,sig) => mkWi('markTran,'WI,form,['call,:form']) + dc ~= 'Rep or not ('_$ in sig) => mkWi('markTran,'WI,form,['call,:form']) argl := [u for t in rest sig for arg in rest form'] where u() == t='_$ => argSource := getSourceWI arg @@ -283,9 +283,9 @@ markImport(d,:option) == --from compFormWithModemap/genDeltaEntry/compImport if CONTAINED('PART,d) then pause d declared? := IFCAR option null d or d = $Representation => nil - d is [op,:.] and MEMQ(op,'(Boolean Mapping Void Segment UniversalSegment)) => nil + d is [op,:.] and op in '(Boolean Mapping Void Segment UniversalSegment) => nil STRINGP d or (IDENTP d and (PNAME d).0 = char '_#) => nil - MEMQ(d,'(_$ _$NoValueMode _$EmptyMode Void)) => nil + d in '(_$ _$NoValueMode _$EmptyMode Void) => nil -------=======+> WHY DOESN'T THIS WORK???????????? --if (d' := macroExpand(d,$e)) ~= d then markImport(d',declared?) dom := markMacroTran d @@ -303,7 +303,7 @@ markMacroTran name == --called by markImport u := or/[x for [x,:y] in $globalMacroStack | y = name] => u u := or/[x for [x,:y] in $localMacroStack | y = name] => u [op,:argl] := name - MEMQ(op,'(Record Union)) => + op in '(Record Union) => -- pp ['"Cannot find: ",name] name [op,:[markMacroTran x for x in argl]] @@ -427,7 +427,7 @@ reduceImports1 x == getImpliedImports x == x is [[op,:r],:y] => - MEMQ(op, '(List Enumeration)) => union(r, getImpliedImports y) + op in '(List Enumeration) => union(r, getImpliedImports y) getImpliedImports y nil @@ -476,7 +476,7 @@ markEncodeChanges(x,s) == --first time only: put ORIGNAME on property list of operators with a ; in name if null s then markOrigName x x is [fn,a,b,c] and MEMQ(fn,$markChoices) => - x is ['ATOM,.,['REPLACE,[y],:.],:.] and MEMQ(y,'(false true)) => 'skip + x is ['ATOM,.,['REPLACE,[y],:.],:.] and y in '(false true) => 'skip ---------------------------------------------------------------------- if c then ----> special case: DON'T STACK A nil!!!! i := getSourceWI c @@ -498,10 +498,10 @@ markEncodeChanges(x,s) == s := [i,:s] markRecord(a,b,s) markEncodeChanges(t,s) - i is [fn,:.] and MEMQ(fn, '(REPEAT COLLECT)) => markEncodeLoop(i,r,s) + i is [fn,:.] and fn in '(REPEAT COLLECT) => markEncodeLoop(i,r,s) t := getTargetWI r markEncodeChanges(t,[i,:s]) - x is ['PROGN,a,:.] and s is [[op,:.],:.] and MEMQ(op,'(REPEAT COLLECT)) => + x is ['PROGN,a,:.] and s is [[op,:.],:.] and op in '(REPEAT COLLECT) => markEncodeChanges(a,s) x is ['TAGGEDreturn,a,[y,:.]] => markEncodeChanges(y,s) x is ['CATCH,a,y] => markEncodeChanges(y,s) @@ -527,7 +527,7 @@ markOrigName x == markEncodeLoop(i, r, s) == [.,:itl1, b1] := i --op is REPEAT or COLLECT if r is ["%LET",.,a] then r := a - r is [op1,:itl2,b2] and MEMQ(op1, '(REPEAT COLLECT)) => + r is [op1,:itl2,b2] and op1 in '(REPEAT COLLECT) => for it1 in itl1 for it2 in itl2 repeat markEncodeChanges(it2,[it1,:s]) markEncodeChanges(b2, [b1,:s]) markEncodeChanges(r, [i,:s]) @@ -567,7 +567,7 @@ markRecord(source,target,u) == FIXP item or item = $One or item = $Zero => nil item is ["-",a] and (FIXP a or a = $One or a = $Zero) => nil STRINGP item => nil - item is [op,.,t] and MEMQ(op,'( _:_: _@ _pretend)) + item is [op,.,t] and op in '( _:_: _@ _pretend) and macroExpand(t,$e) = target => nil $source: local := source $target: local := target @@ -669,7 +669,7 @@ markPaths(x,y,s) == --x < y; find location s of x in y (initially s=nil) y is [['elt,.,op],:r] and (u := markPaths(x,[op,:r],s)) => u x is ['elt,:r] and (u := markPaths(r,y,s)) => u y is ['elt,:r] and (u := markPaths(x,r,s)) => u - x is [op,:u] and MEMQ(op,'(LIST VECTOR)) and y is ['construct,:v] and + x is [op,:u] and op in '(LIST VECTOR) and y is ['construct,:v] and (p := markPaths(['construct,:u],y,s)) => p atom y => nil y is ["%LET",a,b] and IDENTP a => @@ -682,7 +682,7 @@ markPaths(x,y,s) == --x < y; find location s of x in y (initially s=nil) -- x is ['exit,a,b] and y is ['exit,a,c] and (p := mymy markPathsEqual(b,c)) => -- markCons(p,s) y is ['call,:r] => markPaths(x,r,s) --for loops - y is [fn,m,y1] and MEMQ(fn,'(PART CATCH THROW)) => markPaths(x,y1,s) or + y is [fn,m,y1] and fn in '(PART CATCH THROW) => markPaths(x,y1,s) or "APPEND"/[markPaths(x,u,markCons(i,s)) for u in y1 for i in 0..] "APPEND"/[markPaths(x,u,markCons(i,s)) for u in y for i in 0..] @@ -694,7 +694,7 @@ markPathsEqual(x,y) == x = y => true x is ["::",.,a] and y is ["::",.,b] and a = $Integer and b = $NonNegativeInteger => true - y is [fn,.,z] and MEMQ(fn,'(PART CATCH THROW)) and markPathsEqual(x,z) => true + y is [fn,.,z] and fn in '(PART CATCH THROW) and markPathsEqual(x,z) => true y is ["%LET",a,b] and GENSYMP a and markPathsEqual(x,b) => true y is ['IF,a,b,:.] and GENSYMP a => markPathsEqual(x,b) -------> ??? y is ['call,:r] => markPathsEqual(IFCDR x,r) @@ -779,30 +779,30 @@ markInsertChanges(code,form,t,loc) == ['SEQ,:[markInsertSeq(code,x,t) for x in y], ['exit,1,markInsertChanges(code,z,t,nil)]] code = '_pretend or code = '_: => - form is [op,a,.] and MEMQ(op,'(_@ _: _:_: _pretend)) => ['_pretend,a,t] + form is [op,a,.] and op in '(_@ _: _:_: _pretend) => ['_pretend,a,t] [code,form,t] - MEMQ(code,'(_@ _:_: _pretend)) => - form is [op,a,b] and MEMQ(op,'(_@ _: _:_: _pretend)) => - MEMQ(op,'(_: _pretend)) => form + code in '(_@ _:_: _pretend) => + form is [op,a,b] and op in '(_@ _: _:_: _pretend) => + op in '(_: _pretend) => form op = code and b = t => form markNumCheck(code,form,t) FIXP form and MEMQ(opOf t,$markPrimitiveNumbers) => ['_@,form,t] [code,form,t] - MEMQ(code,'(_@ _:_: _:)) and form is [op,a] and + code in '(_@ _:_: _:) and form is [op,a] and (op='rep and t = 'Rep or op='per and t = "$") => form code = 'Lisp => t = $EmptyMode => form ["pretend",form,t] - MEMQ(t,'(rep per)) => + t in '(rep per) => t = 'rep and form is ["per",:.] => CADR form t = 'per and form is ["rep",:.] => CADR form [t,form] - code is [op,x,t1] and MEMQ(op,'(_@ _: _:_: _pretend)) and t1 = t => form + code is [op,x,t1] and op in '(_@ _: _:_: _pretend) and t1 = t => form FIXP form and MEMQ(opOf t,$markPrimitiveNumbers) => ['_@,form,t] markNumCheck("::",form,t) markNumCheck(op,form,t) == - op = "::" and MEMQ(opOf t,'(Integer)) => + op = "::" and opOf t in '(Integer) => s := form = $One and 1 or form = $Zero and 0 => ['DOLLAR, s , t] FIXP form => ["@", form, t] form is ["-", =$One] => ['DOLLAR, -1, t] @@ -1148,17 +1148,17 @@ markInsertBodyParts u == u is ['SEQ,:l,['exit,n,x]] => ['SEQ,:[markInsertBodyParts y for y in l], ['exit,n,markInsertBodyParts x]] - u is [op,:l] and MEMQ(op,'(REPEAT COLLECT)) => markInsertRepeat u + u is [op,:l] and op in '(REPEAT COLLECT) => markInsertRepeat u u is ["%LET",["%Comma",:s],b] => ["%LET",["%Comma",:[markWrapPart x for x in s]],markInsertBodyParts b] --u is ["%LET",a,b] and constructor? opOf b => u u is ["%LET",a,b] and a is [op,:.] => ["%LET",[markWrapPart x for x in a],markInsertBodyParts b] - u is [op,a,b] and MEMQ(op,'(_add _with IN %LET)) => + u is [op,a,b] and op in '(_add _with IN %LET) => [op,markInsertBodyParts a,markInsertBodyParts b] - u is [op,a,b] and MEMQ(op,'(_: _:_: _pretend _@)) => + u is [op,a,b] and op in '(_: _:_: _pretend _@) => [op,markInsertBodyParts a,b] - u is [op,a,:x] and MEMQ(op,'(STEP return leave exit reduce)) => + u is [op,a,:x] and op in '(STEP return leave exit reduce) => [op,a,:[markInsertBodyParts y for y in x]] u is [op,:x] and markPartOp? op => [op,:[markWrapPart y for y in x]] u is [op,:.] and constructor? op => u @@ -1204,8 +1204,8 @@ markInsertIterator x == markKillExpr m == --used to kill all but PART information for compilation m is [op,:.] => - MEMQ(op,'(MI WI)) => markKillExpr CADDR m - MEMQ(op,'(AUTOHARD AUTOSUBSET AUTOREP)) => markKillExpr CADDDR m + op in '(MI WI) => markKillExpr CADDR m + op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillExpr CADDDR m m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillExpr x,m,e]] [markKillExpr x for x in m] m @@ -1214,8 +1214,8 @@ markKillButIfs m == --used to kill all but PART information for compilation m is [op,:.] => op = 'IF => m op = 'PART => markKillButIfs CADDR m - MEMQ(op,'(MI WI)) => markKillButIfs CADDR m - MEMQ(op,'(AUTOHARD AUTOSUBSET AUTOREP)) => markKillButIfs CADDDR m + op in '(MI WI) => markKillButIfs CADDR m + op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillButIfs CADDDR m m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillButIfs x,m,e]] [markKillButIfs x for x in m] m @@ -1223,8 +1223,8 @@ markKillButIfs m == --used to kill all but PART information for compilation markKillAll m == --used to prepare code for compilation m is [op,:.] => op = 'PART => markKillAll CADDR m - MEMQ(op,'(MI WI)) => markKillAll CADDR m - MEMQ(op,'(AUTOHARD AUTOSUBSET AUTOREP)) => markKillAll CADDDR m + op in '(MI WI) => markKillAll CADDR m + op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillAll CADDDR m m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillAll x,m,e]] [markKillAll x for x in m] m @@ -1252,7 +1252,7 @@ changeToEqualEqual lines == not UPPER_-CASE_-P (x . (n + 4)) => nil word := INTERN SUBSTRING(x, n + 4, m - n - 4) expandedWord := macroExpand(word,$e) - not (MEMQ(word, '(Record Union Mapping)) + not (word in '(Record Union Mapping) or getConstructorFormFromDB opOf expandedWord) => nil sayMessage '"Converting input line:" sayMessage ['"WAS: ", x] @@ -1386,14 +1386,14 @@ mkGetPaths(x,y) == mkPaths(x,y) == --x < y; find location s of x in y (initially s=nil) markPathsEqual(x,y) => [y] atom y => nil - x is [op, :u] and MEMQ(op,'(LIST VECTOR)) and y is ['construct,:v] + x is [op, :u] and op in '(LIST VECTOR) and y is ['construct,:v] and markPathsEqual(['construct,:u],y) => [y] (y is ["%LET",a,b] or y is ['IF,a,b,:.]) and GENSYMP a and markPathsEqual(x,b) => [y] y is ['call,:r] => -- markPathsEqual(x,y1) => [y] mkPaths(x,r) => [y] y is ['PART,.,y1] => mkPaths(x,y1) - y is [fn,.,y1] and MEMQ(fn,'(CATCH THROW)) => + y is [fn,.,y1] and fn in '(CATCH THROW) => -- markPathsEqual(x,y1) => [y] mkPaths(x,y1) => [y] y is [['elt,.,op],:r] and (u := mkPaths(x,[op,:r])) => u @@ -1480,7 +1480,7 @@ buildNewDefinition(op,theSig,formPredAlist) == boolBin x == x is [op,:argl] => - MEMQ(op,'(AND OR)) and argl is [a, b, :c] and c => boolBin [op, boolBin [op, a, b], :c] + op in '(AND OR) and argl is [a, b, :c] and c => boolBin [op, boolBin [op, a, b], :c] [boolBin y for y in x] x diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index 5da5e158..e24fcf07 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -278,7 +278,7 @@ AMFCR_,redefinedList(op,l) == "OR"/[AMFCR_,redefined(op,u) for u in l] AMFCR_,redefined(opname,u) == not(u is [op,:l]) => nil op = 'DEF => opname = CAAR l - MEMQ(op,'(PROGN SEQ)) => AMFCR_,redefinedList(opname,l) + op in '(PROGN SEQ) => AMFCR_,redefinedList(opname,l) op = 'COND => "OR"/[AMFCR_,redefinedList(opname,CDR u) for u in l] augModemapsFromCategory(domainName,domainView,functorForm,categoryForm,e) == diff --git a/src/interp/msg.boot b/src/interp/msg.boot index 040ba711..07e2e174 100644 --- a/src/interp/msg.boot +++ b/src/interp/msg.boot @@ -102,7 +102,7 @@ ncBug (erMsgKey, erArgL,:optAttr) == -- text -- the actual text msgCreate(tag,posWTag,key,argL,optPre,:optAttr) == - if PAIRP key then tag := 'old + if CONSP key then tag := 'old msg := [tag,posWTag,key,argL,optPre,NIL] if CAR optAttr then setMsgForcedAttrList(msg,car optAttr) diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index b13ef6af..475a8013 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -159,7 +159,7 @@ substituteSegmentedMsg(msg,args) == nargs := #args for x in segmentedMsgPreprocess msg repeat -- x is a list - PAIRP x => + CONSP x => l := cons(substituteSegmentedMsg(x,args),l) c := x.0 n := STRINGLENGTH x @@ -184,7 +184,7 @@ substituteSegmentedMsg(msg,args) == -- Note 'f processing must come first. if MEMQ(char 'f,q) then arg := - PAIRP arg => APPLY(first arg, rest arg) + CONSP arg => APPLY(first arg, rest arg) arg if MEMQ(char 'm,q) then arg := [['"%m",:arg]] if MEMQ(char 's,q) then arg := [['"%s",:arg]] @@ -206,7 +206,7 @@ substituteSegmentedMsg(msg,args) == --stifled after the first item in the list until the --end of the list. (using %n and %y) l := - PAIRP(arg) => + CONSP(arg) => MEMQ(char 'y,q) or (CAR arg = '"%y") or ((LENGTH arg) = 1) => APPEND(REVERSE arg, l) head := first arg @@ -225,7 +225,7 @@ substituteSegmentedMsg(msg,args) == addBlanks msg == -- adds proper blanks - null PAIRP msg => msg + atom msg => msg null msg => msg LENGTH msg = 1 => msg blanksOff := false @@ -259,7 +259,7 @@ noBlankBeforeP word== if CVECP word and SIZE word > 1 then word.0 = char '% and word.1 = char 'x => return true word.0 = char " " => return true - (PAIRP word) and member(CAR word,$msgdbListPrims) => true + (CONSP word) and member(CAR word,$msgdbListPrims) => true false $msgdbNoBlanksAfterGroup == ['" ", " ",'"%" ,"%", :$msgdbPrims, @@ -271,13 +271,13 @@ noBlankAfterP word== if CVECP word and (s := SIZE word) > 1 then word.0 = char '% and word.1 = char 'x => return true word.(s-1) = char " " => return true - (PAIRP word) and member(CAR word, $msgdbListPrims) => true + (CONSP word) and member(CAR word, $msgdbListPrims) => true false cleanUpSegmentedMsg msg == -- removes any junk like double blanks -- takes a reversed msg and puts it in the correct order - null PAIRP msg => msg + atom msg => msg blanks := ['" "," "] haveBlank := NIL prims := @@ -496,7 +496,7 @@ flowSegmentedMsg(msg, len, offset) == off1:= (offset <= 1 => '""; fillerSpaces(offset-1,'" ")) firstLine := true - PAIRP msg => + CONSP msg => lnl := offset if msg is [a,:.] and member(a,'(%b %d _ "%b" "%d" " ")) then nl := [off1] @@ -507,14 +507,14 @@ flowSegmentedMsg(msg, len, offset) == actualMarg := potentialMarg if lnl = 99999 then nl := ['%l,:nl] lnl := 99999 - PAIRP(f) and member(CAR(f),'("%m" %m '%ce "%ce" %rj "%rj")) => + CONSP(f) and member(CAR(f),'("%m" %m '%ce "%ce" %rj "%rj")) => actualMarg := potentialMarg nl := [f,'%l,:nl] lnl := 199999 member(f,'("%i" %i )) => potentialMarg := potentialMarg + 3 nl := [f,:nl] - PAIRP(f) and member(CAR(f),'("%t" %t)) => + CONSP(f) and member(CAR(f),'("%t" %t)) => potentialMarg := potentialMarg + CDR f nl := [f,:nl] sbl := sayBrightlyLength f @@ -571,11 +571,11 @@ throwKeyedMsgCannotCoerceWithValue(val,t1,t2) == --% Some Standard Message Printing Functions -bright x == ['"%b",:(PAIRP(x) and NULL CDR LASTNODE x => x; [x]),'"%d"] +bright x == ['"%b",:(CONSP(x) and NULL CDR LASTNODE x => x; [x]),'"%d"] --bright x == ['%b,:(ATOM x => [x]; x),'%d] mkMessage msg == - msg and (PAIRP msg) and member((first msg),'(%l "%l")) and + msg and (CONSP msg) and member((first msg),'(%l "%l")) and member((last msg),'(%l "%l")) => concat msg concat('%l,msg,'%l) @@ -919,7 +919,7 @@ sayDisplayStringWidth x == sayDisplayWidth x sayDisplayWidth x == - PAIRP x => + CONSP x => +/[fn y for y in x] where fn y == member(y,'(%b %d "%b" "%d")) or y=$quadSymbol => 1 k := blankIndicator y => k diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index 96240a71..f8b4cb4a 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -204,7 +204,7 @@ beenHere(e,n) == fun = 'CAR => RPLACA(loc,var) fun = 'CDR => - if PAIRP QCDR loc + if CONSP QCDR loc then RPLACD(loc,[var]) else RPLACD(loc,var) SAY '"whoops" diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 7fd6aa3c..f09552ea 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -124,7 +124,7 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) == for [.,a,b] in rest x for [.,=a,c] in rest compForm]] (x' := isQuasiquote x) => quasiquote encode(x',isQuasiquote compForm,false) - IDENTP op and (constructor? op or MEMQ(op,'(Union Mapping))) => + IDENTP op and (constructor? op or op in '(Union Mapping)) => [op,:[encode(y,z,false) for y in rest x for z in rest compForm]] -- enumeration constants are like field names, they do not need -- to be encoded. @@ -144,7 +144,7 @@ listOfBoundVars form == form = '$ => [] IDENTP form and (u:=get(form,'value,$e)) => u:=u.expr - MEMQ(KAR u,'(Union Record)) => listOfBoundVars u + KAR u in '(Union Record) => listOfBoundVars u [form] atom form => [] first form = 'QUOTE => [] @@ -363,7 +363,7 @@ consDomainForm(x,dc) == NRTdescendCodeTran(u,condList) == null u => nil u is ['LIST] => nil - u is [op,.,i,a] and MEMQ(op,'(setShellEntry SETELT QSETREFV)) => + u is [op,.,i,a] and op in '(setShellEntry SETELT QSETREFV) => null condList and a is ['CONS,fn,:.] => RPLACA(u,'LIST) RPLACD(u,nil) @@ -720,7 +720,7 @@ NRTsubstDelta(initSig) == u:= $NRTdeltaList.($NRTdeltaLength+5-t) first u = 'domain => second u error "bad $NRTdeltaList entry" - MEMQ(first t,'(Mapping Union Record _:)) => + first t in '(Mapping Union Record _:) => [first t,:[replaceSlotTypes(x) for x in rest t]] t @@ -763,7 +763,7 @@ NRTputInHead bod == bod is ['SPADCALL,:args,fn] => NRTputInTail rest bod --NOTE: args = COPY of rest bod -- The following test allows function-returning expressions - fn is [elt,dom,ind] and not (dom='$) and MEMQ(elt,'(getShellEntry ELT QREFELT CONST)) => + fn is [elt,dom,ind] and not (dom='$) and elt in '(getShellEntry ELT QREFELT CONST) => k:= NRTassocIndex dom => RPLACA(LASTNODE bod,[$elt,'_$,k]) nil NRTputInHead fn diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 0a33b680..9f548288 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -98,7 +98,7 @@ evalSlotDomain(u,dollar) == y is [v,:.] => VECP v => lazyDomainSet(y,dollar,u) --old style has [$,code,:lazyt] IDENTP v and constructor? v - or MEMQ(v,'(Record Union Mapping Enumeration)) => + or v in '(Record Union Mapping Enumeration) => lazyDomainSet(y,dollar,u) --new style has lazyt y y @@ -131,7 +131,7 @@ replaceGoGetSlot env == goGetDomain := goGetDomainSlotIndex = 0 => thisDomain thisDomain.goGetDomainSlotIndex - if PAIRP goGetDomain then + if CONSP goGetDomain then goGetDomain := lazyDomainSet(goGetDomain,thisDomain,goGetDomainSlotIndex) sig := [newExpandTypeSlot(bytevec.(index := QSADD1 index),thisDomain,thisDomain) @@ -228,7 +228,7 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == NE(success,'failed) and success => if $monitorNewWorld then sayLooking1('"<----",uu) where uu() == - PAIRP success => [first success,:devaluate rest success] + CONSP success => [first success,:devaluate rest success] success success subsumptionSig and (u:= basicLookup(op,subsumptionSig,domain,dollar)) => u @@ -463,10 +463,10 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) == lazyMatch(source,lazyt,dollar,domain) == lazyt is [op,:argl] and null atom source and op=CAR source and #(sargl := CDR source) = #argl => - MEMQ(op,'(Record Union)) and first argl is [":",:.] => + op in '(Record Union) and first argl is [":",:.] => and/[stag = atag and lazyMatchArg(s,a,dollar,domain) for [.,stag,s] in sargl for [.,atag,a] in argl] - MEMQ(op,'(Union Mapping _[_|_|_] QUOTE Enumeration)) => + op in '(Union Mapping _[_|_|_] QUOTE Enumeration) => and/[lazyMatchArg(s,a,dollar,domain) for s in sargl for a in argl] coSig := getDualSignatureFromDB op null coSig => error ["bad Constructor op", op] @@ -486,7 +486,7 @@ lazyMatch(source,lazyt,dollar,domain) == lazyMatchArgDollarCheck(s,d,dollarName,domainName) == #s ~= #d => nil scoSig := getDualSignatureFromDB opOf s or return nil - if MEMQ(opOf s, '(Union Mapping Record)) then + if opOf s in '(Union Mapping Record) then scoSig := [true for x in s] and/[fn for x in rest s for arg in rest d for xt in rest scoSig] where fn() == @@ -544,10 +544,10 @@ newExpandLocalType(lazyt,dollar,domain) == newExpandLocalTypeForm(lazyt,dollar,domain) --new style newExpandLocalTypeForm([functorName,:argl],dollar,domain) == - MEMQ(functorName, '(Record Union)) and first argl is [":",:.] => + functorName in '(Record Union) and first argl is [":",:.] => [functorName,:[['_:,tag,newExpandLocalTypeArgs(dom,dollar,domain,true)] for [.,tag,dom] in argl]] - MEMQ(functorName, '(Union Mapping _[_|_|_] Enumeration)) => + functorName in '(Union Mapping _[_|_|_] Enumeration) => [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]] functorName = "QUOTE" => [functorName,:argl] coSig := getDualSignatureFromDB functorName diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot index d49177a8..3943f6cf 100644 --- a/src/interp/nrungo.boot +++ b/src/interp/nrungo.boot @@ -116,11 +116,11 @@ goGet(:l) == lookupDomain := domainSlot = 0 => thisDomain thisDomain.domainSlot -- where we look for the operation - if PAIRP lookupDomain then lookupDomain := NRTevalDomain lookupDomain + if CONSP lookupDomain then lookupDomain := NRTevalDomain lookupDomain dollar := -- what matches $ in signatures explicitLookupDomainIfTrue => lookupDomain thisDomain - if PAIRP dollar then dollar := NRTevalDomain dollar + if CONSP dollar then dollar := NRTevalDomain dollar fn:= basicLookup(op,sig,lookupDomain,dollar) fn = nil => keyedSystemError("S2NR0001",[op,sig,lookupDomain.0]) val:= APPLY(first fn,[:arglist,rest fn]) @@ -131,9 +131,9 @@ NRTreplaceLocalTypes(t,dom) == atom t => not INTEGERP t => t t:= dom.t - if PAIRP t then t:= NRTevalDomain t + if CONSP t then t:= NRTevalDomain t t.0 - MEMQ(CAR t,'(Mapping Union Record _:)) => + CAR t in '(Mapping Union Record _:) => [CAR t,:[NRTreplaceLocalTypes(x,dom) for x in rest t]] t @@ -275,7 +275,7 @@ compareSig(sig,tableSig,dollar,domain) == lazyCompareSigEqual(s,tslot,dollar,domain) == tslot = '$ => s = "$" or s = devaluate dollar - INTEGERP tslot and PAIRP(lazyt:=domain.tslot) and PAIRP s => + INTEGERP tslot and CONSP(lazyt:=domain.tslot) and CONSP s => lazyt is [.,.,.,[.,item,.]] and item is [.,[functorName,:.]] and functorName = CAR s => compareSigEqual(s,(NRTevalDomain lazyt).0,dollar,domain) diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index 401cf9a4..0d62cbac 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -124,7 +124,7 @@ makeCompactDirect1(op,items) == orderBySubsumption items == acc := subacc := nil for x in items repeat - not MEMQ($op,'(Zero One)) and x is [.,.,.,'Subsumed] => subacc := [x,:subacc] + not $op in '(Zero One) and x is [.,.,.,'Subsumed] => subacc := [x,:subacc] acc := [x,:acc] y := z := nil for [a,b,:.] in subacc | b repeat @@ -276,12 +276,12 @@ augmentPredVector(dollar,value) == isHasDollarPred pred == pred is [op,:r] => - MEMQ(op,'(AND and OR or NOT not)) => or/[isHasDollarPred x for x in r] - MEMQ(op,'(HasCategory HasAttribute)) => CAR r = '$ + op in '(AND and OR or NOT not) => or/[isHasDollarPred x for x in r] + op in '(HasCategory HasAttribute) => CAR r = '$ false stripOutNonDollarPreds pred == - pred is [op,:r] and MEMQ(op,'(AND and OR or NOT not)) => + pred is [op,:r] and op in '(AND and OR or NOT not) => "append"/[stripOutNonDollarPreds x for x in r] not isHasDollarPred pred => [pred] nil @@ -302,7 +302,7 @@ removeAttributePredicates pl == transHasCode x == atom x => x op := QCAR x - MEMQ(op,'(HasCategory HasAttribute)) => x + op in '(HasCategory HasAttribute) => x op="has" => compHasFormat x [transHasCode y for y in x] @@ -424,7 +424,7 @@ listOfCategoryEntries l == firstItemList:= op = 'ATTRIBUTE and first u is [f,:.] and constructor? f => [first u] - MEMQ(op,'(ATTRIBUTE SIGNATURE)) => nil + op in '(ATTRIBUTE SIGNATURE) => nil op = 'IF and u is [pred,conseq,alternate] => listOfCategoryEntriesIf(pred,conseq,alternate) categoryFormatError() @@ -632,7 +632,7 @@ dcData con == sayBrightly '"Operation data from slot 1" PRINT_-FULL $infovec.1 vec := getCodeVector() - vec := (PAIRP vec => CDR vec; vec) + vec := (CONSP vec => CDR vec; vec) sayBrightly ['"Information vector has ",SIZE vec,'" entries"] dcData1 vec @@ -652,8 +652,8 @@ dcSize(:options) == con := KAR options options := rest options null con => dcSizeAll() - quiet := MEMQ('quiet,options) - full := MEMQ('full,options) + quiet := 'quiet in options + full := 'full in options name := abbreviation? con or con infovec := getInfovec name template := infovec.0 @@ -893,7 +893,7 @@ substSlotNumbers(form,template,domain) == expandType(lazyt,template,domform) == atom lazyt => expandTypeArgs(lazyt,template,domform) [functorName,:argl] := lazyt - MEMQ(functorName, '(Record Union)) and first argl is [":",:.] => + functorName in '(Record Union) and first argl is [":",:.] => [functorName,:[['_:,tag,expandTypeArgs(dom,template,domform)] for [.,tag,dom] in argl]] lazyt is ['local,x] => diff --git a/src/interp/pathname.boot b/src/interp/pathname.boot index a7449f65..0fcd0b64 100644 --- a/src/interp/pathname.boot +++ b/src/interp/pathname.boot @@ -49,7 +49,7 @@ pathname? p == pathname p == pathname? p => p - not PAIRP p => PATHNAME p + atom p => PATHNAME p if #p>2 then p:=[p.0,p.1] PATHNAME APPLY(FUNCTION MAKE_-FILENAME, p) diff --git a/src/interp/posit.boot b/src/interp/posit.boot index d1d80a31..b8fd4481 100644 --- a/src/interp/posit.boot +++ b/src/interp/posit.boot @@ -57,7 +57,7 @@ pfPosOrNopos pf == poNoPosition() poIsPos? pos == - PAIRP pos and PAIRP first pos and #first pos = 5 + CONSP pos and CONSP first pos and #first pos = 5 lnCreate(extBl, st, gNo, :optFileStuff) == lNo := @@ -141,9 +141,9 @@ pfAbSynOp?(form, op) == EQ(hd, op) or EQCAR(hd, op) pfLeaf? form == - MEMQ(pfAbSynOp form, + pfAbSynOp form in '(id idsy symbol string char float expression integer - Document error)) + Document error) pfLeaf(x,y,:z) == tokConstruct(x,y, IFCAR z or pfNoPosition()) pfLeafToken form == tokPart form diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index 704a2f48..b6df42c9 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -362,7 +362,7 @@ postJoin: %ParseTree -> %ParseForm postJoin ["Join",a,:l] == a:= postTran a l:= postTranList l - if l is [b] and b is [name,:.] and MEMQ(name,'(ATTRIBUTE SIGNATURE)) then l + if l is [b] and b is [name,:.] and name in '(ATTRIBUTE SIGNATURE) then l := [["CATEGORY",b]] al:= a is ["%Comma",:c] => c @@ -496,7 +496,7 @@ postSignature t == killColons: %ParseTree -> %ParseForm killColons x == atom x => x - x is [op,:.] and MEMQ(op, '(Record Union %Forall %Exist)) => x + x is [op,:.] and op in '(Record Union %Forall %Exist) => x x is [":",.,y] => killColons y [killColons first x,:killColons rest x] @@ -540,7 +540,7 @@ postWith t == t isnt ["with",a] => systemErrorHere ["postWidth",t] $insidePostCategoryIfTrue: local := true a:= postTran a - a is [op,:.] and MEMQ(op,'(SIGNATURE ATTRIBUTE IF)) => ["CATEGORY",a] + a is [op,:.] and op in '(SIGNATURE ATTRIBUTE IF) => ["CATEGORY",a] a is ["PROGN",:b] => ["CATEGORY",:b] a diff --git a/src/interp/profile.boot b/src/interp/profile.boot index 94ea6fa7..df0ea732 100644 --- a/src/interp/profile.boot +++ b/src/interp/profile.boot @@ -87,7 +87,7 @@ profileDisplayOp(op,alist1) == sayBrightly '" locals" for [x,:t] in MSORT LASSOC('locals,alist1) repeat sayBrightly concat('" ",x,": ",prefix2String t) - for [con,:alist2] in alist1 | not MEMQ(con,'(locals arguments)) repeat + for [con,:alist2] in alist1 | not (con in '(locals arguments)) repeat sayBrightly concat('" ",prefix2String con) for [op1,:sig] in MSORT alist2 repeat sayBrightly ['" ",:formatOpSignature(op1,sig)] diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot index eb3bc9b4..4b17f3c1 100644 --- a/src/interp/pspad1.boot +++ b/src/interp/pspad1.boot @@ -269,7 +269,7 @@ format(x,:options) == op = 'elt and UPPER_-CASE_-P (STRINGIMAGE opOf CAR argl).0 => formatDollar1(CAR argl,CADR argl) fn:= GETL(op,"PSPAD") => formatFn(fn,x,$m,$c) - if MEMQ(op,'(AND OR NOT)) then op:= DOWNCASE op + if op in '(AND OR NOT) then op:= DOWNCASE op n=1 and GETL(op,'Nud) and (lbp:= formatOpBindingPower(op,"Nud","left")) => formatPrefix(op,first argl,lbp,formatOpBindingPower(op,"Nud","right"),qualification) n=2 and (op = '_$ or getOp(op,'Led)) and (lbp:= formatOpBindingPower(op,"Led","left")) => @@ -283,7 +283,7 @@ format(x,:options) == getOp(op,kind) == kind = 'Led => - MEMQ(op,'(_div _exquo)) => nil + op in '(_div _exquo) => nil GETL(op,'Led) GETL(op,'Nud) @@ -301,7 +301,7 @@ formatMacroCheck name == u := or/[x for [x,:y] in $globalMacroStack | y = name] => u u := or/[x for [x,:y] in $localMacroStack | y = name] => u [op,:argl] := name - MEMQ(op,'(Record Union)) => + op in '(Record Union) => pp ['"Cannot find: ",name] name [op,:[formatMacroCheck x for x in argl]] @@ -363,10 +363,10 @@ formatElt(u) == formatForm (u) == [op,:argl] := u - if MEMQ(op, '(Record Union)) then + if op in '(Record Union) then $fieldNames := union(getFieldNames argl,$fieldNames) MEMQ(op,'((QUOTE T) true)) => format "true" - MEMQ(op,'(false nil)) => format op + op in '(false nil) => format op u='(Zero) => format 0 u='(One) => format 1 1=#argl => formatApplication u @@ -428,7 +428,7 @@ formatApplication2 x == leadOp := x is [['elt,.,y],:.] => y opOf x - MEMQ(leadOp,'(COLLECT LIST construct)) or + leadOp in '(COLLECT LIST construct) or pspadBindingPowerOf("left",x)<1000 => formatPren x format x @@ -542,7 +542,7 @@ pspadBindingPowerOf(key,x) == pspadOpBindingPower(op,LedOrNud,leftOrRight) == if op in '(SLASH OVER) then op := "/" - MEMQ(op,'(_:)) and LedOrNud = 'Led => + op in '(_:) and LedOrNud = 'Led => leftOrRight = 'left => 195 196 exception:= @@ -557,10 +557,10 @@ pspadOpBindingPower(op,LedOrNud,leftOrRight) == formatOpBindingPower(op,key,leftOrRight) == if op in '(SLASH OVER) then op := "/" op = '_$ => 1002 - MEMQ(op,'(_:)) and key = 'Led => + op in '(_:) and key = 'Led => leftOrRight = 'left => 195 196 - MEMQ(op,'(_~_= _>_=)) => 400 + op in '(_~_= _>_=) => 400 op = "not" and key = "Nud" => leftOrRight = 'left => 1000 1001 @@ -582,7 +582,7 @@ formatInfixOp(op,:options) == formatDEF def == formatDEF0(def,$DEFdepth + 1) formatDEF0(["DEF",form,tlist,sclist,body],$DEFdepth) == - if not MEMQ(KAR form,'(Exports Implementation)) then + if not (KAR form in '(Exports Implementation)) then $form := form is [":",a,:.] => a form @@ -727,7 +727,7 @@ formatImport ["import",a] == format "import from " and formatLocal1 a addFieldNames a == - a is [op,:r] and MEMQ(op,'(Record Union)) => + a is [op,:r] and op in '(Record Union) => $fieldNames := union(getFieldNames r,$fieldNames) a is ['List,:b] => addFieldNames b nil diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot index 1441da4f..0928d565 100644 --- a/src/interp/pspad2.boot +++ b/src/interp/pspad2.boot @@ -60,8 +60,8 @@ formatDeftran(u,SEQflag) == u is ['Join,:x] => formatDeftranJoin(u,SEQflag) u is ['CATEGORY,kind,:l,x] => formatDeftran(['with,['SEQ,:l,['exit,n,x]]],SEQflag) u is ['CAPSULE,:l,x] => formatDeftranCapsule(l,x,SEQflag) - u is [op,:.] and MEMQ(op,'(rep per)) => formatDeftranRepper(u,SEQflag) - u is [op,:.] and MEMQ(op,'(_: _:_: _pretend _@)) => + u is [op,:.] and op in '(rep per) => formatDeftranRepper(u,SEQflag) + u is [op,:.] and op in '(_: _:_: _pretend _@) => formatDeftranColon(u,SEQflag) u is ['PROGN,:l,x] => formatDeftran(['SEQ,:l,['exit,1,x]],SEQflag) u is ['SEQ,:l,[.,n,x]] => @@ -86,7 +86,7 @@ formatDeftran(u,SEQflag) == u is ['Union,:argl] => ['Union,:[x for a in argl | x := (STRINGP a => [":",INTERN a,'Branch]; formatDeftran(a,nil))]] - u is [op,:itl,body] and MEMQ(op,'(REPEAT COLLECT)) and + u is [op,:itl,body] and op in '(REPEAT COLLECT) and ([nitl,:nbody] := formatDeftranREPEAT(itl,body)) => formatDeftran([op,:nitl,nbody],SEQflag) u is [":",a,b] => [":",formatDeftran(a,nil),formatDeftran(markMacroTran(b),nil)] @@ -104,7 +104,7 @@ formatDeftranCapsule(l,x,SEQflag) == formatDeftran(['SEQ,:l,['exit,1,x]],SEQflag) formatDeftranRepper([op,a],SEQflag) == - a is [op1,b] and MEMQ(op1,'(rep per)) => + a is [op1,b] and op1 in '(rep per) => op = op1 => formatDeftran(a,SEQflag) formatDeftran(b,SEQflag) a is ["::",b,t] => @@ -120,7 +120,7 @@ formatDeftranRepper([op,a],SEQflag) == a is ['not,[op,a,b]] and (op1 := LASSOC(op,$pspadRelationAlist)) => formatDeftran([op1,a,b],SEQflag) a is ["return",n,r] => - MEMQ(opOf r,'(true false)) => a + opOf r in '(true false) => a ["return",n,[op,formatDeftran(r,SEQflag)]] a is ['error,:.] => a [op,formatDeftran(a,SEQflag)] @@ -129,7 +129,7 @@ formatDeftranColon([op,a,t],SEQflag) == --op is one of : :: pretend @ a := formatDeftran(a,SEQflag) t := formatDeftran(t,SEQflag) a is ["UNCOERCE",b] => b - a is [op1,b,t1] and t1 = t and MEMQ(op,'(_: _:_: _pretend _@)) => + a is [op1,b,t1] and t1 = t and op in '(_: _:_: _pretend _@) => op1 = "pretend" or op = "pretend" => ["pretend",b,t] null SEQflag and op1 = ":" or op = ":" => ["pretend",b,t] a @@ -184,7 +184,7 @@ formatDeftranIf(a,b,c) == a is [op,:r] and (al := '((_= . _~_=) (_< . _>_=) (_> . _<_=)); iop := LASSOC(op, al) or rassoc(op, al)) => [["=>",[iop, :r],c]] - a is [op,r] and MEMQ(op,'(NOT not NULL null)) => + a is [op,r] and op in '(NOT not NULL null) => [["=>", r, c]] [["=>", ['not, a], c]] post := @@ -214,7 +214,7 @@ formatCATEGORY cat == format ["with",formatDeftranCategory cat] formatSIGNATURE ['SIGNATURE,op,types,:r] == - MEMQ('constant,r) => format op and format ": " and (u := format first types) and + 'constant in r => format op and format ": " and (u := format first types) and formatSC() and formatComments(u,op,types) format op and format ": " and (u := format ['Mapping,:types]) and formatSC() and formatComments(u,op,types) @@ -422,7 +422,7 @@ formatIterator u == formatStepOne? step == step = 1 or step = '(One) => true - step is [op,n,.] and MEMQ(op,'(_:_: _@)) => n = 1 or n = '(One) + step is [op,n,.] and op in '(_:_: _@) => n = 1 or n = '(One) false formatBy ['by,seg,step] == format seg and format " by " and format step diff --git a/src/interp/ptrees.boot b/src/interp/ptrees.boot index e8ff9ee6..6aa764af 100644 --- a/src/interp/ptrees.boot +++ b/src/interp/ptrees.boot @@ -85,8 +85,7 @@ pfDocument? form == pfAbSynOp?(form, 'Document) pfDocumentText form == tokPart form pfLiteral? form == - MEMQ(pfAbSynOp form,'(integer symbol expression - one zero char string float)) + pfAbSynOp form in '(integer symbol expression one zero char string float) pfLiteralClass form == pfAbSynOp form pfLiteralString form == tokPart form diff --git a/src/interp/scan.boot b/src/interp/scan.boot index 184e8b40..e6beeb2a 100644 --- a/src/interp/scan.boot +++ b/src/interp/scan.boot @@ -512,7 +512,7 @@ scanS()== CONCAT(str,b) scanTransform x==x ---idChar? x== scanLetter x or DIGITP x or MEMQ(x,'(_? _%)) +--idChar? x== scanLetter x or DIGITP x or x in '(_? _%) --scanLetter x== -- if not CHARP x @@ -527,7 +527,7 @@ posend(line,n)== -- while n<#line and digit? line.n repeat n:=n+1 -- n ---startsId? x== scanLetter x or MEMQ(x,'(_? _%)) +--startsId? x== scanLetter x or x in '(_? _%) digit? x== DIGITP x scanW(b)== -- starts pointing to first char diff --git a/src/interp/setvars.boot b/src/interp/setvars.boot index 51c31f6b..a35a2f30 100644 --- a/src/interp/setvars.boot +++ b/src/interp/setvars.boot @@ -334,7 +334,7 @@ displaySetVariableSettings(setTree,label) == opt := functionp(setData.setVar) => FUNCALL( setData.setVar,"%display%") '"unimplemented" - if PAIRP opt then opt := [:[o,'" "] for o in opt] + if CONSP opt then opt := [:[o,'" "] for o in opt] sayBrightly concat(setOption,'%b,opt,'%d) st = 'STRING => opt := object2String eval setData.setVar @@ -523,7 +523,7 @@ setExposeAddGroup arg == sayAsManyPerLineAsPossible [object2String first x for x in $globalExposureGroupAlist] for x in arg repeat - if PAIRP x then x := QCAR x + if CONSP x then x := QCAR x x = 'all => $localExposureData.0 :=[first x for x in $globalExposureGroupAlist] $localExposureData.1 :=NIL @@ -551,7 +551,7 @@ setExposeAddConstr arg == displayExposedConstructors() for x in arg repeat x := unabbrev x - if PAIRP x then x := QCAR x + if CONSP x then x := QCAR x -- if the constructor is known, we know what type it is null getConstructorKindFromDB x => sayKeyedMsg("S2IZ0049J",[x]) @@ -587,7 +587,7 @@ setExposeDropGroup arg == sayMSG '" " displayExposedGroups() for x in arg repeat - if PAIRP x then x := QCAR x + if CONSP x then x := QCAR x x = 'all => $localExposureData.0 := NIL $localExposureData.1 := NIL @@ -618,7 +618,7 @@ setExposeDropConstr arg == displayHiddenConstructors() for x in arg repeat x := unabbrev x - if PAIRP x then x := QCAR x + if CONSP x then x := QCAR x -- if the constructor is known, we know what type it is null getConstructorKindFromDB x => sayKeyedMsg("S2IZ0049J",[x]) diff --git a/src/interp/setvart.boot b/src/interp/setvart.boot index 39a5e304..cfb4252e 100644 --- a/src/interp/setvart.boot +++ b/src/interp/setvart.boot @@ -1719,7 +1719,7 @@ $reportCoerceIfTrue := NIL --% printLoadMessages u == - MEMQ(u, '(%display% %describe%)) => + u in '(%display% %describe%) => ($printLoadMsgs => '"on"; '"off") $printLoadMsgs := u is ["on"] diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot index 06db93ac..887af990 100644 --- a/src/interp/showimp.boot +++ b/src/interp/showimp.boot @@ -193,7 +193,7 @@ showDomainsOp1(u,key) == u getDomainRefName(dom,nam) == - PAIRP nam => [getDomainRefName(dom,x) for x in nam] + CONSP nam => [getDomainRefName(dom,x) for x in nam] not FIXP nam => nam slot := dom.nam VECP slot => slot.0 diff --git a/src/interp/simpbool.boot b/src/interp/simpbool.boot index e487d986..b6f33fb3 100644 --- a/src/interp/simpbool.boot +++ b/src/interp/simpbool.boot @@ -87,9 +87,9 @@ b2dnf x == x = NIL => 'false atom x => bassert x [op,:argl] := x - MEMQ(op,'(AND and)) => band argl - MEMQ(op,'(OR or)) => bor argl - MEMQ(op,'(NOT not)) => bnot first argl + op in '(AND and) => band argl + op in '(OR or) => bor argl + op in '(NOT not) => bnot first argl bassert x band x == x is [h,:t] => andDnf(b2dnf h,band t) diff --git a/src/interp/slam.boot b/src/interp/slam.boot index 02556d43..a53f8e1b 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -220,7 +220,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == tripleCode cacheResetCode := ["SETQ",stateNam,initialValueCode] ["COND",[["NULL",["AND",["BOUNDP",MKQ stateNam], _ - ["PAIRP",stateNam]]], _ + ["CONSP",stateNam]]], _ ["%LET",stateVar,cacheResetCode]], _ [''T, ["%LET",stateVar,stateNam]]] diff --git a/src/interp/trace.boot b/src/interp/trace.boot index eb7941e9..b21b18ad 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -179,7 +179,7 @@ getMapSig(mapName,subName) == getTraceOption (x is [key,:l]) == key:= selectOptionLC(key,$traceOptionList,'traceOptionError) x := [key,:l] - MEMQ(key,'(nonquietly timer nt)) => x + key in '(nonquietly timer nt) => x key='break => null l => ['break,'before] opts := [selectOptionLC(y,'(before after),NIL) for y in l] @@ -192,7 +192,7 @@ getTraceOption (x is [key,:l]) == key='within => l is [a] and IDENTP a => x stackTraceOptionError ["S2IT0010",['")within"]] - MEMQ(key,'(cond before after)) => + key in '(cond before after) => key:= key="cond" => "when" key @@ -212,7 +212,7 @@ getTraceOption (x is [key,:l]) == stackTraceOptionError ["S2IT0013",[x]] g:= domainToGenvar x => g stackTraceOptionError ["S2IT0013",[x]] - MEMQ(key,'(local ops vars)) => + key in '(local ops vars) => null l or l is ["all"] => [key,:"all"] isListOfIdentifiersOrStrings l => x stackTraceOptionError ["S2IT0015",[STRCONC('")",object2String key)]] @@ -425,7 +425,7 @@ isTraceGensym x == GENSYMP x spadTrace(domain,options) == $fromSpadTrace:= true $tracedModemap:local:= nil - PAIRP domain and REFVECP CAR domain and (CAR domain).0 = 0 => + CONSP domain and REFVECP CAR domain and (CAR domain).0 = 0 => aldorTrace(domain,options) not isDomainOrPackage domain => userError '"bad argument to trace" listOfOperations:= diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot index 9b1f2411..4d0fadc7 100644 --- a/src/interp/wi1.boot +++ b/src/interp/wi1.boot @@ -202,7 +202,7 @@ markWhereTran ["where",["DEF",form,sig,clist,body],:tail] == a is ['LISTOF,:r] => for y in r repeat decls := [[":",y,b],:decls] decls := [x,:decls] - x is [key,fn,p,q,bd] and MEMQ(key,'(DEF MDEF)) and p='(NIL) and q='(NIL) => + x is [key,fn,p,q,bd] and key in '(DEF MDEF) and p='(NIL) and q='(NIL) => fn = target or fn is [=target] => ttype := bd fn = body or fn is [=body] => body := bd macros := [x,:macros] @@ -344,7 +344,7 @@ compAtom(x,m,e) == modeIsAggregateOf('Vector,m,e) is [.,R]=> compVector(x,['Vector,R],e) T => convert(T,m) --> - FIXP x and MEMQ(opOf m, '(Integer NonNegativeInteger PositiveInteger SmallInteger)) => markAt [x,m,e] + FIXP x and opOf m in '(Integer NonNegativeInteger PositiveInteger SmallInteger) => markAt [x,m,e] -- FIXP x and (T := [x, $Integer,e]) and (T' := convert(T,m)) => markAt(T, T') t:= isSymbol x => @@ -479,7 +479,7 @@ compWhere([.,form,:exprList],m,eInit) == -- form is ['DEF,a,osig,:.] and osig is [otarget,:.] => -- exprList is [['SEQ,:l,['exit,n,y]]] and (u := [:l,y]) and -- (ntarget := or/[def for x in u | x is [op,a',:.,def] and ([op,a',otarget]) and --- MEMQ(op,'(DEF MDEF)) and (a' = otarget or a' is [=otarget])]) => +-- op in '(DEF MDEF) and (a' = otarget or a' is [=otarget])]) => -- [ntarget,:rest osig] -- osig -- nil @@ -576,7 +576,7 @@ setqSingle(id,val,m,E) == 'locals profileRecord(key,id,T.mode) newProplist:= consProplistOf(id,currentProplist,"value",markKillAll removeEnv T) - e':= (PAIRP id => e'; addBinding(id,newProplist,e')) + e':= (CONSP id => e'; addBinding(id,newProplist,e')) x1 := markKillAll x if isDomainForm(x1,e') then if isDomainInScope(id,e') then @@ -651,7 +651,7 @@ setqMultipleExplicit(nameList,valList,m,e) == canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends atom expr => ValueFlag and level=exitCount (op:= first expr)="QUOTE" => ValueFlag and level=exitCount - MEMQ(op,'(WI MI)) => canReturn(CADDR expr,level,count,ValueFlag) + op in '(WI MI) => canReturn(CADDR expr,level,count,ValueFlag) op="TAGGEDexit" => expr is [.,count,data] => canReturn(data.expr,level,count,count=level) level=exitCount and not ValueFlag => nil @@ -901,7 +901,7 @@ compCoerce(u := ["::",x,m'],m,e) == T:= compCoerce1(x,m',e) => coerce(T,m) T := comp(x,$EmptyMode,e) or return nil T.mode = $SmallInteger and - MEMQ(opOf m,'(NonNegativeInteger PositiveInteger)) => + opOf m in '(NonNegativeInteger PositiveInteger) => compCoerce(["::",["::",x,$Integer],m'],m,e) --------------> new code <------------------- getmode(m',e) is ["Mapping",["UnionCategory",:l]] => diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index fa3f48bc..6e18448c 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -125,7 +125,7 @@ compDefineFunctor1(df, m,$e,$prefix,$formalArgList) == --The following loop sees if we can economise on ADDed operations --by using those of Rep, if that is the same. Example: DIRPROD if not $insideCategoryPackageIfTrue then - if body is ['add,ab:=[fn,:.],['CAPSULE,:cb]] and MEMQ(fn,'(List Vector)) + if body is ['add,ab:=[fn,:.],['CAPSULE,:cb]] and fn in '(List Vector) and FindRep(cb) = ab where FindRep cb == u:= @@ -459,7 +459,7 @@ unLet x == corrupted? u == u is [op,:r] => - MEMQ(op,'(WI MI PART)) => true + op in '(WI MI PART) => true or/[corrupted? x for x in r] false @@ -629,7 +629,7 @@ compApplyModemap(form,modemap,$e) == --+ store the signature instead. --$NRTflag=true and f is [op1,d,.] and NE(d,'$) and member(op1,'(ELT CONST)) => - f is [op1,d,.] and MEMQ(op1,'(ELT CONST Subsumed)) => + f is [op1,d,.] and op1 in '(ELT CONST Subsumed) => [genDeltaEntry [op,:modemap],lt',$bindings] markImport mc [f,lt',$bindings] @@ -638,8 +638,8 @@ compMapCond''(cexpr,dc) == cexpr=true => true --cexpr = "true" => true ---------------> new <---------------------- - cexpr is [op,:l] and MEMQ(op,'(_and AND)) => and/[compMapCond''(u,dc) for u in l] - cexpr is [op,:l] and MEMQ(op,'(_or OR)) => or/[compMapCond''(u,dc) for u in l] + cexpr is [op,:l] and op in '(_and AND) => and/[compMapCond''(u,dc) for u in l] + cexpr is [op,:l] and op in '(_or OR) => or/[compMapCond''(u,dc) for u in l] ---------------> new <---------------------- cexpr is ["not",u] => not compMapCond''(u,dc) cexpr is ["has",name,cat] => (knownInfo cexpr => true; false) diff --git a/src/interp/word.boot b/src/interp/word.boot index c13b55a0..b5fbaf71 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -152,7 +152,7 @@ doYouWant? nam == center80 ['"If so, type",:bright 'y,"or",:bright 'yes] center80 ['"Anything else means",:bright 'no] x := UPCASE queryUser nil - MEMQ(STRING2ID_-N(x,1),'(Y YES)) => nam + STRING2ID_-N(x,1) in '(Y YES) => nam nil pickANumber(word,list) == |