diff options
62 files changed, 502 insertions, 497 deletions
diff --git a/src/interp/astr.boot b/src/interp/astr.boot index 466185bb..abbac83c 100644 --- a/src/interp/astr.boot +++ b/src/interp/astr.boot @@ -45,18 +45,18 @@ module astr where -- Pick off the tag ncTag x == - atom x => ncBug('S2CB0031,[]) + x isnt [.,:.] => ncBug('S2CB0031,[]) x := first x ident? x => x - atom x => ncBug('S2CB0031,[]) + x isnt [.,:.] => ncBug('S2CB0031,[]) first x -- Pick off the property list ncAlist x == - atom x => ncBug('S2CB0031,[]) + x isnt [.,:.] => ncBug('S2CB0031,[]) x := first x ident? x => nil - atom x => ncBug('S2CB0031,[]) + x isnt [.,:.] => ncBug('S2CB0031,[]) rest x --- Get the entry for key k on x's association list diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index 29ad20c5..b11c18f4 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -44,7 +44,7 @@ namespace BOOT --conPage(a,:b) == -- --The next 4 lines allow e.g. MATRIX INT ==> Matrix Integer (see kPage) -- $conArgstrings: local := --- atom a => b +-- a isnt [.,:.] => b -- a := conform2OutputForm a -- [mathform2HtString x for x in rest a] -- if cons? a then a := first a @@ -60,7 +60,7 @@ namespace BOOT conPage(a,:b) == --The next 4 lines allow e.g. MATRIX INT ==> Matrix Integer (see kPage) form := - atom a => [a,:b] + a isnt [.,:.] => [a,:b] a $conArgstrings: local := [form2HtString x for x in KDR a] if cons? a then a := first a @@ -95,7 +95,7 @@ conPageConEntry entry == --======================================================================= conform2String u == x := form2String u - atom x => STRINGIMAGE x + x isnt [.,:.] => STRINGIMAGE x strconc/[STRINGIMAGE y for y in x] kxPage(htPage,name) == downlink name @@ -647,7 +647,7 @@ mkConform(kind,name,argString) == sayBrightlyNT '"Won't parse: " pp form systemError '"Keywords in argument list?" - atom parse => [parse] + parse isnt [.,:.] => [parse] parse [makeSymbol name,:rest ncParseFromString strconc('"d",argString)] --& case @@ -825,7 +825,8 @@ dbGetDocTable(op,$sig,docTable,$which,aux) == main where or/[gn x for x in tableValue(docTable,op)] gn u == --u is [origin,entry1,...,:code] $conform := first u --origin - if atom $conform then $conform := [$conform] + if $conform isnt [.,:.] then + $conform := [$conform] code := LASTATOM u --optional topic code comments := or/[p for entry in rest u | p := hn entry] or return nil [$conform,first comments,:code] @@ -854,7 +855,7 @@ dbAddChainDomain conform == dbSubConform(args,kFormatSlotDomain devaluate form) dbSubConform(args,u) == - atom u => + u isnt [.,:.] => (n := position(u,$FormalMapVariableList)) >= 0 => args . n u u is ['local,y] => dbSubConform(args,y) @@ -862,7 +863,7 @@ dbSubConform(args,u) == dbAddChain conform == u := dbAddChainDomain conform => - atom u => nil + u isnt [.,:.] => nil [[u,:true],:dbAddChain u] nil diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index bd04dcf7..29c3d534 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -119,7 +119,8 @@ buildLibdbConEntry conname == header := strconc($kind,symbolName conname) buildLibdbString [header,#argl,$exposed?,sigpart,argpart,abb,conComments] -dbMkForm x == atom x and [x] or x +dbMkForm x == + x isnt [.,:.] and [x] or x buildLibdbString [x,:u] == strconc(STRINGIMAGE x,strconc/[strconc('"`",STRINGIMAGE y) for y in u]) @@ -133,7 +134,7 @@ libConstructorSig [conname,:argl] == or/[CONTAINED(x,y) for y in u for j in 1.. | j ~= i] sig := fn applySubst(pairList($FormalMapVariableList,argl),sig) where fn x == - atom x => x + x isnt [.,:.] => x x is ['Join,a,:r] => ['Join,fn a,'etc] x is ['CATEGORY,:.] => 'etc [fn y for y in x] @@ -452,7 +453,7 @@ getArgumentConstructors con == --called by mkDependentsHashTable fn argtypes where fn(u) == "union"/[gn x for x in u] gn(x) == - atom x => nil + x isnt [.,:.] => nil x is ['Join,:r] => fn(r) x is ['CATEGORY,:.] => nil constructor? first x => [first x,:fn rest x] @@ -541,7 +542,7 @@ explodeIfs x == main where --called by getParents, getParentsForDomain [[a,:p]] folks u == --called by getParents and getParentsForDomain - atom u => nil + u isnt [.,:.] => nil 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 diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index dad326ca..39340f6a 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -136,7 +136,7 @@ dbShowOp1(htPage,opAlist,which,key) == key [what,whats,fn] := LASSOC(branch,$OpViewTable) data := dbGatherData(htPage,opAlist,which,branch) - dataCount := +/[1 for x in data | (what is '"Name" and $exposedOnlyIfTrue => atom x; true)] + dataCount := +/[1 for x in data | (what is '"Name" and $exposedOnlyIfTrue => x isnt [.,:.]; true)] namedPart := null rest opAlist => ops := escapeSpecialChars STRINGIMAGE CAAR opAlist @@ -235,7 +235,7 @@ conform2StringList(form,opFn,argFn,exception) == pred => string? x => [x] u := apply(argFn,[x]) - atom u and [u] or u + u isnt [.,:.] and [u] or u typ := sublisFormal(args,atype) if x is ['QUOTE,a] then x := a u := mathform2HtString algCoerceInteractive(x,typ,'(OutputForm)) => [u] @@ -371,14 +371,14 @@ dbGatherData(htPage,opAlist,which,key) == y --no, create new entry in DATA if key in '(origins conditions) then r := CDDR newEntry - if atom r then r := nil --clear out possible 'ASCONST + if r isnt [.,:.] then r := nil --clear out possible 'ASCONST newEntry.rest.rest := --store op/sigs under key if needed insert([dbMakeSignature(op,item),exposeFlag,:tail],r) if key in '(origins conditions) then for entry in data repeat --sort list of entries (after the 2nd) tail := CDDR entry tail := - atom tail => tail + tail isnt [.,:.] => tail listSort(function LEXLESSEQP,tail) entry.rest.rest := tail data := listSort(function LEXLESSEQP,data) @@ -417,7 +417,7 @@ dbGatherDataImplementation(htPage,opAlist) == alist := [[key,gn key,:entries],:alist] reverse! alist gn key == - atom key => true + key isnt [.,:.] => true isExposedConstructor first key dbSelectData(htPage,opAlist,key) == @@ -504,7 +504,7 @@ dbShowOpItems(which,data,exposedOnly?) == for i in 0.. for item in data repeat if firstTime then firstTime := false else htSaySaturn '"&" - if atom item then + if item isnt [.,:.] then op := item exposeFlag := true else @@ -549,7 +549,7 @@ dbShowOpAllDomains(htPage,opAlist,which) == simpOrDumb(new,old) == new is 'etc => 'etc - atom new => old + new isnt [.,:.] => old 'etc dbShowOpOrigins(htPage,opAlist,which,data) == @@ -907,19 +907,19 @@ mathform2HtString form == escapeString form is ['BRACKET,['AGGLST,:arg]] => if arg is ['construct,:r] then arg := r arg := - atom arg => [arg] + arg isnt [.,:.] => [arg] [y for x in arg | y := (x is ['QUOTE,a] => a; x)] tailPart := strconc/[strconc('",",STRINGIMAGE x) for x in rest arg] strconc('"[",STRINGIMAGE first arg,tailPart,'"]") form is ['BRACKET,['AGGLST,'QUOTE,arg]] => - if atom arg then arg := [arg] + if arg isnt [.,:.] then arg := [arg] tailPart := strconc/[strconc('",",x) for x in rest arg] strconc('"[",first arg,tailPart,'"]") - atom form => form + form isnt [.,:.] => form strconc/fortexp0 form niladicHack form == - atom form => form + form isnt [.,:.] => form form is [x] and GETL(x,"NILADIC") => x [niladicHack x for x in form] @@ -979,7 +979,7 @@ evalDomainOpPred(dom,pred) == process(dom,pred) where pred is 'T => true systemError nil convertCatArg p == - atom p or #p = 1 => MKQ p + p isnt [.,:.] or #p = 1 => MKQ p ['%list,MKQ first p,:[convertCatArg x for x in rest p]] evpred(dom,pred) == k := POSN1(pred,$predicateList) => testBitVector(dom.3,k + 1) diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index e29f362f..1e5ff436 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -203,7 +203,7 @@ getSubstSigIfPossible sig == fullSubstitute(x,y,z) == --substitutes deeply: x for y in list z z = y => x - atom z => z + z isnt [.,:.] => z [fullSubstitute(x,y,u) for u in z] getSubstCandidates sig == @@ -415,13 +415,13 @@ zeroOneConvert x == x kFormatSlotDomain x == fn formatSlotDomain x where fn x == - atom x => x + x isnt [.,:.] => x (op := first x) is '_$ => '_$ op is 'local => second x op is ":" => [":",second x,fn third x] ident? op and isConstructorName op => [fn y for y in x] integer? op => op - op is 'QUOTE and atom second x => second x + op is 'QUOTE and second x isnt [.,:.] => second x x koCatOps(conform,domname) == @@ -582,7 +582,7 @@ modemap2SigConds conds == hasPatternVar x == ident? x and (x ~= "**") => isPatternVar x - atom x => false + x isnt [.,:.] => false or/[hasPatternVar y for y in x] getDcForm(dc, condlist) == diff --git a/src/interp/br-prof.boot b/src/interp/br-prof.boot index c79b121e..5b8d9113 100644 --- a/src/interp/br-prof.boot +++ b/src/interp/br-prof.boot @@ -155,12 +155,12 @@ dbShowInfoList(dataItems,count,buttonForOp?) == htSay '"{" if count < 16384 or not buttonForOp? then htSay [ops,'": "] - atom sig => bcConform sig + sig isnt [.,:.] => bcConform sig bcConform dbInfoSig sig else htMakePage [['bcLinks,[ops,'"",'dbInfoChooseSingle,count]]] htSay '": " - if atom sig then htSay sig else + if sig isnt [.,:.] then htSay sig else bcConform dbInfoSig sig htSay '"}" count := count + 1 @@ -245,7 +245,7 @@ hasNewInfoAlist conname == (u := getInfoAlist conname) and hasNewInfoText u hasNewInfoText u == - and/[atom op and "and"/[item is [sig,:alist] and + and/[op isnt [.,:.] and "and"/[item is [sig,:alist] and null sig or cons? sig and cons? alist for item in items] for [op,:items] in u] getInfoAlist conname == diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index f0297eed..1719be7a 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -383,7 +383,7 @@ htMakePage1 itemList == itemType := 'text items := string? u => u - atom u => STRINGIMAGE u + u isnt [.,:.] => STRINGIMAGE u string? first u => u u is ['text, :s] => s itemType := first u @@ -425,7 +425,7 @@ saturnTran x == mkBold s == secondPart := - atom s => [s, '"}"] + s isnt [.,:.] => [s, '"}"] [:s, '"}"] ['"{\bf ", :secondPart] @@ -441,8 +441,8 @@ getCallBackFn form == strconc('"(|htDoneButton| '|", func, '"| ",htpName page(), '")") mkDocLink(code,s) == - if atom code then code := [code] - if atom s then s := [s] + if code isnt [.,:.] then code := [code] + if s isnt [.,:.] then s := [s] ['"\lispLink[d]{\verb!", :code, '"!}{", :s, '"}"] saturnTranText x == @@ -994,9 +994,9 @@ dbGatherThenShow(htPage,opAlist,which,data,constructorIfTrue,word,fn) == integer? thing => '"unexported" constructorIfTrue => htSay word - atom thing => '" an unknown constructor" + thing isnt [.,:.] => '" an unknown constructor" '"" - atom thing => '"unconditional" + thing isnt [.,:.] => '"unconditional" '"" htSay '"}" if cons? thing then @@ -1480,7 +1480,7 @@ htBlank(:options) == unTab s == string? s => unTab1 s - atom s => s + s isnt [.,:.] => s [unTab1 first s, :rest s] unTab1 s == @@ -1612,7 +1612,7 @@ bcConform1 form == main where bcPred pred hd form hd form == - atom form => + form isnt [.,:.] => -- string literals, e.g. "failed", are constructor arguments -- too, until we fix that. string? form or not (ident? form and isConstructorName form) => diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 3622b118..aa1d3cbe 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -68,7 +68,7 @@ grepConstruct1(s,key) == grepConstructDo(x, key) == $orCount := 0 ---atom x => grepFile(x, key,'i) +--x isnt [.,:.] => grepFile(x, key,'i) $localLibdb => oldLines := purgeNewConstructorLines(grepf(x,key,false),$newConstructorList) newLines := grepf(x,$localLibdb,false) @@ -104,7 +104,7 @@ grepForAbbrev(s,key) == match?(pattern,symbolName a) and not tableValue($defaultPackageNamesHT,x) applyGrep(x,filename) == - atom x => grepFile(x,filename,'i) + x isnt [.,:.] => grepFile(x,filename,'i) $localLibdb => a := purgeNewConstructorLines(grepf(x,filename,false),$newConstructorList) b := grepf(x,$localLibdb,false) @@ -250,7 +250,7 @@ mkUpDownPattern s == recurse(s,0,#s) where mkGrepPattern(s,key) == --called by grepConstruct1 and grepf - atom s => mkGrepPattern1(s,key) + s isnt [.,:.] => mkGrepPattern1(s,key) [first s,:[mkGrepPattern(x,key) for x in rest s]] mkGrepPattern1(x,:options) == --called by mkGrepPattern (and grepConstructName?) @@ -344,7 +344,7 @@ aPage(a,:b) == --called by \spadatt{a} arg := IFCAR b or a s := pmParseFromString STRINGIMAGE arg searchOn := - atom s => s + s isnt [.,:.] => s IFCAR s $attributeArgs : local := IFCAR IFCDR s aSearch searchOn @@ -355,7 +355,7 @@ spadType(x) == --called by \spadtype{x} from HyperDoc s := PNAME x form := ncParseFromString s or systemError ['"Argument: ",s,'" to spadType won't parse"] - if atom form then form := [form] + if form isnt [.,:.] then form := [form] op := opOf form looksLikeDomainForm form => apply(function conPage,form) conPage(op) @@ -364,7 +364,7 @@ looksLikeDomainForm x == entry := getCDTEntry(opOf x,true) or return false coSig := symbolLassoc('coSig,CDDR entry) k := #coSig - atom x => k = 1 + x isnt [.,:.] => k = 1 k ~= #x => false and/[p for key in rest coSig for arg in rest x] where p() == @@ -717,7 +717,7 @@ dbWordFrom(l,i) == conLowerCaseConTran x == ident? x => IFCAR tableValue($lowerCaseConTb, x) or x - atom x => x + x isnt [.,:.] => x [conLowerCaseConTran y for y in x] string2Constructor x == @@ -726,7 +726,7 @@ string2Constructor x == conLowerCaseConTranTryHarder x == ident? x => IFCAR tableValue($lowerCaseConTb,DOWNCASE x) or x - atom x => x + x isnt [.,:.] => x [conLowerCaseConTranTryHarder y for y in x] constructorSearchGrep(filter,key,kind) == diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index 98a290c1..2d0f2e8b 100644 --- a/src/interp/br-util.boot +++ b/src/interp/br-util.boot @@ -182,7 +182,7 @@ unMkEvalable u == lisp2HT u == ['"_'",:fn u] where fn u == ident? u => escapeSpecialIds symbolName u string? u => escapeString u - atom u => systemError() + u isnt [.,:.] => systemError() ['"_(",:"append"/[fn x for x in u],'")"] args2HtString(x,:options) == @@ -191,7 +191,7 @@ args2HtString(x,:options) == subString(form2HtString(['f,:x],emList),1) quickForm2HtString(x) == - atom x => STRINGIMAGE x + x isnt [.,:.] => STRINGIMAGE x form2HtString x form2HtString(x,:options) == @@ -199,7 +199,7 @@ form2HtString(x,:options) == $brief: local := IFCAR IFCDR options --see dbShowOperationsFromConform (lib11) fn(x) where fn x == - atom x => + x isnt [.,:.] => symbolMember?(x,$FormalMapVariableList) => strconc('"\",symbolName x) u := escapeSpecialChars STRINGIMAGE x @@ -223,17 +223,17 @@ form2HtString(x,:options) == strconc('",",fn first x,fnTailTail rest x) sexpr2HtString x == - atom x => form2HtString x + x isnt [.,:.] => form2HtString x strconc('"(",fn x,'")") where fn x == r := rest x suffix := null r => '"" - atom r => strconc('" . ",form2HtString rest x) + r isnt [.,:.] => strconc('" . ",form2HtString rest x) strconc('" ",fn r) strconc(sexpr2HtString first x,suffix) form2LispString(x) == - atom x => + x isnt [.,:.] => x = '_$ => '"__$" symbolMember?(x,$FormalMapVariableList) => strconc('"__", symbolName x) string? x => strconc('"_"",x,'"_"") @@ -246,12 +246,12 @@ form2LispString(x) == strconc(form2LispString first x,args2LispString rest x) sexpr2LispString x == - atom x => form2LispString x + x isnt [.,:.] => form2LispString x strconc('"(",fn x,'")") where fn x == r := rest x suffix := null r => '"" - atom r => strconc('" . ",form2LispString rest x) + r isnt [.,:.] => strconc('" . ",form2LispString rest x) strconc('" ",fn r) strconc(sexpr2HtString first x,suffix) @@ -418,7 +418,7 @@ bcConPredTable(u,conname,:options) == htSay '"{" bcStarSpace opOf conform form := - atom conform => getConstructorForm conform + conform isnt [.,:.] => getConstructorForm conform conform bcConform(form,italicList) if extractHasArgs pred is [arglist,:pred] then diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index 511ff5e9..514a6312 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -119,7 +119,7 @@ lazyCompareSigEqual(s,tslot,dollar,domain) == compareSigEqual(s,t,dollar,domain) == s = t => true - atom t => + t isnt [.,:.] => u := t is '$ => dollar isSharpVar t => @@ -132,7 +132,7 @@ compareSigEqual(s,t,dollar,domain) == u => compareSigEqual(s,u,dollar,domain) s = u s is '$ => compareSigEqual(dollar,t,dollar,domain) - atom s => nil + s isnt [.,:.] => nil #s ~= #t => nil match := true for u in s for v in t repeat @@ -223,7 +223,7 @@ goGet(:l) == val NRTreplaceLocalTypes(t,dom) == - atom t => + t isnt [.,:.] => not integer? t => t t := domainRef(dom,t) if cons? t then t := evalDomain t diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index cfcd96a9..e3842172 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -160,7 +160,7 @@ finalizeDocumentation() == for [op,sig] in signatures repeat s := formatOpSignature(op,sig) sayMSG - atom s => ['%x9,s] + s isnt [.,:.] => ['%x9,s] ['%x9,:s] if attributes then sayKeyedMsg("S2CD0005", @@ -169,7 +169,7 @@ finalizeDocumentation() == for x in attributes repeat a := form2String x sayMSG - atom a => ['%x9,a] + a isnt [.,:.] => ['%x9,a] ['%x9,:a] if unusedCommentLineNumbers then sayKeyedMsg("S2CD0006",[strconc(STRINGIMAGE bigcnt,'"."),name]) @@ -177,7 +177,7 @@ finalizeDocumentation() == sayMSG ['" ",:bright n,'" ",r] hn [[:fn(sig,$e),:doc] for [sig,:doc] in docList] where fn(x,e) == - atom x => [x,nil] + x isnt [.,:.] => [x,nil] if #x > 2 then x := TAKE(2,x) applySubst(pairList($lisplibForm.args,$FormalMapVariableList), macroExpand(x,e)) @@ -241,7 +241,7 @@ transDoc(conname,doclist) == -- checkDocError -- ['"_"Related Domain_" has wrong number of arguments: ",x] -- nil --- n=0 and atom x => [x] +-- n=0 and x isnt [.,:.] => [x] -- x longline := $x is 'constructor => @@ -280,7 +280,7 @@ transformAndRecheckComments(name,lines) == $origin : local := 'gloss $recheckingFlag : local := false $exposeFlagHeading : local := - atom name => ['" -- ",name] + name isnt [.,:.] => ['" -- ",name] concat('" --",formatOpSignature(name.0, escapePercent name.1)) if not $exposeFlag then sayBrightly $exposeFlagHeading u := checkComments(name,lines) @@ -382,7 +382,7 @@ checkRecordHash u == null parse => checkDocError ['"Unparseable \spadtype: ",s] not member(opOf parse,$currentSysList) => checkDocError ['"Bad system command: ",s] - atom parse or (parse isnt ['set,arg]) => 'ok ---assume ok + parse isnt [.,:.] or (parse isnt ['set,arg]) => 'ok ---assume ok not spadSysChoose($setOptions,arg) => checkDocError ['"Incorrect \spadsys: ",s] entry := tableValue($sysHash,htname) or [nil] @@ -393,10 +393,10 @@ checkRecordHash u == null parse => checkDocError ['"Unparseable \spadtype: ",s] n := checkNumOfArgs parse null n => checkDocError ['"Unknown \spadtype: ", s] - atom parse and n > 0 => 'skip + parse isnt [.,:.] and n > 0 => 'skip null (key := checkIsValidType parse) => checkDocError ['"Unknown \spadtype: ", s] - atom key => 'ok + key isnt [.,:.] => 'ok checkDocError ['"Wrong number of arguments: ",form2HtString key] else if x in '("\spadop" "\keyword") and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then x := intern checkGetStringBeforeRightBrace u @@ -428,7 +428,7 @@ checkNumOfArgs conform == ++ The check is down recursively on the argument to the instantiated functor. checkIsValidType form == main where main() == - atom form => 'ok + form isnt [.,:.] => 'ok [op,:args] := form conname := (constructor? op => op; abbreviation? op) null conname => nil diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index ffcbe321..af1888ec 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -275,7 +275,7 @@ devaluateList l == [devaluate d for d in l] devaluateDeeply x == vector? x => devaluate x - atom x => x + x isnt [.,:.] => x [devaluateDeeply y for y in x] --% Debugging Functions @@ -347,12 +347,12 @@ mkErrorExpr level == l is [a,b] => highlight(b,a) where highlight(b,a) == - atom b => + b isnt [.,:.] => substitute(var,b,a) where var:= makeSymbol strconc(STRINGIMAGE $bright,STRINGIMAGE b,STRINGIMAGE $dim) highlight1(b,a) where highlight1(b,a) == - atom a => a + a isnt [.,:.] => a a is [ =b,:c] => [$bright,b,$dim,:c] [highlight1(b,first a),:highlight1(b,rest a)] substitute(bracket rest l,second l,first l) @@ -549,7 +549,7 @@ unionLike?(m,e) == ++ If `x' designates a store with multiple views, e.g. Union, return ++ the collection of those modes. unionProperty(x,e) == - atom x => unionLike?(getmode(x,e),e) + x isnt [.,:.] => unionLike?(getmode(x,e),e) nil getInverseEnvironment(a,e) == @@ -652,7 +652,7 @@ isKnownCategory(c,e) == ++ Returns non-nil if `t' is a known type in the environement `e'. diagnoseUnknownType(t,e) == - atom t => + t isnt [.,:.] => t in '($ constant) => t t' := assoc(t,getDomainsInScope e) => t' (m := getmode(t,e)) and isKnownCategory(m,$CategoryFrame) => t @@ -719,7 +719,7 @@ isConstantId(name,e) == isFalse() == nil isFluid s == - atom s and char "$" = stringChar(PNAME s,0) + s isnt [.,:.] and char "$" = stringChar(PNAME s,0) isFunction(x,e) == get(x,"modemap",e) or GETL(x,"SPECIAL") or x="case" or getmode(x,e) is [ @@ -764,7 +764,7 @@ isSubset(x,y,e) == isDomainInScope(domain,e) == domainList:= getDomainsInScope e - atom domain => + domain isnt [.,:.] => symbolMember?(domain,domainList) => true not ident? domain or isSomeDomainVariable domain => true false @@ -790,7 +790,7 @@ isAlmostSimple x == transform:= fn x where fn x == - atom x or null rest x => x + x isnt [.,:.] or null rest x => x [op,y,:l]:= x op="has" => x op="is" => x @@ -813,12 +813,12 @@ incExitLevel u == decExitLevel u == (adjExitLevel(u,1,-1); removeExit0 u) where removeExit0 x == - atom x => x + x isnt [.,:.] => x x is ["exit",0,u] => removeExit0 u [removeExit0 first x,:removeExit0 rest x] adjExitLevel(x,seqnum,inc) == - atom x => x + x isnt [.,:.] => x 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] => @@ -845,7 +845,7 @@ removeEnv t == [t.expr,t.mode,$EmptyEnvironment] -- t is a triple -- [first l,:ordinsert(x,rest l)] makeNonAtomic x == - atom x => [x] + x isnt [.,:.] => [x] x flatten(l,key) == @@ -875,7 +875,7 @@ numOfOccurencesOf(x,y) == fn(x,y,n) == null y => 0 x=y => n+1 - atom y => n + y isnt [.,:.] => n fn(x,first y,n)+fn(x,rest y,n) compilerMessage(msg,args) == @@ -888,7 +888,7 @@ printDashedLine() == stackSemanticError(msg,expr) == BUMPERRORCOUNT "semantic" if $insideCapsuleFunctionIfTrue then msg:= [$op,": ",:msg] - if atom msg then msg:= [msg] + if msg isnt [.,:.] then msg:= [msg] entry:= [msg,expr] if not listMember?(entry,$semanticErrorStack) then $semanticErrorStack:= [entry,:$semanticErrorStack] @@ -929,7 +929,8 @@ stackAndThrow(msg, args == nil) == printString x == PRINC (string? x => x; PNAME x) -printAny x == if atom x then printString x else PRIN1 x +printAny x == + if x isnt [.,:.] then printString x else PRIN1 x printSignature(before,op,[target,:argSigList]) == printString before @@ -1018,12 +1019,12 @@ outerProduct l == "append"/[[[x,:y] for y in outerProduct rest l] for x in first l] sublisR(al,u) == - atom u => u + u isnt [.,:.] => u y:= rassoc(t:= [sublisR(al,x) for x in u],al) => y true => t substituteOp(op',op,x) == - atom x => x + x isnt [.,:.] => x [(op=(f:= first x) => op'; f),:[substituteOp(op',op,y) for y in rest x]] --substituteForFormalArguments(argl,expr) == @@ -1032,12 +1033,12 @@ substituteOp(op',op,x) == -- following is only intended for substituting in domains slots 1 and 4 -- signatures and categories sublisV(p,e) == - (atom p => e; suba(p,e)) where + (p isnt [.,:.] => e; suba(p,e)) where suba(p,e) == string? e => e -- no need to descend vectors unless they are categories categoryObject? e => LIST2VEC [suba(p,e.i) for i in 0..maxIndex e] - atom e => (y:= ASSQ(e,p) => rest y; e) + e isnt [.,:.] => (y:= ASSQ(e,p) => rest y; e) u:= suba(p,first e) v:= suba(p,rest e) sameObject?(first e,u) and sameObject?(rest e,v) => e @@ -1051,7 +1052,7 @@ old2NewModemaps x == x traceUp() == - atom $x => sayBrightly "$x is an atom" + $x isnt [.,:.] => sayBrightly "$x is an atom" for y in rest $x repeat u:= comp(y,$EmptyMode,$f) => sayBrightly [y,'" ==> mode",'"%b",u.mode,'"%d"] @@ -1163,7 +1164,7 @@ mutateBindingFormWithUnaryFunction(form,fun) == form isnt [op,inits,:body] and op in '(LET %bind) => form for defs in tails inits repeat def := first defs - atom def => nil -- no initializer + def isnt [.,:.] => nil -- no initializer def.rest.first := FUNCALL(fun, second def) for stmts in tails body repeat stmts.first := FUNCALL(fun, first stmts) @@ -1387,9 +1388,9 @@ proclaimCapsuleFunction(op,sig) == -- we optimize abstractions just as well as builtins. r := getRepresentation $e => normalize(r,top?) -- Cope with old-style constructor definition - atom $functorForm => [$functorForm] + $functorForm isnt [.,:.] => [$functorForm] normalize($functorForm,top?) - atom d => + d isnt [.,:.] => top? => "%Thing" getmode(d,$e) => "*" d @@ -1412,9 +1413,10 @@ MAKE_-CLOSEDFN_-NAME() == backendCompileNEWNAM: %Form -> %Void backendCompileNEWNAM x == atomic? x => nil - atom(y := first x) => + y := first x + y isnt [.,:.] => backendCompileNEWNAM rest x - if y = "CLOSEDFN" then + if y is "CLOSEDFN" then u := MAKE_-CLOSEDFN_-NAME() PUSH([u,second x], $CLOSEDFNS) x.first := "FUNCTION" @@ -1514,7 +1516,7 @@ backendFluidize x == stringChar(symbolName x,0) = char "$" and not digit? stringChar(symbolName x,1) => x atomic? x => nil - first x = "FLUID" => second x + first x is "FLUID" => second x a := backendFluidize first x b := backendFluidize rest x a = nil => b @@ -1663,7 +1665,7 @@ transformToBackendCode x == -- Make it explicitly a sequence of statements if it is not a one liner. body := body is [stmt] and - (atom stmt + (stmt isnt [.,:.] or stmt.op in '(SEQ LET LET_*) or not CONTAINED("EXIT",stmt)) => body @@ -1758,7 +1760,7 @@ expandFormTemplate(shell,args,slot) == slot = 0 => "$" slot = 2 => "$$" expandFormTemplate(shell,args,vectorRef(shell,slot)) - atom slot => slot + slot isnt [.,:.] => slot slot is ["local",parm] and (n := isFormal parm) => args.n -- FIXME: we should probably expand with dual signature slot is ["NRTEVAL",val] => val @@ -1780,7 +1782,7 @@ equalFormTemplate(shell,args,slot,form) == slot is ["QUOTE",val] => string? val or symbol? val or integer? val => val = form slot = form - atom slot or atom form => form = slot + slot isnt [.,:.] or form isnt [.,:.] => form = slot #slot ~= #form => false and/[equalFormTemplate(shell,args,i,x) for i in slot for x in form] @@ -1816,7 +1818,7 @@ getFunctionTemplate(sig,start,end,shell,args,funDesc) == ++ Subroutine of lookupDefiningFunction. lookupInheritedDefiningFunction(op,sig,shell,args,slot) == dom := expandFormTemplate(shell,args,slot) - atom dom or dom is ["local",:.] => nil + dom isnt [.,:.] or dom is ["local",:.] => nil lookupDefiningFunction(op,sig,dom) ++ Return the name of the function definition that explicitly implements diff --git a/src/interp/category.boot b/src/interp/category.boot index ab079f88..1a9073e2 100644 --- a/src/interp/category.boot +++ b/src/interp/category.boot @@ -55,7 +55,7 @@ categoryObject? a == ++ envronement `e'. isCategoryForm: (%Form,%Env) -> %Boolean isCategoryForm(x,e) == - atom x => + x isnt [.,:.] => u := macroExpand(x,e) cons? u and categoryForm? u categoryForm? x @@ -95,7 +95,7 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) == Prepare2 v == v is '$ => nil string? v => nil - atom v => [v] + v isnt [.,:.] => [v] v.op is 'Union => "union"/[Prepare2 x for x in stripUnionTags v.args] v.op is 'Mapping => "union"/[Prepare2 x for x in v.args] @@ -376,7 +376,7 @@ JoinInner(l,$e) == for u in l repeat for at in u.2 repeat at2:= first at - if atom at2 then at2:=[at2] + if at2 isnt [.,:.] then at2 := [at2] -- the variable $Attributes is built globally, so that true -- attributes can be detected without calling isCategoryForm symbolMember?(first at2,$Attributes) => nil diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index 231accef..a4c1cdd9 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -85,7 +85,7 @@ simpCategoryTable() == main where entry := tableValue(_*HASCATEGORY_-HASH_*,key) null entry => tableRemove!(_*HASCATEGORY_-HASH_*,key) change := - atom opOf entry => simpHasPred entry + opOf entry isnt [.,:.] => simpHasPred entry [[x,:npred] for [x,:pred] in entry | npred := simpHasPred pred] tableValue(_*HASCATEGORY_-HASH_*,key) := change @@ -157,7 +157,8 @@ simpHasAttribute(pred,conform,attr) == --eval w/o loading simpCatHasAttribute(domform,attr) == conform := getConstructorForm opOf domform catval := eval mkEvalable conform - if atom KDR attr then attr := IFCAR attr + if KDR attr isnt [.,:.] then + attr := IFCAR attr pred := u := LASSOC(attr,catval . 2) => first u return false --exit: not there @@ -421,7 +422,7 @@ compressHashTable ht == compressSexpr(x,left,right) == -- recursive version of compressHashTable - atom x => nil + x isnt [.,:.] => nil u:= tableValue($found,x) => left => left.first := u right => right.rest := u @@ -439,14 +440,14 @@ squeeze1(l) == -- recursive version of squeezeList x:= first l y:= - atom x => x + x isnt [.,:.] => x z:= member(x,$found) => first z $found:= [x,:$found] squeeze1 x l.first := y x:= rest l y:= - atom x => x + x isnt [.,:.] => x z:= member(x,$found) => first z $found:= [x,:$found] squeeze1 x diff --git a/src/interp/clammed.boot b/src/interp/clammed.boot index 479d8ba5..022c31f9 100644 --- a/src/interp/clammed.boot +++ b/src/interp/clammed.boot @@ -166,7 +166,7 @@ isLegitimateMode(t,hasPolyMode,polyVarList) == null t => true -- a terminating condition with underDomainOf t = $EmptyMode => true string? t => true - atom t => false + t isnt [.,:.] => false badDoubles := [$QuotientField,:'(Gaussian Complex Polynomial Expression)] t is [T1, [T2, :.]] and T1 = T2 and member(T1, badDoubles) => false @@ -212,7 +212,7 @@ isLegitimateMode(t,hasPolyMode,polyVarList) == underDomainOf t == t = $RationalNumber => $Integer - atom t => nil + t isnt [.,:.] => nil d := deconstructT t 1 = #d => nil u := getUnderModeOf(t) => u diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 8f228742..86a0f629 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -182,12 +182,12 @@ comp3(x,m,$e) == e:= $e --for debugging purposes m is ["Mapping",:.] => compWithMappingMode(x,m,e) m is ["QUOTE",a] => (x=a => [x,m,$e]; nil) - string? m => (atom x => (m=x or m=STRINGIMAGE x => [m,m,e]; nil); nil) + string? m => (x isnt [.,:.] => (m=x or m=STRINGIMAGE x => [m,m,e]; nil); nil) -- In quasiquote mode, x should match exactly (y := isQuasiquote m) => y = x => [["QUOTE",x], m, $e] nil - atom x => compAtom(x,m,e) + x isnt [.,:.] => compAtom(x,m,e) op:= x.op getmode(op,e) is ["Mapping",:ml] and (u:= applyMapping(x,m,e,ml)) => u op is ":" => compColon(x,m,e) @@ -257,7 +257,7 @@ applyMapping([op,:argl],m,e,ml) == -- if argl'="failed" then return nil -- mappingHasCategoryTarget => convert([form,first ml,e],m) -- form:= --- not symbolMember?(op,$formalArgList) and atom op => +-- not symbolMember?(op,$formalArgList) and op isnt [.,:.] => -- [op',:argl',"$"] where -- op':= makeSymbol strconc(STRINGIMAGE $prefix,";",STRINGIMAGE op) -- ['%call,["applyFun",op],:argl'] @@ -276,7 +276,7 @@ hasFormalMapVariable(x, vl) == freeVarUsage([.,vars,body],env) == freeList(body,vars,nil,env) where freeList(u,bound,free,e) == - atom u => + u isnt [.,:.] => not ident? u => free symbolMember?(u,bound) => free v := ASSQ(u,free) => @@ -305,7 +305,7 @@ freeVarUsage([.,vars,body],env) == for vv in v repeat free := freeList(vv,bound,free,e) free - if atom op then --Atomic functions aren't descended + if op isnt [.,:.] then --Atomic functions aren't descended u := rest u for v in u repeat free := freeList(v,bound,free,e) @@ -695,7 +695,7 @@ compApplication(op,argl,m,T) == for x in argl for m in argml] argTl = "failed" => nil form:= - atom T.expr and + T.expr isnt [.,:.] and not (symbolMember?(op,$formalArgList) or symbolMember?(T.expr,$formalArgList)) and null get(T.expr,"value",e) => emitLocalCallInsn(T.expr,[a.expr for a in argTl],e) @@ -1274,7 +1274,7 @@ compIf(["IF",a,b,c],m,E) == [x,mc,returnEnv] canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends - atom expr => ValueFlag and level=exitCount + expr isnt [.,:.] => ValueFlag and level=exitCount op := expr.op op in '(QUOTE CLOSEDFN) => ValueFlag and level=exitCount op is "TAGGEDexit" => @@ -1286,7 +1286,7 @@ canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends [.,gs,data]:= expr (findThrow(gs,data,level,exitCount,ValueFlag) => true) where findThrow(gs,expr,level,exitCount,ValueFlag) == - atom expr => nil + expr isnt [.,:.] => nil expr is ["THROW", =gs,data] => true --this is pessimistic, but I know of no more accurate idea expr is ["SEQ",:l] => @@ -1309,7 +1309,7 @@ canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends or/[canReturn(init,level,exitCount,false) for [.,init] in second expr] or canReturn(third expr,level,exitCount,ValueFlag) --now we have an ordinary form - atom op => and/[canReturn(u,level,exitCount,ValueFlag) for u in expr] + op isnt [.,:.] => and/[canReturn(u,level,exitCount,ValueFlag) for u in expr] systemErrorHere ['"canReturn",expr] --for the time being ++ We are compiling a conditional expression, type check and generate @@ -1403,7 +1403,7 @@ getBootType t == ++ Verify that mode `t' is admissible in an external entity signature ++ specification, and return its Boot denotation. checkExternalEntityType(t,e) == - atom t => + t isnt [.,:.] => stackAndThrow('"Type variable not allowed in import of external entity",nil) t' := getBootType t => t' stackAndThrow('"Type %1bp is invalid in a foreign signature",[t]) @@ -1559,7 +1559,7 @@ compColon([":",f,t],m,e) == --if inside an expression, ":" means to convert to m "on faith" $lhsOfColon: local:= f t:= - atom t and (t':= assoc(t,getDomainsInScope e)) => t' + t isnt [.,:.] and (t':= assoc(t,getDomainsInScope e)) => t' isDomainForm(t,e) and not $insideCategoryIfTrue => (if not listMember?(t,getDomainsInScope e) then e:= addDomain(t,e); t) isDomainForm(t,e) or isCategoryForm(t,e) => t @@ -1865,7 +1865,7 @@ resolve(din,dout) == modeEqual(x,y) == -- this is the late modeEqual -- orders Unions - atom x or atom y => x=y + x isnt [.,:.] or y isnt [.,:.] => x=y #x ~= #y => nil x is ['Union,:xl] and y is ['Union,:yl] => for x1 in xl repeat @@ -1880,7 +1880,7 @@ modeEqual(x,y) == modeEqualSubst(m1,m,e) == modeEqual(m1, m) => true - atom m1 => get(m1,"value",e) is [m',:.] and modeEqual(m',m) + m1 isnt [.,:.] => get(m1,"value",e) is [m',:.] and modeEqual(m',m) m1 is [op,:l1] and m is [=op,:l2] and # l1 = # l2 => -- Above length test inserted JHD 4:47 on 15/8/86 -- Otherwise Records can get fouled up - consider expressIdealElt @@ -2235,7 +2235,7 @@ processInlineRequest(t,e) == T := compOrCroak(t,$EmptyMode,e) not isCategoryForm(T.mode,e) => stackAndThrow('"%1b does not designate a domain",[t]) - atom T.expr => + T.expr isnt [.,:.] => stackWarning('"inline request for type variable %1bp is meaningless",[t]) nominateForInlining T.expr @@ -2294,7 +2294,7 @@ getIdentity(x,e) == numberize x == x=$Zero => 0 x=$One => 1 - atom x => x + x isnt [.,:.] => x [numberize first x,:numberize rest x] ++ If there is a local reference to mode `m', return it. @@ -2565,11 +2565,11 @@ compUnnamedMapping(parms,source,target,body,env) == gatherParameterList vars == main(vars,nil,nil) where main(vars,parms,source) == vars = nil => [reverse! parms,reverse! source] - atom vars or vars is [":",:.] => [[x] for x in check vars] + vars isnt [.,:.] or vars is [":",:.] => [[x] for x in check vars] [v,s] := check first vars main(rest vars,[v,:parms],[s,:source]) check var == - atom var => + var isnt [.,:.] => not ident? var => stackAndThrow('"invalid parameter %1b in lambda expression",[var]) [checkVariableName var,nil] diff --git a/src/interp/database.boot b/src/interp/database.boot index 635e1fea..be5479d8 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -380,7 +380,7 @@ isDomainSubst u == main where [nhead,:isDomainSubst rest u] u fn(x,alist) == - atom x => + x isnt [.,:.] => ident? x and symbolMember?(x,$PatternVariableList) and (s := findSub(x,alist)) => s x [first x,:[fn(y,alist) for y in rest x]] @@ -390,7 +390,7 @@ isDomainSubst u == main where findSub(x,rest alist) signatureTran pred == - atom pred => pred + pred isnt [.,:.] => pred pred is ["has",D,catForm] and isCategoryForm(catForm,$e) => ['ofCategory,D,catForm] [signatureTran p for p in pred] @@ -402,7 +402,7 @@ interactiveModemapForm mm == mm := replaceVars(COPY mm,$PatternVariableList,$FormalMapVariableList) [pattern:=[dc,:sig],pred] := mm pred := [fn x for x in pred] where fn x == - x is [a,b,c] and a isnt 'isFreeFunction and atom c => [a,b,[c]] + x is [a,b,c] and a isnt 'isFreeFunction and c isnt [.,:.] => [a,b,[c]] x --pp pred [mmpat, patternAlist, partial, patvars] := @@ -600,7 +600,7 @@ mkAlistOfExplicitCategoryOps target == [[atomizeOp op,:sig] for x in l | x is ['SIGNATURE,op,sig,:.]] where atomizeOp op == - atom op => op + op isnt [.,:.] => op op is [a] => a keyedSystemError("S2GE0016", ['"mkAlistOfExplicitCategoryOps",'"bad signature"]) @@ -613,7 +613,7 @@ mkAlistOfExplicitCategoryOps target == ['"mkAlistOfExplicitCategoryOps",'"bad signature"]) flattenSignatureList(x) == - atom x => nil + x isnt [.,:.] => nil x is ['SIGNATURE,:.] => [x] x is ['IF,cond,b1,b2] => append(flattenSignatureList b1, flattenSignatureList b2) @@ -647,7 +647,7 @@ updateDatabase(fname,cname,systemdir?) == REMOVER(lst,item) == --destructively removes item from lst - atom lst => + lst isnt [.,:.] => lst=item => nil lst first lst=item => rest lst diff --git a/src/interp/define.boot b/src/interp/define.boot index d452065c..11d928fc 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -137,7 +137,7 @@ makeDomainTemplate vec == item := vectorRef(vec,index) null item => nil vectorRef(newVec,index) := - atom item => item + item isnt [.,:.] => item cons? first item => makeGoGetSlot(item,index) item $byteVec := "append"/reverse! $byteVec @@ -255,7 +255,7 @@ NRTmakeCategoryAlist() == encodeCatform x == k := NRTassocIndex x => k - atom x or atom rest x => x + x isnt [.,:.] or rest x isnt [.,:.] => x [first x,:[encodeCatform y for y in rest x]] NRTcatCompare [catform,:pred] == LASSOC(first catform,$levelAlist) @@ -273,7 +273,7 @@ NRTgetLookupFunction(domform,exCategory,addForm) == domform := applySubst($pairlis,domform) addForm := applySubst($pairlis,addForm) $why: local := nil - atom addForm => 'lookupComplete + addForm isnt [.,:.] => 'lookupComplete extends := NRTextendsCategory1(domform,exCategory,getExportCategory addForm) if null extends then [u,msg,:v] := $why @@ -362,7 +362,7 @@ substSlotNumbers(form,template,domain) == expandType(form,template,domain) expandType(lazyt,template,domform) == - atom lazyt => expandTypeArgs(lazyt,template,domform) + lazyt isnt [.,:.] => expandTypeArgs(lazyt,template,domform) [functorName,:argl] := lazyt functorName is ":" => [functorName,first argl,expandTypeArgs(second argl,template,domform)] @@ -376,7 +376,7 @@ expandTypeArgs(u,template,domform) == integer? u => expandType(templateVal(template, domform, u), template,domform) u is ['NRTEVAL,y] => y --eval y u is ['QUOTE,y] => y - atom u => u + u isnt [.,:.] => u expandType(u,template,domform) templateVal(template,domform,index) == @@ -614,14 +614,14 @@ giveFormalParametersValues(argl,e) == macroExpandInPlace: (%Form,%Env) -> %Form macroExpandInPlace(x,e) == y:= macroExpand(x,e) - atom x or atom y => y + x isnt [.,:.] or y isnt [.,:.] => y x.first := first y x.rest := rest y x macroExpand: (%Form,%Env) -> %Form macroExpand(x,e) == --not worked out yet - atom x => + x isnt [.,:.] => not ident? x or (u := get(x,"macro",e)) = nil => x -- Don't expand a functional macro name by itself. u is ['%mlambda,:.] => x @@ -700,7 +700,7 @@ makeCategoryPredicates(form,u) == u is ["has",:.] => insert(applySubst(pairList($tvl,$mvl),u),pl) u is [op,:.] and op in '(SIGNATURE ATTRIBUTE) => pl - atom u => pl + u isnt [.,:.] => pl fnl(u,pl) fnl(u,pl) == for x in u repeat pl := fn(x,pl) @@ -717,7 +717,7 @@ mkCategoryPackage(form is [op,:argl],cat,def) == nameForDollar := first SETDIFFERENCE('(S A B C D E F G H I),argl) packageArgl := [nameForDollar,:argl] capsuleDefAlist := fn(def,nil) where fn(x,oplist) == - atom x => oplist + x isnt [.,:.] => oplist x is ['DEF,y,:.] => [y,:oplist] fn(x.args,fn(x.op,oplist)) catvec := eval mkEvalableCategoryForm form @@ -828,7 +828,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, mkConstructor: %Form -> %Form mkConstructor form == - atom form => ['devaluate,form] + form isnt [.,:.] => ['devaluate,form] null form.args => ['QUOTE,[form.op]] ['%list,MKQ form.op,:[mkConstructor x for x in form.args]] @@ -1199,7 +1199,7 @@ compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) == getmode(a,e) or userError concat( '"There is no mode for argument",a,'"of function",form.op) transformType x == - atom x => x + x isnt [.,:.] => x x is [":",R,Rtype] => ($sigAlist:= [[R,:transformType Rtype],:$sigAlist]; x) x is ['Record,:.] => x --RDJ 8/83 @@ -1602,7 +1602,7 @@ compileConstructor1 (form:=[fn,[key,vl,:bodyl]]) == constructMacro: %Form -> %Form constructMacro (form is [nam,[lam,vl,body]]) == - not (and/[atom x for x in vl]) => + not (and/[x isnt [.,:.] for x in vl]) => stackSemanticError(["illegal parameters for macro: ",vl],nil) ["XLAM",vl':= [x for x in vl | ident? x],body] @@ -1616,7 +1616,7 @@ modemap2Signature [[.,:sig],:.] == sig uncons: %Form -> %Form uncons x == - atom x => x + x isnt [.,:.] => x x is ["CONS",a,b] => [a,:uncons b] --% CAPSULE @@ -1758,7 +1758,7 @@ doIt(item,$predl) == item is ["%LET",lhs,rhs,:.] => compOrCroak(item,$EmptyMode,$e) isnt [code,.,$e] => stackSemanticError(["cannot compile assigned value to",:bright lhs],nil) - not (code is ["%LET",lhs',rhs',:.] and atom lhs') => + not (code is ["%LET",lhs',rhs',:.] and lhs' isnt [.,:.]) => code is ["PROGN",:.] => stackSemanticError(["multiple assignment ",item," not allowed"],nil) item.first := first code @@ -1865,7 +1865,7 @@ doItIf(item is [.,p,x,y],$predl,$e) == -- conditional compilation nils:=ans:=[] for u in flp1 repeat -- is =u form always an atom? - if atom u or (or/[v is [.,=u,:.] for v in $getDomainCode]) + if u isnt [.,:.] or (or/[v is [.,=u,:.] for v in $getDomainCode]) then nils:=[u,:nils] else @@ -1896,7 +1896,7 @@ compJoin(["Join",:argl],m,e) == parameters:= union("append"/[getParms(y,e) for y in rest x],parameters) where getParms(y,e) == - atom y => + y isnt [.,:.] => isDomainForm(y,e) => [y] nil y is [op,y'] and op in '(LENGTH %llength) => [y,y'] @@ -1905,7 +1905,7 @@ compJoin(["Join",:argl],m,e) == x is ["DomainSubstitutionMacro",pl,body] => (parameters:= union(pl,parameters); body) x is ["mkCategory",:.] => x - atom x and getmode(x,e)=$Category => x + x isnt [.,:.] and getmode(x,e) = $Category => x stackSemanticError(["invalid argument to Join: ",x],nil) x T:= [wrapDomainSub(parameters,["Join",:catList']),$Category,e] @@ -1949,7 +1949,7 @@ DomainSubstitutionFunction(parameters,body) == if parameters then (body := Subst(parameters,body)) where Subst(parameters,body) == - atom body => + body isnt [.,:.] => symbolMember?(body,parameters) => MKQ body body listMember?(body,parameters) => @@ -1966,7 +1966,7 @@ DomainSubstitutionFunction(parameters,body) == => ['QUOTE,simplifyVMForm body] [Subst(parameters,u) for u in body] body isnt ["Join",:.] => body - atom $definition => body + $definition isnt [.,:.] => body null $definition.args => body --should not bother if it will only be called once name := makeSymbol strconc(KAR $definition,";CAT") diff --git a/src/interp/diagnostics.boot b/src/interp/diagnostics.boot index a16cba91..c5075839 100644 --- a/src/interp/diagnostics.boot +++ b/src/interp/diagnostics.boot @@ -89,7 +89,7 @@ MESSAGEPRINT_-1 x == PRINC x MESSAGEPRINT_-2 x == - atom x => + x isnt [.,:.] => not null x => writeString '" . " MESSAGEPRINT_-1 x diff --git a/src/interp/format.boot b/src/interp/format.boot index 449e1322..cc3d5309 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -261,7 +261,7 @@ formatOpSymbol(op,sig) == op formatAttribute x == - atom x => [" ",x] + x isnt [.,:.] => [" ",x] x is [op,:argl] => for x in argl repeat argPart:= append!(argPart,concat('",",formatAttributeArg x)) @@ -270,7 +270,7 @@ formatAttribute x == formatAttributeArg x == x is '"*" => "_"*_"" - atom x => formatOpSymbol (x,nil) + x isnt [.,:.] => formatOpSymbol (x,nil) x is [":",op,["Mapping",:sig]] => concat('"%b",formatOpSymbol(op,sig),": ",'"%d",formatMapping sig) prefix2String0 x @@ -324,7 +324,7 @@ formatSignatureArgs0 sml == --% Conversions to string form expr2String x == - atom (u:= prefix2String0 x) => u + (u:= prefix2String0 x) isnt [.,:.] => u strconc/[atom2String y for y in u] -- exports (this is a badly named bit of sillyness) @@ -339,7 +339,7 @@ prefix2String0 form == form2StringLocal form -- SUBRP form => formWrapId BPINAME form --- atom form => +-- form isnt [.,:.] => -- form=$EmptyMode or form=$quadSymbol => formWrapId specialChar 'quad -- string? form => formWrapId form -- ident? form => @@ -361,7 +361,7 @@ form2StringWithPrens form == formString u == x := form2String u - atom x => STRINGIMAGE x + x isnt [.,:.] => STRINGIMAGE x strconc/[STRINGIMAGE y for y in x] form2String u == @@ -383,7 +383,7 @@ constructorName con == con form2String1 u == - atom u => + u isnt [.,:.] => u=$EmptyMode or u=$quadSymbol => formWrapId specialChar 'quad ident? u => constructor? u => app2StringWrap(formWrapId u, [u]) @@ -429,10 +429,10 @@ form2String1 u == op = 'AGGLST => tuple2String argl op = 'BRACKET => argl' := form2String1 first argl - ['"[",:(atom argl' => [argl']; argl'),'"]"] + ['"[",:(argl' isnt [.,:.] => [argl']; argl'),'"]"] op = 'PAREN => argl' := form2String1 first argl - ['"(",:(atom argl' => [argl']; argl'),'")"] + ['"(",:(argl' isnt [.,:.] => [argl']; argl'),'")"] op = "SIGNATURE" => [operation,sig] := argl concat(operation,'": ",formatSignature sig) @@ -550,7 +550,7 @@ tuple2String argl == if member(string, '("failed" "nil" "prime" "sqfr" "irred")) then string := strconc('"_"",string,'"_"") else string := - atom string => object2String string + string isnt [.,:.] => object2String string [f x for x in string] for x in rest argl repeat if member(x,'("failed" "nil" "prime" "sqfr" "irred")) then @@ -559,22 +559,22 @@ tuple2String argl == string where f x == - atom x => object2String x + x isnt [.,:.] => object2String x -- [f first x,:f rest x] [f y for y in x] script2String s == null s => '"" -- just to be safe - if atom s then s := [s] + if s isnt [.,:.] then s := [s] linearFormatForm(first s, rest s) linearFormatName x == - atom x => x + x isnt [.,:.] => x linearFormat x linearFormat x == - atom x => x - x is [op,:argl] and atom op => + x isnt [.,:.] => x + x is [op,:argl] and op isnt [.,:.] => argPart:= argl is [a,:l] => [a,:"append"/[['",",x] for x in l]] nil @@ -752,7 +752,7 @@ object2Identifier x == blankList x == "append"/[[BLANK,y] for y in x] pkey keyStuff == - if atom keyStuff then keyStuff := [keyStuff] + if keyStuff isnt [.,:.] then keyStuff := [keyStuff] allMsgs := ['" "] while not null keyStuff repeat dbN := nil @@ -799,16 +799,16 @@ form2FenceQuote x == integer? x => [STRINGIMAGE x] symbol? x => [FORMAT(nil, '"|~a|", x)] string? x => ['"_"",x,'"_""] - atom x => systemErrorHere ["form2FenceQuote",x] + x isnt [.,:.] => systemErrorHere ["form2FenceQuote",x] ['"(",:form2FenceQuote first x,:form2FenceQuoteTail rest x] form2FenceQuoteTail x == null x => ['")"] - atom x => ['" . ",:form2FenceQuote x,'")"] + x isnt [.,:.] => ['" . ",:form2FenceQuote x,'")"] ['" ",:form2FenceQuote first x,:form2FenceQuoteTail rest x] form2StringList u == - atom (r := form2String u) => [r] + (r := form2String u) => [r] isnt [.,:.] r --% Type Formatting Without Abbreviation @@ -825,7 +825,7 @@ formatUnabbreviatedSig sig == formatUnabbreviatedTuple t == -- t is a list of types null t => t - atom t => [t] + t isnt [.,:.] => [t] t0 := formatUnabbreviated t.op null rest t => t0 [:t0,'",",:formatUnabbreviatedTuple rest t] @@ -833,7 +833,7 @@ formatUnabbreviatedTuple t == formatUnabbreviated t == null t => ['"()"] - atom t => + t isnt [.,:.] => [t] t is [p,sel,arg] and p = ":" => [sel,'": ",:formatUnabbreviated arg] diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot index 2c40d76e..2ffe80a1 100644 --- a/src/interp/fortcall.boot +++ b/src/interp/fortcall.boot @@ -53,20 +53,20 @@ makeFort(name,args,decls,results,returnType,aspInfo) == dummies := [second(u) for u in args | first u = 0] args := [untangle2(u) for u in args] -- lose spad Union representation where untangle2 u == - atom (v := rest(u)) => v + (v := rest(u)) isnt [.,:.] => v first(v) userArgs := [u for u in args | not member(u,dummies)] -- Temporary decls := [untangle(u) for u in decls] -- lose spad Union representation where untangle u == - [if atom(rest(v)) then rest(v) else _ - [if atom(w) then w else rest(w) for w in rest(v)] for v in u] + [if rest(v) isnt [.,:.] then rest(v) else _ + [if w isnt [.,:.] then w else rest(w) for w in rest(v)] for v in u] makeFort1(name,args,userArgs,dummies,decls,results,returnType,aspInfo) makeFort1(name,args,userArgs,dummies,decls,results,returnType,aspInfo) == asps := [first(u) for u in aspInfo] -- Now reorder the arguments so that all the scalars come first, so -- that when we come to deal with arrays we know all the dimensions. - scalarArgs := [u for u in args | atom getFortranType(u,decls)] + scalarArgs := [u for u in args | getFortranType(u,decls) isnt [.,:.]] arrayArgs := [u for u in args | not member(u,scalarArgs)] orderedArgs := [:scalarArgs,:arrayArgs] file := if $fortranDirectory then @@ -170,7 +170,7 @@ getFortranType(u,decls) == -- find u in decls, return the given (Fortran) type. result := nil for d in decls repeat for dec in rest d repeat - atom(dec) and dec=u => + dec isnt [.,:.] and dec=u => return( result := first d ) LISTP(dec) and first(dec)=u => return( result := [first d,:rest dec] ) @@ -225,7 +225,7 @@ writeXDR(v,str,fp) == wl(['"));"],fp) prefix2Infix(l) == - atom(l) => [l] + l isnt [.,:.] => [l] #l=2 => [first l,"(",:prefix2Infix second l,")"] #l=3 => ["(",:prefix2Infix second l,first l,:prefix2Infix third l,")"] error '"Function in array dimensions with more than two arguments" @@ -283,14 +283,14 @@ spadTypeTTT u == mkQuote l == [addQuote(u)for u in l] where addQuote u == - atom u => ['QUOTE,u] + u isnt [.,:.] => ['QUOTE,u] ["construct",:[addQuote(v) for v in u]] makeLispList(l) == outputList := [] for u in l repeat outputList := [:outputList, _ - if atom(u) then ['QUOTE,u] else [["$elt","Lisp","construct"],_ + if u isnt [.,:.] then ['QUOTE,u] else [["$elt","Lisp","construct"],_ :makeLispList(u)]] outputList @@ -519,10 +519,10 @@ spadify(l,results,decls,names,actual) == if not scalarMember?(0,dims) then els := makeVector(reverse! els,nil) spadForms := [makeResultRecord(name,ty,els), :spadForms] -- Result is a Boolean Scalar - atom fort and ty="logical" => + fort isnt [.,:.] and ty="logical" => spadForms := [makeResultRecord(name,ty,int2Bool fort), :spadForms] -- Result is a Scalar - atom fort => + fort isnt [.,:.] => spadForms := [makeResultRecord(name,ty,fort),:spadForms] error ['"Unrecognised output format: ",fort] reverse! spadForms diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 106a1557..94619b9d 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -56,7 +56,7 @@ CategoryPrint(D,$e) == for j in 6..maxIndex D repeat u := categoryRef(D,j) null u => SAY "another domain" - atom first u => SAY("Alternate View corresponding to: ",u) + first u isnt [.,:.] => SAY("Alternate View corresponding to: ",u) PRETTYPRINT u --% Domain printing @@ -212,13 +212,13 @@ getPrincipalView domain == pview CategoriesFromGDC x == - atom x => nil + x isnt [.,:.] => nil x is ['%list,a,:b] and a is ['QUOTE,a'] => union([[a']],"union"/[CategoriesFromGDC u for u in b]) x is ['QUOTE,a] and a is [b] => [a] compCategories u == - atom u => u + u isnt [.,:.] => u cons? u.op => error ['"compCategories: need an atom in operator position", u.op] u.op in '(Record Union Mapping) => @@ -226,7 +226,7 @@ compCategories u == [u.op, :[compCategories1(a,$SetCategory) for a in u.args]] u is ['SubDomain,D,.] => compCategories D v := get(u.op,'modemap,$e) - atom v => + v isnt [.,:.] => error ['"compCategories: could not get proper modemap for operator",u.op] if rest v then sayBrightly ['"compCategories: ", '"%b", '"Warning", '"%d", @@ -242,7 +242,7 @@ compCategories u == compCategories1(u,v) == -- v is the mode of u - atom u => u + u isnt [.,:.] => u u is [":",x,t] => [u.op,x,compCategories1(t,v)] isCategoryForm(v,$e) => compCategories u [c,:.] := comp(macroExpand(u,$e),v,$e) => c @@ -280,7 +280,7 @@ optFunctorBody x == null rest l and null CDAR l => --there is no meat to this conditional form pred:= CAAR l - atom pred => nil + pred isnt [.,:.] => nil first pred="HasCategory" => nil ['%when,:l] ['%when,:l] @@ -288,12 +288,12 @@ optFunctorBody x == optFunctorBodyQuotable u == u = nil or integer? u or string? u => true - atom u => false + u isnt [.,:.] => false u is ['QUOTE,:.] => true false optFunctorBodyRequote u == - atom u => u + u isnt [.,:.] => u u is ['QUOTE,v] => v systemErrorHere ["optFunctorBodyRequote",u] @@ -343,7 +343,7 @@ setVector12 args == freeof($domainShell.4,args1) => nil [['SetDomainSlots124,'$,['QUOTE,args1],['%list,:args2]]] where freeof(a,b) == - atom a => null symbolMember?(a,b) + a isnt [.,:.] => null symbolMember?(a,b) freeof(first a,b) => freeof(rest a,b) false @@ -395,7 +395,7 @@ mkDomainFormer x == x mkTypeForm x == - atom x => mkDevaluate x + x isnt [.,:.] => mkDevaluate x x.op in '(CATEGORY mkCategory) => MKQ x x is [":",selector,dom] => ['%list,MKQ ":",MKQ selector,mkTypeForm dom] @@ -432,7 +432,7 @@ mkVectorWithDeferral(objects,tag) == for u in objects for count in 0..]] DescendCodeAdd(base,flag) == - atom base => DescendCodeVarAdd(base,flag) + base isnt [.,:.] => DescendCodeVarAdd(base,flag) not (modemap:=get(opOf base,'modemap,$CategoryFrame)) => if getmode(opOf base,$e) is ["Mapping",target,:formalArgModes] then formalArgs:= take(#formalArgModes,$FormalMapVariableList) @@ -474,7 +474,7 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) == (for u in code repeat if update(u,copyvec,[]) then code := remove(code,u)) where update(code,copyvec,sofar) == - atom code => nil + code isnt [.,:.] => nil code.op in '(%tref ELT) => copyvec.(third code):=union(copyvec.(third code), sofar) true @@ -591,7 +591,7 @@ ProcessCond cond == TryGDC cond == --sees if a condition can be optimised by the use of --information in $getDomainCode - atom cond => cond + cond isnt [.,:.] => cond cond is ['HasCategory,:l] => solved := nil for u in $getDomainCode while solved = nil repeat @@ -679,7 +679,7 @@ InvestigateConditions catvecListMaker == principal' := pessimise $principal where pessimise a == - atom a => a + a isnt [.,:.] => a a is ['SIGNATURE,:.] => a a is ['IF,cond,:.] => if not listMember?(cond,$Conditions) then @@ -703,7 +703,7 @@ InvestigateConditions catvecListMaker == Conds(code,previous) == --each call takes a list of conditions, and returns a list --of refinements of that list - atom code => [previous] + code isnt [.,:.] => [previous] code is ['DomainSubstitutionMacro,.,b] => Conds(b,previous) code is ['IF,a,b,c] => union(Conds(b,[a,:previous]),Conds(c,previous)) code is ['PROGN,:l] => "union"/[Conds(u,previous) for u in l] @@ -760,7 +760,7 @@ InvestigateConditions catvecListMaker == [true,:[LASSOC(ms,list) for ms in masterSecondaries]] ICformat u == - atom u => u + u isnt [.,:.] => u u is ["has",:.] => compHasFormat u u is ['AND,:l] or u is ['and,:l] => l:= removeDuplicates [ICformat v for [v,:l'] in tails l @@ -811,7 +811,7 @@ ICformat u == l partPessimise(a,trueconds) == - atom a => a + a isnt [.,:.] => a a is ['SIGNATURE,:.] => a a is ['IF,cond,:.] => (listMember?(cond,trueconds) => a; nil) [partPessimise(first a,trueconds),:partPessimise(rest a,trueconds)] diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot index ce9ff96b..5e0053d9 100644 --- a/src/interp/g-cndata.boot +++ b/src/interp/g-cndata.boot @@ -174,7 +174,7 @@ isNameOfType x == constructor? opOf unabbrev x unabbrev1(u,modeIfTrue) == - atom u => + u isnt [.,:.] => not ident? u => u -- surely not constructor abbrev modeIfTrue => d:= isDomainValuedVariable u => u @@ -254,7 +254,7 @@ isConstructorName op == nAssocQ(x,l,n) == repeat - if atom l then return nil + if l isnt [.,:.] then return nil if sameObject?(x,first(l).n) then return first l l:= rest l diff --git a/src/interp/g-error.boot b/src/interp/g-error.boot index 718752fd..3d7c58bf 100644 --- a/src/interp/g-error.boot +++ b/src/interp/g-error.boot @@ -97,7 +97,7 @@ errorSupervisor1(errorType,errorMsg,$BreakMode) == '"Error with unknown classification" msg := errorMsg is ['mathprint, :.] => errorMsg - atom errorMsg => ['" ", errorMsg] + errorMsg isnt [.,:.] => ['" ", 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 f571be7f..69c333e3 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -53,7 +53,7 @@ nominateForInlining dom == ++ return the template of the instantiating functor for ++ the domain form `dom'. getDomainTemplate dom == - atom dom => nil + dom isnt [.,:.] => nil getInfovec first dom ++ Emit code for an indirect call to domain-wide Spad function. @@ -160,14 +160,14 @@ optimizeFunctionDef(def) == x is ["THROW", =g,:u] => x.first := "RETURN" x.rest := replaceThrowByReturn(u,g) - atom x => nil + x isnt [.,:.] => nil replaceThrowByReturn(first x,g) replaceThrowByReturn(rest x,g) changeVariableDefinitionToStore(body',args) [name,[slamOrLam,args,groupVariableDefinitions body']] resetTo(x,y) == - atom y => x := y + y isnt [.,:.] => x := y sameObject?(x,y) => x x.first := y.first x.rest := y.rest @@ -179,7 +179,7 @@ simplifyVMForm x == x is '%icst1 => 1 atomic? x => x x.op is 'CLOSEDFN => x - atom x.op => + x.op isnt [.,:.] => x is [op,vars,body] and abstractionOperator? op => third(x) := simplifyVMForm body x @@ -199,18 +199,18 @@ subrname u == nil changeThrowToExit(s,g) == - atom s or s.op in '(QUOTE SEQ REPEAT COLLECT %collect %loop) => nil + s isnt [.,:.] or s.op in '(QUOTE SEQ REPEAT COLLECT %collect %loop) => nil s is ["THROW", =g,:u] => (s.first := "EXIT"; s.rest := u) changeThrowToExit(first s,g) changeThrowToExit(rest s,g) hasNoThrows(a,g) == a is ["THROW", =g,:.] => false - atom a => true + a isnt [.,:.] => true hasNoThrows(first a,g) and hasNoThrows(rest a,g) changeThrowToGo(s,g) == - atom s or first s is 'QUOTE => nil + s isnt [.,:.] or s.op is 'QUOTE => nil s is ["THROW", =g,u] => changeThrowToGo(u,g) s.first := "PROGN" @@ -236,7 +236,7 @@ removeNeedlessThrow x == optCatch (x is ["CATCH",g,a]) == $InteractiveMode => x - atom a => a + a isnt [.,:.] => a removeNeedlessThrow a if a is ["SEQ",:s,["THROW", =g,u]] then changeThrowToExit(s,g) @@ -259,11 +259,11 @@ optSPADCALL(form is ['SPADCALL,:argl]) == optCall (x is ['%call,:u]) == u is [['XLAM,vars,body],:args] => - atom vars => body + vars isnt [.,:.] => body #vars > #args => systemErrorHere ['optCall,x] resetTo(x,optXLAMCond applySubst(pairList(vars,args),body)) [fn,:a] := u - atom fn => + fn isnt [.,:.] => opt := fn has OPTIMIZE => resetTo(x,FUNCALL(opt,u)) resetTo(x,u) fn is ['applyFun,name] => @@ -332,7 +332,7 @@ EqualBarGensym(x,y) == true null x => y is [g] and GENSYMP g null y => x is [g] and GENSYMP g - atom x or atom y => false + x isnt [.,:.] or y isnt [.,:.] => false fn(first x,first y) and fn(rest x,rest y) --Called early, to change IF to conditional form @@ -348,7 +348,7 @@ optXLAMCond x == x is ['%when,u:= [p,c],:l] => p is '%otherwise => c ['%when,u,:optCONDtail l] - atom x => x + x isnt [.,:.] => x x.first := optXLAMCond first x x.rest := optXLAMCond rest x x @@ -459,7 +459,7 @@ isSimpleVMForm form == ++ on the program point where it is evaluated. isFloatableVMForm: %Code -> %Boolean isFloatableVMForm form == - atom form => form isnt "$" + form isnt [.,:.] => form isnt "$" form is ["QUOTE",:.] => true symbolMember?(form.op, $simpleVMoperators) and "and"/[isFloatableVMForm arg for arg in form.args] @@ -482,7 +482,7 @@ findVMFreeVars form == form isnt [op,:args] => nil op is "QUOTE" => nil vars := union/[findVMFreeVars arg for arg in args] - atom op => vars + op isnt [.,:.] => vars union(findVMFreeVars op,vars) ++ Return true is `var' is the left hand side of an assignment @@ -584,7 +584,7 @@ optLET u == -- Munge inits into list of dotted-pairs. Lovely Lisp. for defs in tails inits repeat def := first defs - atom def => systemErrorHere ["optLET",def] -- cannot happen + def isnt [.,:.] => systemErrorHere ["optLET",def] -- cannot happen def.rest := second def applySubst(inits,body) @@ -655,7 +655,7 @@ optCollectVector form == ++ Translate retraction of a value denoted by `e' to sub-domain `m' ++ defined by predicate `pred', optRetract ["%retract",e,m,pred] == - atom e => + e isnt [.,:.] => cond := simplifyVMForm substitute(e,"#1",pred) cond is '%true => e ["check-subtype",cond,MKQ m,e] diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 115aa242..f6584a37 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -54,7 +54,7 @@ $AbstractionOperator == ++ Return true if the symbol 's' is used in the form 'x'. usedSymbol?(s,x) == symbol? x => s = x - atom x => false + x isnt [.,:.] => false x is ['QUOTE,:.] => false x is [op,parms,:body] and abstractionOperator? op => symbolMember?(s,parms) => false @@ -145,7 +145,7 @@ noteSubDomainInfo(sub,super,pred) == ++ The transitive closure of the predicate form is returned, where ++ the predicate parameter is `#1'. isSubDomain(d1,d2) == - atom d1 or atom d2 => false + d1 isnt [.,:.] or d2 isnt [.,:.] => false -- 1. Easy, if by syntax constructs. d1 is ["SubDomain",=d2,pred] => pred @@ -284,7 +284,7 @@ addIntSymTabBinding(var,proplist,e is [[curContour,:.],:.]) == e putMacro(lhs,rhs,e) == - atom lhs => put(lhs,"macro",rhs,e) + lhs isnt [.,:.] => put(lhs,"macro",rhs,e) parms := [gensym() for p in lhs.args] put(lhs.op,"macro", ['%mlambda,parms,applySubst(pairList(lhs.args,parms),rhs)],e) @@ -302,7 +302,7 @@ isQuasiquote m == ++ returns the inferred domain for the syntactic object t. getTypeOfSyntax t == - atom t => + t isnt [.,:.] => ident? t => '(Identifier) (m := getBasicMode t) and not member(m,[$EmptyMode,$NoValueMode]) => ["Literal",m] @@ -510,9 +510,9 @@ concatList [x,:y] == concat1(x,y) == null x => y - atom x => (null y => x; atom y => [x,y]; [x,:y]) + x isnt [.,:.] => (null y => x; y isnt [.,:.] => [x,y]; [x,:y]) null y => x - atom y => [:x,y] + y isnt [.,:.] => [:x,y] [:x,:y] --% BOOT ravel and reshape @@ -528,16 +528,16 @@ boolODDP x == ODDP x --% Miscellaneous freeOfSharpVars x == - atom x => not isSharpVarWithNum x + x isnt [.,:.] => not isSharpVarWithNum x freeOfSharpVars first x and freeOfSharpVars rest x listOfSharpVars x == - atom x => (isSharpVarWithNum x => [x]; nil) + x isnt [.,:.] => (isSharpVarWithNum x => [x]; nil) union(listOfSharpVars first x,listOfSharpVars rest x) listOfPatternIds x == isPatternVar x => [x] - atom x => nil + x isnt [.,:.] => nil x is ['QUOTE,:.] => nil UNIONQ(listOfPatternIds first x,listOfPatternIds rest x) @@ -551,7 +551,7 @@ removeZeroOne x == -- 0 and 1 x = $Zero => 0 x = $One => 1 - atom x => x + x isnt [.,:.] => x [removeZeroOne first x,:removeZeroOne rest x] removeZeroOneDestructively t == @@ -559,15 +559,15 @@ removeZeroOneDestructively t == -- 0 and 1 destructively t = $Zero => 0 t = $One => 1 - atom t => t + t isnt [.,:.] => t RPLNODE(t,removeZeroOneDestructively first t, removeZeroOneDestructively rest t) flattenSexpr s == null s => s - atom s => s + s isnt [.,:.] => s [f,:r] := s - atom f => [f,:flattenSexpr r] + f isnt [.,:.] => [f,:flattenSexpr r] [:flattenSexpr f,:flattenSexpr r] isLowerCaseLetter c == @@ -649,9 +649,9 @@ spadThrowBrightly x == spadThrow() sublisNQ(al,e) == - atom al => e + al isnt [.,:.] => e fn(al,e) where fn(al,e) == - atom e => + e isnt [.,:.] => for x in al repeat sameObject?(first x,e) => return (e := rest x) e diff --git a/src/interp/ht-root.boot b/src/interp/ht-root.boot index 1976952c..831d36d4 100644 --- a/src/interp/ht-root.boot +++ b/src/interp/ht-root.boot @@ -83,7 +83,7 @@ htSystemVariables() == main where where functionTail(name,class,var,valuesOrFunction) == val := eval var - atom valuesOrFunction => + valuesOrFunction isnt [.,:.] => htMakePage '((domainConditions (isDomain STR (String)))) htMakePage [['bcLinks,['"reset",'"",'htSetSystemVariableKind,[var,name,nil]]]] htMakePage [['bcStrings,[30,STRINGIMAGE val,name,valuesOrFunction]]] @@ -100,7 +100,7 @@ htSystemVariables() == main where htSay('"{\em ",x,'"}\space{1}") htMakePage [['bcLispLinks,[x,'" ",'htSetSystemVariable,[variable,x]]]] fn(t,al,firstTime) == - atom t => al + t isnt [.,:.] => al if firstTime then $heading := opOf first t fn(rest t,gn(first t,al),firstTime) gn(t,al) == diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot index 846730c9..46e1fcf1 100644 --- a/src/interp/ht-util.boot +++ b/src/interp/ht-util.boot @@ -219,7 +219,7 @@ bcIssueHt line == iht line mapStringize l == - atom l => l + l isnt [.,:.] => l l.first := basicStringize first l l.rest := mapStringize rest l l diff --git a/src/interp/htcheck.boot b/src/interp/htcheck.boot index 046ae387..8a0669ef 100644 --- a/src/interp/htcheck.boot +++ b/src/interp/htcheck.boot @@ -126,5 +126,5 @@ spadSysBranch(tree,arg) == --tree is (msg kind TREEorSomethingElse ...) kind = 'TREE => spadSysChoose(tree.4,arg) kind = 'LITERALS => member(arg,tree.4) kind = 'INTEGER => integer? arg - kind = 'FUNCTION => atom arg + kind = 'FUNCTION => arg isnt [.,:.] systemError '"unknown tree branch" diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index 9f4ce9a7..28c5ea5a 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -225,7 +225,7 @@ bottomUp t == null tar => [om] (r := resolveTM(om,tar)) => [r] [om] - if atom op then + if op isnt [.,:.] then opName:= getUnname op if isLocallyBound opName then putModeSet(op,bottomUpIdentifier(op,opName)) @@ -586,7 +586,7 @@ printableArgModeSetList() == amsl := nil for a in reverse $origArgModeSetList repeat b := first a - if atom b then b := [b] + if b isnt [.,:.] then b := [b] amsl := ['"%l",b,:amsl] if amsl then amsl := rest amsl amsl @@ -787,7 +787,7 @@ bottomUpFormAnyUnionRetract(t,op,opName,argl,amsl) == ok := nil for m in amsl while not ok repeat - if atom first(m) then return nil + if first(m) isnt [.,:.] then return nil first m = $Any => ok := true (first first m = 'Union) => ok := true not ok => nil @@ -811,7 +811,7 @@ bottomUpFormUntaggedUnionRetract(t,op,opName,argl,amsl) == ok := nil for [m] in amsl while not ok repeat - if atom m then return nil + if m isnt [.,:.] then return nil if m is ['Union, :.] and null getUnionOrRecordTags m then ok := true not ok => nil diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index 74e9e0ac..cdb40620 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -212,7 +212,7 @@ retract2Specialization object == null isRectangularList(val',n,m) => nil coerceInt(object,['Matrix,D']) type is ['Expression,D] => - atom val' => nil -- certainly not a fraction + val' isnt [.,:.] => nil -- certainly not a fraction [num,:den] := val' ofCategory(type,$Field) => -- coerceRetract already handles case where den = 1 @@ -424,7 +424,7 @@ canCoerce1(t1,t2) == string? t2 => t1 is ['Variable,v] and (t2 = PNAME(v)) => true nil - atom t1 or atom t2 => nil + t1 isnt [.,:.] or t2 isnt [.,:.] => nil null isValidType(t2) => nil absolutelyCannotCoerce(t1,t2) => nil @@ -671,7 +671,7 @@ absolutelyCanCoerceByCheating(t1,t2) == -- difference is a subdomain isEqualOrSubDomain(t1,t2) => true typeIsASmallInteger(t1) and t2 = $Integer => true - atom(t1) or atom(t2) => false + t1 isnt [.,:.] or t2 isnt [.,:.] => false [tl1,:u1] := deconstructT t1 [tl2,:u2] := deconstructT t2 tl1 = '(Stream) and tl2 = '(InfiniteTuple) => @@ -684,7 +684,7 @@ absolutelyCanCoerceByCheating(t1,t2) == absolutelyCannotCoerce(t1,t2) == -- response of true means "definitely cannot coerce" -- this is largely an efficiency hack - atom(t1) or atom(t2) => nil + t1 isnt [.,:.] or t2 isnt [.,:.] => nil t2 = $None => true n1 := first t1 n2 := first t2 @@ -851,13 +851,13 @@ coerceInt1(triple,t2) == (string? t1) and (t1 = unwrap val) => t2 = $OutputForm => objNew(t1,$OutputForm) nil - atom t1 => nil + t1 isnt [.,:.] => nil if t1 = $AnonymousFunction and (t2 is ['Mapping,target,:margl]) then $useCoerceOrCroak := nil [.,vars,:body] := unwrap val vars := - atom vars => [vars] + vars isnt [.,:.] => [vars] vars is ["tuple",:.] => rest vars vars #margl ~= #vars => 'continue @@ -1234,14 +1234,14 @@ computeTTTranspositions(t1,t2) == reverse! towers decomposeTypeIntoTower t == - atom t => [t] + t isnt [.,:.] => [t] d := deconstructT t null rest d => [t] rd := reverse t [reverse rest rd,:decomposeTypeIntoTower first rd] reassembleTowerIntoType tower == - atom tower => tower + tower isnt [.,:.] => tower null rest tower => first tower [:top,t,s] := tower reassembleTowerIntoType [:top,[:t,s]] diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot index 93a7afd1..b2d46aee 100644 --- a/src/interp/i-coerfn.boot +++ b/src/interp/i-coerfn.boot @@ -1284,7 +1284,7 @@ Sm2PolyType(u,source is [sm,n,S], target is [pol,vl,T]) == -- first want to check case S is Polynomial S is ['Polynomial,S'] => -- check to see if variable occurs in any of the terms - if atom vl + if vl isnt [.,:.] then vl' := [vl] else vl' := vl novars := true diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index aae60c58..5626f35c 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -231,7 +231,7 @@ evalForm(op,opName,argl,mmS) == dc:= first sig form := dc='local => --[fun,:form] - atom fun => + fun isnt [.,:.] => isLocallyBound fun => ['SPADCALL,:form,fun] [fun,:form,nil] ['SPADCALL,:form,fun] @@ -270,7 +270,7 @@ sideEffectedArg?(t,sig,opName) == t = dc getArgValue(a, t) == - atom a and not vector? a => + a isnt [.,:.] and not vector? a => t' := coerceOrRetract(getBasicObject a,t) t' and getValueNormalForm t' v := getArgValue1(a, t) => v diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index d5cbcb91..16b58b74 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -225,7 +225,7 @@ selectMms2(op,tar,args1,args2,$Coerce) == while a repeat x:= first a a:= rest a - atom x => 'iterate + x isnt [.,:.] => 'iterate mmS := append(mmS, findFunctionInDomain(op,x,tar,args1,args2,nil,nil)) -- step 2. if we didn't get one, trying coercing (if we are @@ -236,7 +236,7 @@ selectMms2(op,tar,args1,args2,$Coerce) == while a repeat x:= first a a:= rest a - atom x => 'iterate + x isnt [.,:.] => 'iterate mmS := append(mmS, findFunctionInDomain(op,x,tar,args1,args2,$Coerce,nil)) @@ -271,7 +271,7 @@ defaultTarget(opNode,op,nargs,args) == target a1 := first args - atom a1 => target + a1 isnt [.,:.] => target a1f := first a1 nargs = 1 => @@ -525,7 +525,7 @@ argCouldBelongToSubdomain(op, nargs) == 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 + cond isnt [.,:.] => false cond.op in '(AND OR and or %and %or) => or/[CONTAINEDisDomain(symbol, u) for u in cond.args] cond.op is 'isDomain => @@ -650,7 +650,7 @@ orderMms(name, mmS,args1,args2,tar) == domainDepth(d) == -- computes the depth of lisp structure d - atom d => 0 + d isnt [.,:.] => 0 MAX(domainDepth(first d)+1,domainDepth(rest d)) hitListOfTarget(t) == @@ -907,7 +907,7 @@ matchMmCond(cond) == -- tests the condition, which comes with a modemap -- cond is 'T or a list, but I hate to test for 'T (ALBI) $domPvar: local := nil - atom cond or + cond isnt [.,:.] or cond.op in '(AND and %and) => and/[matchMmCond c for c in cond.args] cond.op in '(OR or %or) => @@ -1001,7 +1001,7 @@ filterModemapsFromPackages(mms, names, op) == isTowerWithSubdomain(towerType,elem) == - atom towerType => nil + towerType isnt [.,:.] => nil dt := deconstructT towerType 2 ~= #dt => nil s := underDomainOf(towerType) @@ -1035,7 +1035,7 @@ selectMmsGen(op,tar,args1,args2) == -- for common aggregates, use under domain also for a in removeDuplicates args repeat a => - atom a => nil + a isnt [.,:.] => nil fa := a.op fa in '(Record Union) => nil conNames := insert(STRINGIMAGE fa, conNames) @@ -1235,7 +1235,7 @@ replaceSharpCalls t == doReplaceSharpCalls t doReplaceSharpCalls t == - atom t => t + t isnt [.,:.] => t t is ['_#, l] => #l t is ['construct,: l] => eval ['LIST,:l] [first t,:[ doReplaceSharpCalls u for u in rest t]] @@ -1491,12 +1491,12 @@ hasCaty(d,cat,SL) == z' := [domArg2(a, S, S') for a in z] S1:= unifyStruct(y,z',copy SL) if S1 isnt 'failed then S1:= - atom cond => S1 + cond isnt [.,:.] => S1 ncond := subCopy(cond, S) ncond is ["has", =d, =cat] => 'failed hasCaty1(ncond,S1) S1 - atom x => SL + x isnt [.,:.] => SL ncond := subCopy(x, constructSubst d) ncond is ["has", =d, =cat] => 'failed hasCaty1(ncond, SL) @@ -1556,7 +1556,7 @@ hasSigAnd(andCls, S0, SL) == SA := 'failed for cls in andCls while not dead repeat SA := - atom cls => copy SL + cls isnt [.,:.] => copy SL cls is ["has",a,b] => hasCate(subCopy(a,S0),subCopy(b,S0),copy SL) keyedSystemError("S2GE0016", @@ -1569,7 +1569,7 @@ hasSigOr(orCls, S0, SL) == SA := 'failed for cls in orCls until found repeat SA := - atom cls => copy SL + cls isnt [.,:.] => copy SL cls is ["has",a,b] => hasCate(subCopy(a,S0),subCopy(b,S0),copy SL) cls is [op,:andCls] and op in '(AND and %and) => @@ -1588,7 +1588,7 @@ hasSig(dom,foo,sig,SL) == p := ASSQ(foo,getConstructorOperationsFromDB dom.op) => for [x,.,cond,.] in rest p until S isnt 'failed repeat S:= - atom cond => copy SL + cond isnt [.,:.] => copy SL cond is ["has",a,b] => hasCate(subCopy(a,S0),subCopy(b,S0),copy SL) cond is [op,:andCls] and op in '(AND and %and) => @@ -1641,7 +1641,7 @@ unifyStruct(s1,s2,SL) == s1=s2 => SL isPatternVar s1 => unifyStructVar(s1,s2,SL) isPatternVar s2 => unifyStructVar(s2,s1,SL) - atom s1 or atom s2 => 'failed + s1 isnt [.,:.] or s2 isnt [.,:.] => 'failed until null s1 or null s2 or SL is 'failed repeat SL:= unifyStruct(first s1,first s2,SL) s1:= rest s1 @@ -1714,18 +1714,18 @@ printMms(mmS) == containsVars(t) == -- tests whether term t contains a * variable - atom t => isPatternVar t + t isnt [.,:.] => isPatternVar t containsVars1(t) containsVars1(t) == -- recursive version, which works on a list [t1,:t2]:= t - atom t1 => + t1 isnt [.,:.] => isPatternVar t1 or - atom t2 => isPatternVar t2 + t2 isnt [.,:.] => isPatternVar t2 containsVars1(t2) containsVars1(t1) or - atom t2 => isPatternVar t2 + t2 isnt [.,:.] => isPatternVar t2 containsVars1(t2) isPartialMode m == @@ -1742,8 +1742,8 @@ getSymbolType var == isEqualOrSubDomain(d1,d2) == -- last 2 parts are for tagged unions (hack for now, RSS) (d1=d2) or isSubDomain(d1,d2) or - (atom(d1) and ((d2 is ['Variable,=d1]) or (d2 is [=d1]))) - or (atom(d2) and ((d1 is ['Variable,=d2]) or (d1 is [=d2]))) + (d1 isnt [.,:.] and ((d2 is ['Variable,=d1]) or (d2 is [=d1]))) + or (d2 isnt [.,:.] and ((d1 is ['Variable,=d2]) or (d1 is [=d2]))) defaultTypeForCategory(cat, SL) == -- this function returns a domain belonging to cat diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index fb9528e3..11199b26 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -72,7 +72,7 @@ mkAtreeExpandMacros x == -- handle macro expansion. if the macros have args we require that -- we match the correct number of args if x isnt ["MDEF",:.] and x isnt ["DEF",["macro",:.],:.] then - atom x and (m := isInterpMacro x) => + x isnt [.,:.] and (m := isInterpMacro x) => [args,:body] := m args => "doNothing" x := body @@ -98,7 +98,7 @@ mkAtree1 x == -- first special handler for making attrib tree null x => throwKeyedMsg("S2IP0005",['"NIL"]) vector? x => x - atom x => + x isnt [.,:.] => x in '(%noBranch %noMapVal) => x x in '(nil true false) => mkAtree2([x],x,nil) x = '_/throwAway => @@ -267,7 +267,7 @@ mkAtree3(x,op,argl) == v := mkAtreeNode $immediateDataSymbol putValue(v,getBasicObject op) v - atom op => + op isnt [.,:.] => t := mkAtreeNode op putAtree(t, 'flagArgsPos, flagArguments(op,#argl)) t @@ -361,7 +361,7 @@ mkAtreeValueOf l == mkAtreeValueOf1 l mkAtreeValueOf1 l == - null l or atom l or null rest l => l + null l or l isnt [.,:.] or null rest l => l l is ["valueOf",u] and ident? u => v := mkAtreeNode $immediateDataSymbol putValue(v,get(u,"value",$InteractiveFrame) or @@ -435,7 +435,7 @@ removeBindingI x == rempropI(x,prop) == id:= - atom x => x + x isnt [.,:.] => x first x getI(id,prop) => recordNewValue(id,prop,nil) diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index e8e9525f..8538c304 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -92,7 +92,7 @@ addDefMap(['DEF,lhs,mapsig,.,rhs],pred) == -- a niladic functions. We try to limit the damage as much as we can. defineeIsConstant := false - if atom lhs then + if lhs isnt [.,:.] then op := lhs putHist(op,'isInterpreterRule,true,$e) putHist(op,'isInterpreterFunction,false,$e) @@ -274,7 +274,7 @@ getIteratorIds itl == makeArgumentIntoNumber x == x=$Zero => 0 x=$One => 1 - atom x => x + x isnt [.,:.] => x x is ["-",n] and integer? n => -n [removeZeroOne first x,:removeZeroOne rest x] @@ -405,7 +405,7 @@ outputFormat(x,m) == categoryForm?(m) => x isMapExpr x => x containsVars x => x - atom(x) and first(m) = 'List => x + x isnt [.,:.] and first(m) = 'List => x (x is ['construct,:.]) and m = '(List (Expression)) => x T:= coerceInteractive(objNewWrap(x,maximalSuperType(m)), $OutputForm) or return x @@ -445,7 +445,7 @@ simplifyMapPattern (x,alias) == simplifyMapConstructorRefs form == -- try to linear format constructor names - atom form => form + form isnt [.,:.] => form [op,:args] := form op in '(exit SEQ) => [op,:[simplifyMapConstructorRefs a for a in args]] @@ -454,10 +454,10 @@ simplifyMapConstructorRefs form == op in '(_: _:_: _@) => args is [obj,dom] => dom' := prefix2String dom - --if atom dom' then dom' := [dom'] + --if dom' isnt [.,:.] then dom' := [dom'] --[op,obj,apply(function strconc,dom')] dom'' := - atom dom' => dom' + dom' isnt [.,:.] => dom' null rest dom' => first dom' apply(function strconc, dom') [op,obj, dom''] @@ -785,10 +785,10 @@ depthOfRecursion(opName,body) == mapRecurDepth(opName,opList,body) == -- walks over the map body counting depth of recursive calls -- expanding the bodies of maps called in body - atom body => 0 + body isnt [.,:.] => 0 body is [op,:argl] => argc:= - atom argl => 0 + argl isnt [.,:.] => 0 argl => "MAX"/[mapRecurDepth(opName,opList,x) for x in argl] 0 symbolMember?(op,opList) => argc @@ -895,7 +895,7 @@ nonRecursivePart(opName, funBody) == expandRecursiveBody(alreadyExpanded, body) == -- replaces calls to other maps with their bodies - atom body => + body isnt [.,:.] => (obj := get(body,'value,$e)) and objVal obj is ["%Map",:mapDef] and ((numMapArgs mapDef) = 0) => getMapBody(body,mapDef) body @@ -940,7 +940,7 @@ containsOp(body,op) == notCalled(opName,form) == -- returns true if opName is not called in the form - atom form => true + form isnt [.,:.] => true form is [op,:argl] => op=opName => false and/[notCalled(opName,x) for x in argl] @@ -1008,16 +1008,16 @@ findLocalVars(op,form) == findLocalVars1(op,form) == -- sets the two lists $localVars and $freeVars - atom form => + form isnt [.,:.] => not ident? form or isSharpVarWithNum form => nil isLocallyBound form or isFreeVar form => nil mkFreeVar($mapName,form) form is ['local, :vars] => for x in vars repeat - atom x => mkLocalVar(op, x) + x isnt [.,:.] => mkLocalVar(op, x) form is ['free, :vars] => for x in vars repeat - atom x => mkFreeVar(op, x) + x isnt [.,:.] => mkFreeVar(op, x) form is ["%LET",a,b] => (a is ["tuple",:vars]) and (b is ["tuple",:vals]) => for var in vars for val in vals repeat @@ -1025,7 +1025,7 @@ findLocalVars1(op,form) == a is ['construct,:pat] => for var in listOfVariables pat repeat mkLocalVar(op,var) findLocalVars1(op,b) - (atom a) or (a is ['_:,a,.]) => + a isnt [.,:.] or (a is ['_:,a,.]) => mkLocalVar(op,a) findLocalVars1(op,b) findLocalVars1(op,b) diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot index c2bf03ff..73496c23 100644 --- a/src/interp/i-object.boot +++ b/src/interp/i-object.boot @@ -113,7 +113,7 @@ removeQuote x == ++ argument to a (library) function call. getValueNormalForm obj == val := objVal obj - atom val => val + val isnt [.,:.] => val [op,:argl] := val op is "WRAPPED" => MKQ argl ident? op and isConstructorName op => @@ -125,7 +125,7 @@ getValueNormalForm obj == instantiationNormalForm(op,argl) == [op,:[normalVal for arg in argl]] where normalVal() == - atom arg => arg + arg isnt [.,:.] => arg [h,:t] := arg ident? h and isConstructorName h => instantiationNormalForm(h,t) MKQ arg @@ -232,14 +232,14 @@ emptyAtree expr == vectorRef(expr,2) := nil vectorRef(expr,3) := nil -- kill proplist too? - atom expr => nil + expr isnt [.,:.] => nil for e in expr repeat emptyAtree e ++ returns true if x is a leaf VAT object. isLeaf x == - atom x --may be a number or a vector + x isnt [.,:.] --may be a number or a vector ++ returns the mode of the VAT node x. ++ Also used by the algebra interface to the interpreter. @@ -260,7 +260,7 @@ putMode(x,y) == ++ Also used by the algebra interface to the interperter. getValue x == vector? x => vectorRef(x,2) - atom x => + x isnt [.,:.] => t := getBasicObject x => t keyedSystemError("S2II0001",[x]) getValue first x @@ -281,7 +281,7 @@ putValueValue(vec,val) == getUnnameIfCan x == vector? x => vectorRef(x,0) x is [op,:.] => getUnnameIfCan op - atom x => x + x isnt [.,:.] => x nil ++ Returns the node class of x; otherwise raise an error. @@ -454,7 +454,7 @@ srcPosDisplay(sp) == ++ represented by the VAT `t'. getFlagArgsPos t == vector? t => getAtree(t, 'flagArgsPos) - atom t => keyedSystemError("S2II0001",[t]) + t isnt [.,:.] => keyedSystemError("S2II0001",[t]) getFlagArgsPos first t --% Transfer of VAT properties. diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index 53949ca0..0f7eb681 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -412,7 +412,7 @@ stringWidth u == 2+#u obj2String o == - atom o => + o isnt [.,:.] => string? o => o o = " " => '" " o = ")" => '")" @@ -421,7 +421,7 @@ obj2String o == apply(function strconc,[obj2String o' for o' in o]) APP(u,x,y,d) == - atom u => appChar(atom2String u,x,y,d) + u isnt [.,:.] => appChar(atom2String u,x,y,d) u is [[op,:.],a] and (s:= GETL(op,'PREFIXOP)) => GETL(op,'isSuffix) => appChar(s,x+WIDTH a,y,APP(a,x,y,d)) APP(a,x+#s,y,appChar(s,x,y,d)) @@ -502,7 +502,7 @@ outputTran x == integer? x => x < 0 => ["-",MINUS x] x - atom x => + x isnt [.,:.] => x=$EmptyMode => specialChar 'quad x x is [c,var,mode] and c in '(_pretend _: _:_: _@) => @@ -626,7 +626,7 @@ checkArgs(op,tail) == head := [] while tail repeat term := first tail - atom term => + term isnt [.,:.] => head := [term,:head] tail := rest tail not LISTP term => -- never happens? @@ -725,7 +725,7 @@ outputConstructTran x == b is ['construct,:l] => ['construct,aPart,:l] ['BRACKET,['AGGLST,aPart,[":",b]]] [op,a,b] - atom x => x + x isnt [.,:.] => x [outputTran first x,:outputConstructTran rest x] outputTranMatrix x == @@ -780,7 +780,7 @@ timesApp(u,x,y,d) == d:= APP(BLANK,x,y,d) x:= x+1 [d,x]:= appInfixArg(arg,x,y,d,rightPrec,"left",nil) --app in a right arg - wasSimple:= atom arg and not integer? arg or isRationalNumber arg + wasSimple:= arg isnt [.,:.] and not integer? arg or isRationalNumber arg wasQuotient:= isQuotient op wasNumber:= integer? arg lastOp := op @@ -859,7 +859,7 @@ exptApp([.,a,b],x,y,d) == APP(b,x',y',d) exptNeedsPren a == - atom a and null (integer? a and a < 0) => false + a isnt [.,:.] and null (integer? a and a < 0) => false key:= keyp a key = "OVER" => true -- added JHD 2/Aug/90 (key="SUB") or (null GETL(key,"Nud") and null GETL(key,"Led")) => false @@ -874,8 +874,8 @@ exptWidth [.,a,b] == WIDTH a+WIDTH b+(exptNeedsPren a => 2;0) needStar(wasSimple,wasQuotient,wasNumber,cur,op) == wasQuotient or isQuotient op => true wasSimple => - atom cur or keyp cur="SUB" or isRationalNumber cur or op="**" or op = "^" or - (atom op and not integer? op and null GETL(op,"APP")) + cur isnt [.,:.] or keyp cur="SUB" or isRationalNumber cur or op="**" or op = "^" or + (op isnt [.,:.] and not integer? op and null GETL(op,"APP")) wasNumber => integer?(cur) or isRationalNumber cur or ((op="**" or op ="^") and integer?(second cur)) @@ -893,7 +893,7 @@ timesWidth u == w:= w+1 if infixArgNeedsParens(arg, rightPrec, "left") then w:= w+2 w:= w+WIDTH arg - wasSimple:= atom arg and not integer? arg --or isRationalNumber arg + wasSimple:= arg isnt [.,:.] and not integer? arg --or isRationalNumber arg wasQuotient:= isQuotient op wasNumber:= integer? arg firstTime:= nil @@ -1043,7 +1043,7 @@ outformWidth u == --WIDTH as called from OUTFORM to do a COPY stringChar(u,0) = char "%" and (stringChar(u,1) = char "b" or stringChar(u,1) = char "d") => 1 #u - atom u => # atom2String u + u isnt [.,:.] => # atom2String u WIDTH COPY u WIDTH u == @@ -1065,12 +1065,12 @@ WIDTH u == -- roughly log2(10). This should return an over-estimate, but for objects -- this big does it matter? FLOOR(INTEGER_-LENGTH(u)/3.3) - atom u => # atom2String u + u isnt [.,:.] => # atom2String u putWidth u is [[.,:n],:.] => n THROW('outputFailure,'outputFailure) putWidth u == - atom u or u is [[.,:n],:.] and integer? n => u + u isnt [.,:.] or u is [[.,:n],:.] and integer? n => u op:= keyp u --integer? op => nil leftPrec:= getBindingPowerOf("left",u) @@ -1094,7 +1094,7 @@ putWidth u == WIDTH x 0 newFirst:= - atom (oldFirst:= first u) => + (oldFirst:= first u) isnt [.,:.] => fn:= GETL(oldFirst,"WIDTH") => [oldFirst,:FUNCALL(fn,[oldFirst,:l])] if l then ll := rest l else ll := nil @@ -1155,7 +1155,7 @@ maprin0 x == maprinChk x == null $MatrixList => maPrin x - atom x and (u:= assoc(x,$MatrixList)) => + x isnt [.,:.] and (u:= assoc(x,$MatrixList)) => $MatrixList := remove($MatrixList,u) maPrin deMatrix rest u x is ["=",arg,y] => --case for tracing with )math and printing matrices @@ -1205,7 +1205,7 @@ LargeMatrixp(u,width, dist) == -- sees if there is a matrix wider than 'width' in the next 'dist' -- part of u, a sized charybdis structure. -- nil if not, first such matrix if there is one - atom u => nil + u isnt [.,:.] => nil CDAR u <= width => nil --CDAR is the width of a charybdis structure op:=CAAR u @@ -1270,7 +1270,7 @@ SubstWhileDesizing(u,m) == -- arg. m is always nil (historical: EU directive to increase argument lists 1991/XGII) --Replaces all occurrences of matrix m by name in u --Taking out any outdated size information as it goes - atom u => u + u isnt [.,:.] => u [[op,:n],:l]:=u --name := RASSOC(u,$MatrixList) => name -- doesn't work since RASSOC seems to use an EQ test, and returns the @@ -1284,7 +1284,7 @@ SubstWhileDesizing(u,m) == PushMatrix u l':=SubstWhileDesizingList(l,m) -- [op,:l'] - atom op => [op,:l'] + op isnt [.,:.] => [op,:l'] [SubstWhileDesizing(op,m),:l'] --;SubstWhileDesizingList(u,m) == @@ -1300,11 +1300,11 @@ SubstWhileDesizing(u,m) == SubstWhileDesizingList(u,m) == u is [a,:b] => res:= - atom a => [a] + a isnt [.,:.] => [a] [SubstWhileDesizing(a,m)] tail:=res for i in b repeat - if atom i then tail.rest := [i] + if i isnt [.,:.] then tail.rest := [i] else tail.rest := [SubstWhileDesizing(i,m)] tail:=rest tail res @@ -1345,11 +1345,11 @@ bigopAppAux(bot,top,arg,x,y,d,kind) == xCenter := half(maxWidth-1) + x d:=APP(arg,x+2+maxWidth,y,d) d:= - atom bot and # atom2String bot = 1 => APP(bot,xCenter,y-2,d) + bot isnt [.,:.] and # atom2String bot = 1 => APP(bot,xCenter,y-2,d) APP(bot,x + half(maxWidth - botWidth),y-2-superspan bot,d) if top then d:= - atom top and # atom2String top = 1 => APP(top,xCenter,y+2,d) + top isnt [.,:.] and # atom2String top = 1 => APP(top,xCenter,y+2,d) APP(top,x + half(maxWidth - topWidth),y+2+subspan top,d) delta := (kind = 'pi => 2; 1) opCode := @@ -1614,7 +1614,7 @@ outputString(start,linelength,str) == outputDomainConstructor form == if VECTORP form then form := devaluate form - atom (u:= prefix2String form) => u + (u:= prefix2String form) isnt [.,:.] => u v:= [object2String(x) for x in u] return INTERNL apply(function strconc,v) @@ -1667,7 +1667,7 @@ printBasic x == x=$One => writeInteger(1,$algebraOutputStream) x=$Zero => writeInteger(0,$algebraOutputStream) ident? x => writeString(symbolName x,$algebraOutputStream) - atom x => PRIN1(x,$algebraOutputStream) + x isnt [.,:.] => PRIN1(x,$algebraOutputStream) PRIN1(x,$algebraOutputStream) charybdis(u,start,linelength) == @@ -1702,8 +1702,8 @@ charyTop(u,start,linelength) == '" " charyTopWidth u == - atom u => u - atom first u => putWidth u + u isnt [.,:.] => u + first u isnt [.,:.] => putWidth u integer? CDAR u => u putWidth u @@ -1729,7 +1729,7 @@ sublisMatAlist(m,m1,u) == charyTrouble1(u,v,start,linelength) == integer? u => outputNumber(start,linelength,atom2String u) - atom u => outputString(start,linelength,atom2String u) + u isnt [.,:.] => outputString(start,linelength,atom2String u) sameObject?(x:= keyp u,'_-) => charyMinus(u,v,start,linelength) x in '(_+ _* AGGLST) => charySplit(u,v,start,linelength) x='EQUATNUM => charyEquatnum(u,v,start,linelength) @@ -1845,8 +1845,8 @@ scylla(n,v) == nil keyp(u) == - atom u => nil - atom first u => first u + u isnt [.,:.] => nil + first u isnt [.,:.] => first u CAAR u absym x == @@ -1866,10 +1866,10 @@ aggwidth u == argsapp(u,x,y,d) == appargs(rest u,x,y,d) subspan u == - atom u => 0 + u isnt [.,:.] => 0 integer? rest u => subspan first u (cons? first u and_ - atom CAAR u and_ + CAAR u isnt [.,:.] and_ not integer? CAAR u and_ GETL(CAAR u, 'SUBSPAN) ) => APPLX(GETL(CAAR u, 'SUBSPAN), [u]) @@ -1878,10 +1878,10 @@ subspan u == agggsub u == subspan rest u superspan u == - atom u => 0 + u isnt [.,:.] => 0 integer? rest u => superspan first u (cons? first u and_ - atom CAAR u and_ + CAAR u isnt [.,:.] and_ not integer? CAAR u and_ GETL(CAAR u, 'SUPERSPAN) ) => APPLX(GETL(CAAR u, 'SUPERSPAN), [u]) @@ -2362,8 +2362,8 @@ qTWidth(u) == 2 + WIDTH second u remWidth(x) == - atom x => x - true => [(atom first x => first x; true => CAAR x), + x isnt [.,:.] => x + true => [(first x isnt [.,:.] => first x; true => CAAR x), :[remWidth y for y in rest x]] subSub(u) == @@ -2554,7 +2554,7 @@ mathPrint u == PSTRING u; nil) mathPrintTran u == - atom u => u + u isnt [.,:.] => u true => for x in tails u repeat x.first := mathPrintTran first x @@ -2601,11 +2601,11 @@ primaryForm2String x == x = "$" => '"%" x = "$$" => '"%%" symbolName x - atom x => toString x + x isnt [.,:.] => toString x strconc('"(",inputForm2String x, '")") callForm2String x == - atom x => primaryForm2String x + x isnt [.,:.] => primaryForm2String x [op,:args] := x member(op,$allClassicOps) => primaryForm2String x @@ -2674,7 +2674,7 @@ parms2String x == strconc(first xs, '", ") inputForm2String x == - atom x => primaryForm2String x + x isnt [.,:.] => primaryForm2String x [op,:args] := x isUnaryPrefix op and #args = 1 => unaryForm2String x #args = 2 => diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot index a8c4f44c..4a0f08eb 100644 --- a/src/interp/i-resolv.boot +++ b/src/interp/i-resolv.boot @@ -326,7 +326,7 @@ resolveTTRed2(t1,t2,TL) == resolveTTRed3(t) == -- recursive resolveTTRed which handles all subterms of the form -- (Resolve t1 t2) or subterms which have to be interpreted - atom t => t + t isnt [.,:.] => t t is ['Resolve,a,b] => ( t1 := resolveTTRed3 a ) and ( t2 := resolveTTRed3 b ) and resolveTT1(t1,t2) @@ -339,7 +339,7 @@ resolveTTRed3(t) == t is ['VarEqual,a,b] => (a = b) and a t is ['SetEqual,a,b] => (and/[member(x,a) for x in b] and "and"/[member(x,b) for x in a]) and a - [( atom x and x ) or ((not cs and x and not interpOp? x and x) + [(x isnt [.,:.] and x ) or ((not cs and x and not interpOp? x and x) or resolveTTRed3 x) or return nil for x in t for cs in getDualSignatureFromDB first t ] @@ -448,7 +448,7 @@ matchUpToPatternVars(pat,form,patAlist) == patAlist := [[pat,:form],:patAlist] true cons?(pat) => - atom form => nil + form isnt [.,:.] => nil matchUpToPatternVars(first pat, first form,patAlist) and matchUpToPatternVars(rest pat, rest form,patAlist) nil @@ -491,7 +491,7 @@ resolveTM1(t,m) == t=rest p and t $Subst := [[m,:t],:$Subst] t - atom(t) or atom(m) => nil + t isnt [.,:.] or m isnt [.,:.] => nil (t is ['Record,:tr]) and (m is ['Record,:mr]) and (tt := resolveTMRecord(tr,mr)) => tt t is ['Record,:.] or m is ['Record,:.] => nil @@ -678,7 +678,7 @@ resolveTMRed(t,m) == resolveTMRed1(t) == -- recursive resolveTMRed which handles all subterms of the form -- (Resolve a b) - atom t => t + t isnt [.,:.] => t t is ['Resolve,a,b] => ( a := resolveTMRed1 a ) and ( b := resolveTMRed1 b ) and resolveTM1(a,b) @@ -692,7 +692,7 @@ resolveTMRed1(t) == "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] - [( atom x and x ) or resolveTMRed1 x or return nil for x in t] + [(x isnt [.,:.] and x ) or resolveTMRed1 x or return nil for x in t] --% Type and Mode Representation diff --git a/src/interp/i-special.boot b/src/interp/i-special.boot index 54729eb6..073c2cbd 100644 --- a/src/interp/i-special.boot +++ b/src/interp/i-special.boot @@ -941,7 +941,7 @@ mkIterZippedFun(indexList,funBody,zipType,$localVars) == vec subVecNodes(new,old,form) == - atom form => + form isnt [.,:.] => (vector? form) and (form.0 = old) => new form [subVecNodes(new,old,first form), :subVecNodes(new,old,rest form)] @@ -1250,14 +1250,14 @@ isPolynomialMode m == nil containsPolynomial m == - atom m => nil + m isnt [.,:.] => nil [d,:.] := m symbolMember?(d,$univariateDomains) or symbolMember?(d,$multivariateDomains) or d in '(Polynomial RationalFunction) => true (m' := underDomainOf m) and containsPolynomial m' containsVariables m == - atom m => nil + m isnt [.,:.] => nil [d,:.] := m symbolMember?(d,$univariateDomains) or symbolMember?(d,$multivariateDomains) => true (m' := underDomainOf m) and containsVariables m' @@ -1367,7 +1367,7 @@ upDollar t == if f = $immediateDataSymbol then f := objValUnwrap coerceInteractive(getValue form,$OutputForm) if f = '(construct) then f := "nil" - atom form and (f ~= $immediateDataSymbol) => + form isnt [.,:.] and (f ~= $immediateDataSymbol) => type := constantInDomain?([f],t) => type ~= true => findConstantInDomain(op,f,type,t) -- Ambiguous constant. FIXME: try to narrow before giving up. @@ -1413,7 +1413,7 @@ upDollarTuple(op, f, t, t2, args, nargs) == upLispCall(op,t) == -- process $Lisp calls - if atom t then code:=getUnname t else + if t isnt [.,:.] then code:=getUnname t else [lispOp,:argl]:= t null functionp lispOp.0 => throwKeyedMsg("S2IS0024",[lispOp.0]) @@ -1672,7 +1672,7 @@ removeConstruct pat == -- removes the "construct" from the beginning of patterns if pat is ["construct",:p] then pat:=p if pat is ["cons", a, b] then pat := [a, [":", b]] - atom pat => pat + pat isnt [.,:.] => pat pat.first := removeConstruct first pat pat.rest := removeConstruct rest pat pat @@ -1973,7 +1973,7 @@ unVectorize body == name := getUnname body name ~= $immediateDataSymbol => name objValUnwrap getValue body - atom body => body + body isnt [.,:.] => body body is [op,:argl] => newOp:=unVectorize op if newOp = 'SUCHTHAT then newOp := "|" @@ -2098,7 +2098,7 @@ NRTcompiledLookup(op,sig,dom) == compiledLookupCheck(op,sig,dom) NRTtypeHack t == - atom t => t + t isnt [.,:.] => t first t = '_# => # second t [first t,:[NRTtypeHack tt for tt in rest t]] @@ -2411,7 +2411,7 @@ upwhere t == [env,:e] := upwhereClause(clause,$env,$e) tree := upwhereMkAtree(tree,env,e) if x := getAtree(op,'dollar) then - atom tree => throwKeyedMsg("S2IS0048",nil) + tree isnt [.,:.] => throwKeyedMsg("S2IS0048",nil) putAtree(first tree,'dollar,x) upwhereMain(tree,env,e) val := getValue tree diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 1cbdc3a7..37724492 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -968,7 +968,7 @@ displayType($op,u,omitVariableNameIfTrue) == sayMSG ['" Type of value of ", fixObjectForPrinting PNAME $op,'": (none)"] type := prefix2String objMode(u) - if atom type then type := [type] + if type isnt [.,:.] then type := [type] sayMSG concat ['" Type of value of ",fixObjectForPrinting PNAME $op,'": ",:type] nil @@ -984,7 +984,7 @@ displayValue($op,u,omitVariableNameIfTrue) == rhs := '": " strconc('"Value of ", PNAME $op,'": ") labmode := prefix2String objMode(u) - if atom labmode then labmode := [labmode] + if labmode isnt [.,:.] then labmode := [labmode] ident? expr and getConstructorKindFromDB expr = "domain" => sayMSG concat('" ",label,labmode,rhs,form2String expr) mathprint ['CONCAT,label,:labmode,rhs, @@ -1091,7 +1091,7 @@ frameSpad2Cmd args == arg := selectOptionLC(first args,frameArgs,'optionError) args := rest args if args is [a] then args := a - if atom args then args := object2Identifier args + if args isnt [.,:.] then args := object2Identifier args arg is 'drop => args and cons?(args) => throwKeyedMsg("S2IZ0017",[args]) closeInterpreterFrame(args) @@ -1229,7 +1229,7 @@ displayFrameNames() == importFromFrame args == -- args should have the form [frameName,:varNames] - if args and atom args then args := [args] + if args and args isnt [.,:.] then args := [args] null args => throwKeyedMsg("S2IZ0073",nil) [fname,:args] := args not member(fname,frameNames()) => @@ -1705,7 +1705,7 @@ readHiFi(n) == if $useInternalHistoryTable then pair := assoc(n,$internalHistoryTable) - atom pair => keyedSystemError("S2IH0034",nil) + pair isnt [.,:.] => keyedSystemError("S2IH0034",nil) vec := rest pair else HiFi:= RDEFIOSTREAM ['(MODE . INPUT),['FILE,:histFileName()]] @@ -2124,15 +2124,15 @@ reportOperations(oldArg,u) == sayKeyedMsg("S2IZ0064",nil) u isnt ['Record,:.] and u isnt ['Union,:.] and null(isNameOfType u) and u isnt ['typeOf,.] => - if atom oldArg then oldArg := [oldArg] + if oldArg isnt [.,:.] then oldArg := [oldArg] sayKeyedMsg("S2IZ0063",nil) for op in oldArg repeat sayKeyedMsg("S2IZ0062",[opOf op]) (v := isDomainValuedVariable u) => reportOpsFromUnitDirectly0 v unitForm:= - atom u => opOf unabbrev u + u isnt [.,:.] => opOf unabbrev u unabbrev u - atom unitForm => reportOpsFromLisplib0(unitForm,u) + unitForm isnt [.,:.] => reportOpsFromLisplib0(unitForm,u) unitForm' := evaluateType unitForm tree := mkAtree removeZeroOneDestructively unitForm (unitForm' := isType tree) => reportOpsFromUnitDirectly0 unitForm' @@ -2220,7 +2220,7 @@ reportOpsFromUnitDirectly unitForm == $CategoryFrame) sigList := removeDuplicates MSORT [[[a,b],true,slot c] for [a,b,c] in funlist] - where slot c == (atom c => [c,0,1]; c) + where slot c == (c isnt [.,:.] => [c,0,1]; c) else sigList:= removeDuplicates MSORT getOplistForConstructorForm unitForm say2PerLine [formatOperation(x,unit) for x in sigList] diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot index 4084ff67..136c61b9 100644 --- a/src/interp/i-util.boot +++ b/src/interp/i-util.boot @@ -46,7 +46,7 @@ $intTopLevel == inputPrompt str == -- replaces older INPUT-PROMPT - atom (x := $SCREENSIZE()) => nil + (x := $SCREENSIZE()) isnt [.,:.] => nil p := first(x) - 2 y := $OLDLINE SETQ($OLDLINE,nil) diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 561edc19..5067a3f2 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -194,7 +194,7 @@ oldAxiomPreCategoryParents(catform,dom) == [eval quoteCatOp cat for [cat,:pred] in parents | eval pred]) quoteCatOp cat == - atom cat => MKQ cat + cat isnt [.,:.] => MKQ cat ['LIST, MKQ first cat,: rest cat] @@ -282,7 +282,7 @@ depthAssoc x == getCatAncestors x == [CAAR y for y in parentsOf opOf x] listOfEntries form == - atom form => form + form isnt [.,:.] => form form is [op,:l] => op is 'Join => "append"/[listOfEntries x for x in l] op is 'CATEGORY => listOfCategoryEntries rest l diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index ceeed354..bd6aa7f5 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -82,7 +82,7 @@ expandSTEP(id,lo,step,final)== loopvar := [:loopvar,[g1,step]] g1 final := - atom final => final + final isnt [.,:.] => final final is [hi] and atomic? hi => hi g2 := gensym() loopvar := [:loopvar,[g2,:final]] diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 7cae8dcb..cc766b57 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -101,7 +101,7 @@ makePredicateBitVector pl == --called by buildFunctor $predGensymAlist := nil --bound by buildFunctor, used by optHas for p in removeAttributePredicates pl repeat pred := simpBool transHasCode p - atom pred => 'skip --skip over T and nil + pred isnt [.,:.] => 'skip --skip over T and nil if isHasDollarPred pred then lasts := insert(pred,lasts) for q in stripOutNonDollarPreds pred repeat firsts := insert(q,firsts) @@ -151,7 +151,7 @@ removeAttributePredicates pl == fnl p == [fn x for x in p] transHasCode x == - atom x => x + x isnt [.,:.] => x op := x.op op in '(HasCategory HasAttribute) => x op="has" => compHasFormat x @@ -159,7 +159,7 @@ transHasCode x == mungeAddGensyms(u,gal) == ['%list,:[fn(x,gal,0) for x in u]] where fn(x,gal,n) == - atom x => x + x isnt [.,:.] => x g := LASSOC(x,gal) => n = 0 => ["%LET",g,x] g @@ -626,8 +626,8 @@ mergeSignatureAndLocalVarAlists(signatureAlist, localVarAlist) == [funcName, :signature] in signatureAlist] Operators u == - atom u => [] - atom first u => + u isnt [.,:.] => [] + first u isnt [.,:.] => answer:="union"/[Operators v for v in rest u] symbolMember?(first u,answer) => answer [first u,:answer] diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index fd5d56bb..0f393f5c 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -45,7 +45,7 @@ $forceAdd := false -- or to get the current domains in scope; addDomain(domain,e) == - atom domain => + domain isnt [.,:.] => domain="$EmptyMode" => e domain="$NoValueMode" => e not ident? domain or 2 < #(s:= STRINGIMAGE domain) and @@ -139,7 +139,7 @@ addEltModemap(op,mc,sig,pred,fn,e) == then $e:= makeLiteral(id,$e) else e:= makeLiteral(id,e) addModemap1(op,mc,[:lt,id],pred,fn,e) - -- atom sel => systemErrorHere '"addEltModemap" + -- sel isnt [.,:.] => systemErrorHere '"addEltModemap" addModemap1(op,mc,sig,pred,fn,e) op='setelt and sig is [:lt,sel,v] => string? sel => @@ -148,7 +148,7 @@ addEltModemap(op,mc,sig,pred,fn,e) == then $e:= makeLiteral(id,$e) else e:= makeLiteral(id,e) addModemap1(op,mc,[:lt,id,v],pred,fn,e) - -- atom sel => systemError '"addEltModemap" + -- sel isnt [.,:.] => systemError '"addEltModemap" addModemap1(op,mc,sig,pred,fn,e) systemErrorHere '"addEltModemap" @@ -213,7 +213,7 @@ augModemapsFromDomain(name,functorForm,e) == augModemapsFromDomain1(name,functorForm,e) == property(KAR functorForm,"makeFunctionList") => addConstructorModemaps(name,functorForm,e) - atom functorForm and (catform := getmode(functorForm,e)) => + functorForm isnt [.,:.] and (catform := getmode(functorForm,e)) => augModemapsFromCategory(name,name,functorForm,catform,e) mappingForm := getmodeOrMapping(KAR functorForm,e) => ["Mapping",categoryForm,:functArgTypes] := mappingForm @@ -275,7 +275,7 @@ evalAndSub(domainName,viewName,functorForm,form,$e) == [substAlist,$e] getOperationAlist(name,functorForm,form) == - if atom name and niladicConstructorFromDB name then + if name isnt [.,:.] and niladicConstructorFromDB name then functorForm:= [functorForm] (u:= isFunctor functorForm) and not ($insideFunctorIfTrue and first functorForm=first $functorForm) => u @@ -359,7 +359,7 @@ addInformation(m,$e) == info m where info m == --Processes information from a mode declaration in compCapsule - atom m => nil + m isnt [.,:.] => nil m is ["CATEGORY",.,:stuff] => for u in stuff repeat addInfo u m is ["Join",:stuff] => for u in stuff repeat info u nil @@ -372,15 +372,15 @@ addInfo u == $Information:= [formatInfo u,:$Information] formatInfo u == - atom u => u + u isnt [.,:.] => u u is ["SIGNATURE",:v] => ["SIGNATURE","$",:v] u is ["PROGN",:l] => ["PROGN",:[formatInfo v for v in l]] u is ["ATTRIBUTE",v] => -- The parser can't tell between those attributes that really -- are attributes, and those that are category names - atom v and isCategoryForm([v],$e) => ["has","$",[v]] - atom v => ["ATTRIBUTE","$",v] + v isnt [.,:.] and isCategoryForm([v],$e) => ["has","$",[v]] + v isnt [.,:.] => ["ATTRIBUTE","$",v] isCategoryForm(v,$e) => ["has","$",v] ["ATTRIBUTE","$",v] u is ["IF",a,b,c] => @@ -401,13 +401,13 @@ liftCond (clause is [ante,conseq]) == formatPred u == --Assumes that $e is set up to point to an environment u is ["has",a,b] => - atom b and isCategoryForm([b],$e) => ["has",a,[b]] - atom b => ["has",a,["ATTRIBUTE",b]] + b isnt [.,:.] and isCategoryForm([b],$e) => ["has",a,[b]] + b isnt [.,:.] => ["has",a,["ATTRIBUTE",b]] isCategoryForm(b,$e) => u b is ["ATTRIBUTE",.] => u b is ["SIGNATURE",:.] => u ["has",a,["ATTRIBUTE",b]] - atom u => u + u isnt [.,:.] => u u is ["and",:v] => ["and",:[formatPred w for w in v]] systemError ['"formatPred",u] diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index 6abdf340..c0da49b3 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -119,7 +119,7 @@ getKeyedMsg key == fetchKeyedMsg(key,false) segmentKeyedMsg(msg) == string2Words msg segmentedMsgPreprocess x == - atom x => x + x isnt [.,:.] => x [head,:tail] := x center := rightJust := nil if member(head, '(%ceon "%ceon")) then center := true @@ -238,7 +238,7 @@ substituteSegmentedMsg(msg,args) == addBlanks msg == -- adds proper blanks - atom msg => msg + msg isnt [.,:.] => msg null msg => msg # msg = 1 => msg blanksOff := false @@ -292,7 +292,7 @@ noBlankAfterP word== cleanUpSegmentedMsg msg == -- removes any junk like double blanks -- takes a reversed msg and puts it in the correct order - atom msg => msg + msg isnt [.,:.] => msg blanks := ['" "," "] haveBlank := nil prims := @@ -531,7 +531,7 @@ throwKeyedMsgCannotCoerceWithValue(val,t1,t2) == --% Some Standard Message Printing Functions bright x == ['"%b",:(cons?(x) and null rest lastNode x => x; [x]),'"%d"] ---bright x == ['"%b",:(atom x => [x]; x),'"%d"] +--bright x == ['"%b",:(x isnt [.,:.] => [x]; x),'"%d"] mkMessage msg == msg and (cons? msg) and member((first msg),'(%l "%l")) and @@ -716,7 +716,7 @@ tabber num == brightPrintCenter(x,out == $OutputStream) == $texFormatting => brightPrintCenterAsTeX(x,out) -- centers rst within $LINELENGTH, checking for %l's - atom x => + x isnt [.,:.] => x := object2String x wid := # x if wid < $LINELENGTH then @@ -742,7 +742,7 @@ brightPrintCenter(x,out == $OutputStream) == nil brightPrintCenterAsTeX(x, out == $OutputStream) == - atom x => + x isnt [.,:.] => sayString('"\centerline{",out) sayString(x,out) sayString('"}",out) @@ -762,7 +762,7 @@ brightPrintCenterAsTeX(x, out == $OutputStream) == brightPrintRightJustify(x, out == $OutputStream) == -- right justifies rst within $LINELENGTH, checking for %l's - atom x => + x isnt [.,:.] => x := object2String x wid := # x wid < $LINELENGTH => @@ -791,7 +791,7 @@ brightPrintRightJustify(x, out == $OutputStream) == sayBrightlyLength l == null l => 0 - atom l => sayBrightlyLength1 l + l isnt [.,:.] => sayBrightlyLength1 l sayBrightlyLength1 first l + sayBrightlyLength rest l sayBrightlyLength1 x == @@ -806,7 +806,7 @@ sayBrightlyLength1 x == -- following line helps find certain bugs that slip through -- also see brightPrintHighlight vector? x => # '"UNPRINTABLE" - atom x => # toString x + x isnt [.,:.] => # toString x 2 + sayBrightlyLength x sayAsManyPerLineAsPossible l == @@ -883,7 +883,7 @@ sayDisplayWidth x == # atom2String x sayWidth x == - atom x => # atom2String x + x isnt [.,:.] => # atom2String x +/[fn y for y in x] where fn y == sayWidth y @@ -950,7 +950,7 @@ splitSayBrightly u == u splitSayBrightlyArgument u == - atom u => nil + u isnt [.,:.] => nil while splitListSayBrightly u is [head,:u] repeat result:= [head,:result] result => [:reverse! result,u] [u] diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index b536b201..7edba7aa 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -100,7 +100,7 @@ exp2Fort1 l == exp2Fort2(e,prec,oldOp) == null e => nil - atom e => [object2String e] + e isnt [.,:.] => [object2String e] e is [ "=",lhs,rhs] or e is [ '"=",lhs,rhs] => ['"%l",:exp2Fort2(rhs,prec,'"="),'"=",:exp2Fort2(lhs,prec,'"=")] @@ -120,7 +120,7 @@ exp2Fort2(e,prec,oldOp) == (p := position(op,unaryOps)) > -1 => nprec := unaryPrecs.p s := [:exp2Fort2(first args,nprec,op),op] - op = '"-" and atom first args => s + op = '"-" and first args isnt [.,:.] => s op = oldOp and member(op,['"*",'"+"]) => s nprec <= prec => ['")",:s,'"("] s @@ -167,7 +167,7 @@ exp2FortOptimize e == -- 1 extract common subexpressions -- 2 try to optimize computing of powers $exprStack : local := nil - atom e => [e] + e isnt [.,:.] => [e] $fortranOptimizationLevel = 0 => e1 := exp2FortOptimizeArray e reverse! [e1,:$exprStack] @@ -214,8 +214,8 @@ beenHere(e,n) == exp2FortOptimizeCS1 e == -- we do nothing with atoms or simple lists containing atoms - atom(e) or (atom first e and null rest e) => e - e is [op,arg] and object2Identifier op = "-" and atom arg => e + e isnt [.,:.] or (first e isnt [.,:.] and null rest e) => e + e is [op,arg] and object2Identifier op = "-" and arg isnt [.,:.] => e -- see if we have been here before not (object2Identifier first e in '(ROW AGGLST)) and @@ -233,7 +233,7 @@ exp2FortOptimizeCS1 e == $fortCsExprStack := rest $fortCsExprStack g := rest f -- check to see of we have an non-nil atomic CDR - g and atom g => + g and g isnt [.,:.] => pushCsStacks(f,'CDR) f.rest := exp2FortOptimizeCS1 g popCsStacks(0) @@ -254,7 +254,7 @@ exp2FortOptimizeCS1 e == exp2FortOptimizeArray e == -- this handles arrays - atom e => e + e isnt [.,:.] => e [op,:args] := e op1 := object2Identifier op op1 in '(BRACE BRACKET) => @@ -371,7 +371,7 @@ formatAsFortranExpression x == dispfortexp x == - if atom(x) or x is [op,:.] and + if x isnt [.,:.] or x is [op,:.] and not (object2Identifier op in '(_= MATRIX construct )) then var := makeSymbol strconc('"R",object2String $IOindex) @@ -438,7 +438,7 @@ exp2FortSpecial(op,args,nargs) == --the next line is NEVER used by FORTRAN code but is needed when -- called to get a linearized form for the browser op = "QUOTE" => - atom (arg := first args) => STRINGIMAGE arg + (arg := first args) isnt [.,:.] => STRINGIMAGE arg tailPart := strconc/[strconc('",",x) for x in rest arg] strconc('"[",first arg,tailPart,'"]") op = "PAREN" => @@ -670,7 +670,7 @@ checkType ty == mkParameterList l == [par2string(u) for u in l] where par2string u == - atom(u) => STRINGIMAGE u + u isnt [.,:.] => STRINGIMAGE u u := rest second u apply(function strconc,[STRINGIMAGE(first u),'"(",_ :rest [:['",",:statement2Fortran(v)] for v in rest u],'")"]) @@ -687,7 +687,7 @@ fortFormatTypes(typeName,names) == typeName = '"CHARACTER" => fortFormatCharacterTypes([unravel(u) for u in names]) where unravel u == - atom u => u + u isnt [.,:.] => u CDADR u fortFormatTypes1(typeName,mkParameterList names) @@ -712,7 +712,7 @@ fortFormatCharacterTypes(names) == sortedByLength := [] genuineArrays := [] for u in names repeat - atom u => sortedByLength := insertEntry(0,u,sortedByLength) + u isnt [.,:.] => sortedByLength := insertEntry(0,u,sortedByLength) #u=2 => sortedByLength := insertEntry(second u,first u,sortedByLength) genuineArrays := [u,:genuineArrays] for u in sortedByLength repeat @@ -797,7 +797,7 @@ fortPre1 e == member(e, imags) => ['"CMPLX",fortPre1(0),fortPre1(1)] -- other special objects STRINGIMAGE(e).0 = char "%" => subSequence(STRINGIMAGE e,1) - atom e => e + e isnt [.,:.] => e [op, :args] := e member(op,["**" , '"**"]) => [rand,exponent] := args @@ -888,7 +888,7 @@ fortExpSize e == -- This function overestimates the size because it assumes that e.g. -- (+ x (+ y z)) will be printed as "x+(y+z)" rather than "x+y+z" -- which is the actual case. - atom e => # STRINGIMAGE e + e isnt [.,:.] => # STRINGIMAGE e #e > 3 => 2+fortSize [fortExpSize x for x in e] #e < 3 => 2+fortSize [fortExpSize x for x in e] [op,arg1,arg2] := e @@ -906,7 +906,7 @@ fortExpSize e == fortSize e == +/[elen u for u in e] where elen z == - atom z => z + z isnt [.,:.] => z first z tempLen () == 1 + # STRINGIMAGE $exp2FortTempVarIndex @@ -950,7 +950,7 @@ segment1(e,maxSize) == segment2(e,topSize) == maxSize := $maximumFortranExpressionLength -tempLen()-1 - atom(e) => [e] + e isnt [.,:.] => [e] exprs := nil newE := [first e] topSize := topSize - fortExpSize newE diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index f3ee3e09..719476a4 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -143,7 +143,7 @@ listOfBoundVars form == u:=u.expr builtinConstructor? KAR u => listOfBoundVars u [form] - atom form => [] + form isnt [.,:.] => [] first form is 'QUOTE => [] -- We don't want to pick up the tag, only the domain first form = ":" => listOfBoundVars third form @@ -165,12 +165,12 @@ optDeltaEntry(op,sig,dc,eltOrConst) == -- stage of the compilation process. dc is '$ => nil ndc := - atom dc and (dcval := get(dc,'value,$e)) => dcval.expr + dc isnt [.,:.] and (dcval := get(dc,'value,$e)) => dcval.expr dc sig := MSUBST(ndc,dc,sig) -- Don't bother if the domain of computation is not an instantiation -- nor a candidate for inlining. - atom ndc or not optimizableDomain? ndc => nil + ndc isnt [.,:.] or not optimizableDomain? ndc => nil fun := lookupDefiningFunction(op,sig,ndc) -- following code is to handle selectors like first, rest if fun = nil and needToQuoteFlags?(sig,$e) then @@ -198,7 +198,7 @@ genDeltaEntry(opMmPair,e) == if $profileCompiler then profileRecord(dc,op,sig) eltOrConst is 'XLAM => cform if eltOrConst is 'Subsumed then eltOrConst := 'ELT - if atom dc then + if dc isnt [.,:.] then dc = "$" => nsig := sig if integer? nsig then nsig := MSUBST("$",dc,substitute("$$","$",sig)) setDifference(listOfBoundVars dc,$functorLocalParameters) ~= [] => @@ -246,7 +246,7 @@ NRTgetLocalIndex item == k := NRTassocIndex item => k item = "$" => 0 item = "$$" => 2 - atom item and not symbolMember?(item,$formalArgList) => --give slots to atoms + item isnt [.,:.] and not symbolMember?(item,$formalArgList) => --give slots to atoms $NRTdeltaList:= [["%domain",NRTaddInner item],:$NRTdeltaList] $NRTdeltaListComp:=[item,:$NRTdeltaListComp] index := $NRTbase + $NRTdeltaLength -- slot number to return @@ -289,7 +289,7 @@ NRTassignCapsuleFunctionSlot(op,sig) == ++ NRTaddInner should call following function instead of NRTgetLocalIndex ++ This would prevent putting spurious items in $NRTdeltaList NRTinnerGetLocalIndex x == - atom x => x + x isnt [.,:.] => x op := x.op ident? op and (constructor? op or builtinConstructor? op) => NRTgetLocalIndex x @@ -300,7 +300,7 @@ NRTinnerGetLocalIndex x == NRTaddInner x == --called by genDeltaEntry and others that affect $NRTdeltaList do - atom x => nil + x isnt [.,:.] => nil x is [":",y,z] => [x.op,y,NRTinnerGetLocalIndex z] x is ['SubDomain,y,:.] => NRTinnerGetLocalIndex y builtinConstructor? x.op or x.op is "[||]" => @@ -402,7 +402,7 @@ washFunctorBody form == main form where --======================================================================= stuffSlot(dollar,i,item) == vectorRef(dollar,i) := - atom item => [symbolFunction item,:dollar] + item isnt [.,:.] => [symbolFunction item,:dollar] item is [n,:op] and integer? n => ['newGoGet,dollar,:item] item is ['CONS,.,['FUNCALL,a,b]] => b is '$ => ['makeSpadConstant,eval a,dollar,i] @@ -571,8 +571,8 @@ NRTcheckVector domainShell == v := vectorRef(domainShell,i) v=true => nil --item is marked; ignore v=nil => nil - atom v => systemErrorHere '"CheckVector" - atom first v => nil --category form; ignore + v isnt [.,:.] => systemErrorHere '"CheckVector" + first v isnt [.,:.] => nil --category form; ignore assoc(first v,alist) => nil alist := [[first v,:vectorRef($SetFunctions,i)],:alist] alist @@ -714,7 +714,7 @@ vectorLocation(op,sig) == NRTsubstDelta(initSig) == sig := [replaceSlotTypes s for s in initSig] where replaceSlotTypes(t) == - atom t => + t isnt [.,:.] => not integer? t => t t = 0 => '$ t = 2 => '_$_$ @@ -735,7 +735,7 @@ NRTputInLocalReferences bod == NRTputInHead bod NRTputInHead bod == - atom bod => bod + bod isnt [.,:.] => bod bod is ['SPADCALL,:args,fn] => NRTputInTail rest bod --NOTE: args = COPY of rest bod -- The following test allows function-returning expressions @@ -755,10 +755,10 @@ NRTputInHead bod == NRTputInTail x == for y in tails x repeat - atom (u := first y) => + (u := first y) isnt [.,:.] => u='$ or LASSOC(u,$devaluateList) => nil k:= NRTassocIndex u => - atom u => y.first := ['%vref,'_$,k] + u isnt [.,:.] => y.first := ['%vref,'_$,k] -- u atomic means that the slot will always contain a vector y.first := ['SPADCHECKELT,'_$,k] --this reference must check that slot is a vector diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 4b1d036f..3424ecf1 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -450,7 +450,7 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) == string? s => a = s s is ['QUOTE,y] and PNAME y = a ident? s and symbolName s = a - atom a => a = s + a isnt [.,:.] => a = s op := opOf a op is 'NRTEVAL => s = nrtEval(second a,domain) op is 'QUOTE => s = second a @@ -499,13 +499,13 @@ lazyMatchArgDollarCheck(s,d,dollarName,domainName) == x is ['elt,someDomain,opname] => lookupInDomainByName(opname,evalDomain someDomain,arg) x is '$ and (arg = dollarName or arg = domainName) => true x = dollarName and arg = domainName => true - atom x or atom arg => false + x isnt [.,:.] or arg isnt [.,:.] => false xt and first x = first arg => lazyMatchArgDollarCheck(x,arg,dollarName,domainName) false lookupInDomainByName(op,domain,arg) == - atom arg => nil + arg isnt [.,:.] => nil opvec := domainRef(domain,1) . 2 numvec := getDomainByteVector domain predvec := domainPredicates domain @@ -543,7 +543,7 @@ newExpandTypeSlot(slot, dollar, domain) == newExpandLocalType(lazyt,dollar,domain) == vector? lazyt => canonicalForm lazyt - atom lazyt => lazyt + lazyt isnt [.,:.] => lazyt lazyt is [vec,.,:lazyForm] and vector? vec => --old style newExpandLocalTypeForm(lazyForm,dollar,domain) newExpandLocalTypeForm(lazyt,dollar,domain) --new style @@ -569,7 +569,7 @@ newExpandLocalTypeArgs(u,dollar,domain,typeFlag) == u is ['NRTEVAL,y] => nrtEval(y,domain) u is ['QUOTE,y] => y u is "$$" => canonicalForm domain - atom u => u --can be first, rest, etc. + u isnt [.,:.] => u --can be first, rest, etc. newExpandLocalTypeForm(u,dollar,domain) nrtEval(expr,dom) == @@ -610,7 +610,7 @@ lazyDomainSet(lazyForm,thisDomain,slot) == ++ such resolution has already occured. resolveNiladicConstructors form == ident? form and niladicConstructorFromDB form => [form] - atom form => form + form isnt [.,:.] => form form is ["QUOTE",:.] => form for args in tails rest form repeat args.first := resolveNiladicConstructors first args @@ -629,7 +629,7 @@ newHasTest(domform,catOrAtt) == cons? domform and builtinFunctorName? domform.op => ofCategory(domform,catOrAtt) op := opOf catOrAtt - isAtom := atom catOrAtt + isAtom := catOrAtt isnt [.,:.] not isAtom and op is 'Join => and/[newHasTest(domform,x) for x in rest catOrAtt] -- we will refuse to say yes for 'Cat has Cat' @@ -640,7 +640,7 @@ newHasTest(domform,catOrAtt) == for [aCat,:cond] in [:ancestorsOf(domform,nil),:applySubst(pairList($FormalMapVariableList,rest domform),getConstructorAttributesFromDB(opOf domform))] | aCat = catOrAtt repeat return evalCond cond where evalCond x == - atom x => x + x isnt [.,:.] => x [pred,:l] := x pred = "has" => l is [ w1,['ATTRIBUTE,w2]] => newHasTest(w1,w2) @@ -682,7 +682,7 @@ lazyMatchAssocV1(x,vec,domain) == --old style slot4 sayLooking(prefix,op,sig,dom) == $monitorNewWorld := false dollar := devaluate dom - atom dollar or vector? dollar or "or"/[vector? x for x in dollar] => systemError nil + dollar isnt [.,:.] or vector? dollar or "or"/[vector? x for x in dollar] => systemError nil sayBrightly concat(prefix,formatOpSignature(op,sig),bright '"from ",form2String dollar) $monitorNewWorld := true diff --git a/src/interp/parse.boot b/src/interp/parse.boot index 6ab39d19..f7db82fe 100644 --- a/src/interp/parse.boot +++ b/src/interp/parse.boot @@ -69,7 +69,7 @@ parseTransform x == parseTran: %ParseForm -> %Form parseTran x == - atom x => x + x isnt [.,:.] => x [op,:argl]:= x u := g(op) where g op == (op is ["elt",op,x] => g x; op) u="construct" => @@ -89,7 +89,7 @@ parseTypeList l == parseTranList: %List %Form -> %List %Form parseTranList l == - atom l => parseTran l + l isnt [.,:.] => parseTran l [parseTran first l,:parseTranList rest l] parseConstruct: %ParseForm -> %Form @@ -129,13 +129,13 @@ transIs1 u == h:= [":",transIs x] (v:= transIs1 y) is [":",z] => [h,z] v="nil" => second h - atom v => [h,[":",v]] + v isnt [.,:.] => [h,[":",v]] [h,:v] u is ["cons",x,y] => h:= transIs x (v:= transIs1 y) is [":",z] => [h,z] v="nil" => [h] - atom v => [h,[":",v]] + v isnt [.,:.] => [h,[":",v]] [h,:v] u @@ -167,12 +167,12 @@ parseBigelt t == transUnCons: %ParseForm -> %Form transUnCons u == - atom u => systemErrorHere ["transUnCons",u] + u isnt [.,:.] => systemErrorHere ["transUnCons",u] u is ["APPEND",x,y] => y = nil => x systemErrorHere ["transUnCons",u] u is ["CONS",x,y] => - atom y => [x,:y] + y isnt [.,:.] => [x,:y] [x,:transUnCons y] parseCoerce: %ParseForm -> %Form @@ -216,8 +216,8 @@ parseDEF t == parseLhs: %ParseForm -> %Form parseLhs x == - atom x => parseTran x - atom first x => [parseTran first x,:[transIs parseTran y for y in rest x]] + x isnt [.,:.] => parseTran x + first x isnt [.,:.] => [parseTran first x,:[transIs parseTran y for y in rest x]] parseTran x @@ -395,7 +395,7 @@ transCategoryItem x == x is ["SIGNATURE",lhs,rhs] => lhs is ["LISTOF",:y] => "append" /[transCategoryItem ["SIGNATURE",z,rhs] for z in y] - atom lhs => + lhs isnt [.,:.] => lhs := washOperatorName lhs rhs is ["Mapping",:m] => m is [.,"constant"] => [["SIGNATURE",lhs,[first m],"constant"]] diff --git a/src/interp/pathname.boot b/src/interp/pathname.boot index e5c9c8f3..97cab246 100644 --- a/src/interp/pathname.boot +++ b/src/interp/pathname.boot @@ -49,7 +49,7 @@ pathname? p == pathname p == pathname? p => p - atom p => PATHNAME p + p isnt [.,:.] => PATHNAME p if #p>2 then p:=[p.0,p.1] PATHNAME apply(FUNCTION MAKE_-FILENAME, p) diff --git a/src/interp/pf2atree.boot b/src/interp/pf2atree.boot index 584244f8..eaf188a8 100644 --- a/src/interp/pf2atree.boot +++ b/src/interp/pf2atree.boot @@ -524,7 +524,7 @@ pfCollect2Atree pf == -- -- patternVarsOf1(expr, varList) == -- null expr => varList --- atom expr => +-- expr isnt [.,:.] => -- not symbol? expr => varList -- SymMemQ(expr, varList) => varList -- [expr, :varList] diff --git a/src/interp/pf2sex.boot b/src/interp/pf2sex.boot index b531026b..30e619ff 100644 --- a/src/interp/pf2sex.boot +++ b/src/interp/pf2sex.boot @@ -473,7 +473,7 @@ patternVarsOf expr == patternVarsOf1(expr, varList) == null expr => varList - atom expr => + expr isnt [.,:.] => not symbol? expr => varList SymMemQ(expr, varList) => varList [expr, :varList] diff --git a/src/interp/posit.boot b/src/interp/posit.boot index 82d1f09d..9e3af606 100644 --- a/src/interp/posit.boot +++ b/src/interp/posit.boot @@ -86,7 +86,7 @@ lnFileName lineObject == ncBug('"there is no file name in %1", [lineObject] ) lnFileName? lineObject == - atom (fN := lineObject.4) => nil + (fN := lineObject.4) isnt [.,:.] => nil fN lnPlaceOfOrigin lineObject == diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index 7f18be08..eaaa254d 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -80,7 +80,7 @@ displayPreCompilationErrors() == postTran: %ParseTree -> %ParseForm postTran x == - atom x => + x isnt [.,:.] => postAtom x op := first x symbol? op and (f:= property(op,'postTran)) => FUNCALL(f,x) @@ -228,16 +228,16 @@ postDef t == [form,targetType]:= lhs is [":",:.] => rest lhs [lhs,nil] - if not $InteractiveMode and atom form then form := [form] + if not $InteractiveMode and form isnt [.,:.] then form := [form] newLhs:= - atom form => form + form isnt [.,:.] => form [op,:argl]:= [(x is [":",a,.] => a; x) for x in form] [op,:postDefArgs argl] argTypeList:= - atom form => nil + form isnt [.,:.] => nil [(x is [":",.,t] => t; nil) for x in rest form] typeList:= [targetType,:argTypeList] - if atom form then form := [form] + if form isnt [.,:.] then form := [form] specialCaseForm := [nil for x in form] ["DEF",newLhs,typeList,specialCaseForm,postTran rhs] @@ -247,7 +247,7 @@ postDefArgs argl == argl is [[":",a],:b] => b ~= nil => postError ['" Argument",:bright a,'"of indefinite length must be last"] - atom a or a is ["QUOTE",:.] => a + a isnt [.,:.] or a is ["QUOTE",:.] => a postError ['" Argument",:bright a,'"of indefinite length must be a name"] [first argl,:postDefArgs rest argl] @@ -264,7 +264,7 @@ postMDef(t) == lhs is [":",:.] => rest lhs [lhs,nil] form:= - atom form => [form] + form isnt [.,:.] => [form] form newLhs:= [(x is [":",a,:.] => a; x) for x in form] typeList:= [targetType,:[(x is [":",.,t] => t; nil) for x in rest form]] @@ -293,7 +293,7 @@ postForm: %ParseTree -> %ParseForm postForm u == u isnt [op,:argl] => systemErrorHere ["postForm",u] x:= - atom op => + op isnt [.,:.] => argl':= postTranList argl op':= true=> op @@ -495,7 +495,7 @@ postSignature t == killColons: %ParseTree -> %ParseForm killColons x == - atom x => x + x isnt [.,:.] => x x is [op,:.] and op in '(Record Union %Forall %Exist) => x x is [":",.,y] => killColons y [killColons first x,:killColons rest x] @@ -551,7 +551,7 @@ postTransformCheck x == postcheck: %ParseTree -> %ParseForm postcheck x == - atom x => nil + x isnt [.,:.] => nil x is ["DEF",form,[target,:.],:.] => setDefOp form postcheck rest rest x @@ -562,7 +562,7 @@ postcheck x == setDefOp: %ParseForm -> %Thing setDefOp f == if f is [":",g,:.] then f := g - f := (atom f => f; first f) + f := (f isnt [.,:.] => f; first f) if $topOp then $defOp:= f else $topOp:= f unComma: %ParseForm -> %ParseForm diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot index ae6c65ad..347a09a1 100644 --- a/src/interp/showimp.boot +++ b/src/interp/showimp.boot @@ -246,8 +246,8 @@ formatLazyDomain(dom,x) == formatLazyDomainForm(dom,x) == x = 0 => ["$"] integer? x => formatLazyDomain(dom,dom.x) - atom x => x - x is ['NRTEVAL,y] => (atom y => [y]; y) + x isnt [.,:.] => x + x is ['NRTEVAL,y] => (y isnt [.,:.] => [y]; y) [first x,:[formatLazyDomainForm(dom,y) for y in rest x]] @@ -282,7 +282,7 @@ dcSlots con == item := template.i item is [n,:op] and integer? n => dcOpLatchPrint(op,n) null item and i > 5 => sayBrightly ['"arg ",strconc('"#",STRINGIMAGE(i - 5))] - atom item => sayBrightly ['"fun ",item] + item isnt [.,:.] => sayBrightly ['"fun ",item] item is ['CONS,.,['FUNCALL,[.,a],b]] => sayBrightly ['"constant ",a] sayBrightly concat('"lazy ",form2String formatSlotDomain i) @@ -321,8 +321,8 @@ formatSlotDomain x == val := $infovec.0.x null val => [strconc('"#",STRINGIMAGE (x - 5))] formatSlotDomain val - atom x => x - x is ['NRTEVAL,y] => (atom y => [y]; y) + x isnt [.,:.] => x + x is ['NRTEVAL,y] => (y isnt [.,:.] => [y]; y) [first x,:[formatSlotDomain y for y in rest x]] --======================================================================= @@ -363,7 +363,7 @@ dcOpPrint(op,index) == slotNumber = 0 => '"subsumed by next entry" slotNumber = 1 => '"missing" name := $infovec.0.slotNumber - atom name => name + name isnt [.,:.] => name name is ["CONS","IDENTITY", ["FUNCALL", ["dispatchFunction", impl],"$"]] => kind := 'CONST @@ -471,7 +471,7 @@ dcSize(:options) == fun := 0 --# of function slots lazyNodes := 0 --# of nodes needed for lazy domain slots for i in 5..maxindex repeat - atom (item := template.i) => fun := fun + 1 + (item := template.i) isnt [.,:.] => fun := fun + 1 integer? first item => latch := latch + 1 'T => lazy := lazy + 1 @@ -537,7 +537,7 @@ halfWordSize(n) == 2 * n numberOfNodes(x) == - atom x => 0 + x isnt [.,:.] => 0 1 + numberOfNodes first x + numberOfNodes rest x template con == @@ -596,7 +596,7 @@ dcOps conname == for [op,:u] in reverse getConstructorOperationsFromDB conname repeat for [sig,slot,pred,key,:.] in u repeat suffix := - atom pred => nil + pred isnt [.,:.] => nil concat('" if ",pred2English pred) key is 'Subsumed => sayBrightly [:formatOpSignature(op,sig),'" subsumed by ",:formatOpSignature(op,slot),:suffix] diff --git a/src/interp/simpbool.boot b/src/interp/simpbool.boot index 9c088079..c14c8d5e 100644 --- a/src/interp/simpbool.boot +++ b/src/interp/simpbool.boot @@ -38,7 +38,7 @@ simpBool x == dnf2pf reduceDnf be x reduceDnf u == -- (OR (AND ..b..) b) ==> (OR b ) - atom u => u + u isnt [.,:.] => u for x in u repeat ok := true for y in u repeat @@ -78,14 +78,14 @@ andReduce(x,y) == dnf2pf(x) == x = 'true => 'T x = 'false => nil - atom x => x + x isnt [.,:.] => x mkpf( [mkpf([:[k for k in b],:[['not,k] for k in a]],'AND) for [a,b] in x],'OR) be x == b2dnf x b2dnf x == x = 'T => 'true x = nil => 'false - atom x => bassert x + x isnt [.,:.] => bassert x [op,:argl] := x op in '(AND and) => band argl op in '(OR or) => bor argl diff --git a/src/interp/slam.boot b/src/interp/slam.boot index f10c3c17..f069dfb1 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -124,7 +124,7 @@ mkDiffAssoc(op,body,k,sharpPosition,sharpArg,diffSlot,vecname) == -- form substitution list of the form: -- ( ((f (,DIFFERENCE #1 1)) . #2) ((f (,DIFFERENCE #1 2)) . #3) ...) -- but also checking that all difference values lie in 1..k - atom body => nil + body isnt [.,:.] => nil body is ['%when,:pl] => "union"/[mkDiffAssoc(op,c,k,sharpPosition,sharpArg,diffSlot,vecname) for [p,c] in pl] body is [fn,:argl] => @@ -365,7 +365,7 @@ mkCacheVec(op,nam,kind,resetCode,countCode) == -- -- op2String op == -- u:= linearFormatName op --- atom u => PNAME u +-- u isnt [.,:.] => PNAME u -- strconc/u -- -- reportCacheStorePrint(op,kind,count) == diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index b6c0ba0e..1b404d9b 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -120,28 +120,28 @@ CONTAINED(x,y) == main where cons? y => eq(x, first y) or eq(x, rest y) symbolEq?(x,y) equal(x,y) == - atom y => x = y + y isnt [.,:.] => x = y equal(x, first y) or equal(x, rest y) ++ Returns all the keys of association list `x' -- ??? Should not this be named `alistAllKeys'? ASSOCLEFT: %Thing -> %Thing ASSOCLEFT x == - atom x => x + x isnt [.,:.] => x [first p for p in x] ++ Returns all the datums of association list `x'. -- ??? Should not this be named `alistAllValues'? ASSOCRIGHT: %Thing -> %Thing ASSOCRIGHT x == - atom x => x + x isnt [.,:.] => x [rest p for p in x] ++ Put the association list pair `(x . y)' into `l', erasing any ++ previous association for `x'. ADDASSOC: (%Thing,%Thing,%Alist(%Thing,%Thing)) -> %Alist(%Thing,%Thing) ADDASSOC(x,y,l) == - atom l => [[x,:y],:l] + l isnt [.,:.] => [[x,:y],:l] x = first first l => [[x,:y],:rest l] [first l,:ADDASSOC(x,y,rest l)] @@ -149,7 +149,7 @@ ADDASSOC(x,y,l) == ++ Remove any assocation pair `(u . x)' from list `v'. DELLASOS: (%Thing,%Alist(%Thing,%Thing)) -> %Alist(%Thing,%Thing) DELLASOS(u,v) == - atom v => nil + v isnt [.,:.] => nil u = first first v => rest v [first v,:DELLASOS(u,rest v)] @@ -158,14 +158,14 @@ DELLASOS(u,v) == -- ??? Should not this be named `alistValue'? LASSOC: (%Thing,%Alist(%Thing,%Thing)) -> %Thing LASSOC(x,y) == - atom y => nil + y isnt [.,:.] => nil x = first first y => rest first y LASSOC(x,rest y) ++ Return the key associated with datum `x' in association list `y'. rassoc: (%Thing,%Alist(%Thing,%Thing)) -> %Thing rassoc(x,y) == - atom y => nil + y isnt [.,:.] => nil x = rest first y => first first y rassoc(x,rest y) diff --git a/src/interp/termrw.boot b/src/interp/termrw.boot index 235bbd88..aa3283f2 100644 --- a/src/interp/termrw.boot +++ b/src/interp/termrw.boot @@ -45,7 +45,7 @@ termRW(t,R) == termRW1(t,R) == -- tries to do one reduction on the leftmost outermost subterm of t t0:= term1RW(t,R) - not sameObject?(t0,t) or atom t => t0 + not sameObject?(t0,t) or t isnt [.,:.] => t0 [t1,:t2]:= t tt1:= termRW1(t1,R) tt2:= t2 and termRW1(t2,R) @@ -71,12 +71,12 @@ termMatch(tp,t,SL,vars) == -- t is a term pattern, t a term -- then the result is the augmented substitution SL or 'failed tp=t => SL - atom tp => + tp isnt [.,:.] => symbolMember?(tp,vars) => p:= ASSOC(tp,SL) => ( rest p=t ) [[tp,:t],:SL] 'failed - atom t => 'failed + t isnt [.,:.] => 'failed [tp1,:tp2]:= tp [t1,:t2]:= t SL:= termMatch(tp1,t1,SL,vars) @@ -92,7 +92,7 @@ termMatch(tp,t,SL,vars) == -- -- tests (by EQ), whether v occurs in term t -- -- v must not be nil -- sameObject?(v,t) => 'T --- atom t => nil +-- t isnt [.,:.] => nil -- isContained(v,first t) or isContained(v,rest t) augmentSub(v,t,SL) == @@ -125,7 +125,7 @@ subCopy0(t, SL) == subCopyOrNil(t,SL) == -- the same as subCopy, but the result is nil if nothing was copied p:= ASSOC(t,SL) => p - atom t => nil + t isnt [.,:.] => nil [t1,:t2]:= t t0:= subCopyOrNil(t1,SL) => t2 => [t, :[rest t0,:subCopy0(t2,SL)]] @@ -147,7 +147,7 @@ deepSubCopy0(t, SL) == deepSubCopyOrNil(t,SL) == -- the same as subCopy, but the result is nil if nothing was copied p:= ASSOC(t,SL) => [t,:deepSubCopy0(rest p, SL)] - atom t => nil + t isnt [.,:.] => nil [t1,:t2]:= t t0:= deepSubCopyOrNil(t1,SL) => t2 => [t, :[rest t0,:deepSubCopy0(t2,SL)]] diff --git a/src/interp/trace.boot b/src/interp/trace.boot index 9465a19a..1d503bcf 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -90,9 +90,9 @@ trace1 l == (lops := hasOption($options,'local)) => null l => throwKeyedMsg("S2IT0019",nil) constructor := unabbrev - atom l => l + l isnt [.,:.] => l null rest l => - atom first l => first l + first l isnt [.,:.] => first l first first l nil not(isFunctor constructor) => throwKeyedMsg("S2IT0020",nil) @@ -207,7 +207,7 @@ getTraceOption (x is [key,:l]) == key="of" => ["of",:[hn y for y in l]] where hn x == - atom x and not upperCase? STRINGIMAGE(x).0 => + x isnt [.,:.] and not upperCase? STRINGIMAGE(x).0 => isDomainOrPackage eval x => x stackTraceOptionError ["S2IT0013",[x]] g:= domainToGenvar x => g @@ -299,7 +299,7 @@ untrace l == transTraceItem x == $doNotAddEmptyModeIfTrue: local:=true - atom x => + x isnt [.,:.] => (value:=get(x,"value",$InteractiveFrame)) and member(objMode value,$LangSupportTypes) => x := objVal value @@ -337,7 +337,7 @@ coerceSpadArgs2E(args) == for arg in args for type in rest $tracedSpadModemap] subTypes(mm,sublist) == - atom mm => + mm isnt [.,:.] => (s:= LASSOC(mm,sublist)) => s mm [subTypes(m,sublist) for m in mm] @@ -451,7 +451,7 @@ spadTrace(domain,options) == integer? n and isTraceable(triple:= [op,sig,n],domain)] where isTraceable(x is [.,.,n,:.],domain) == - atom domain.n => nil + domain.n isnt [.,:.] => nil functionSlot:= first domain.n GENSYMP functionSlot => (reportSpadTrace("Already Traced",x); nil) @@ -650,7 +650,7 @@ getBpiNameIfTracedMap(name) == name hasPair(key,l) == - atom l => nil + l isnt [.,:.] => nil l is [[ =key,:a],:.] => a hasPair(key,rest l) @@ -728,7 +728,7 @@ traceReply() == sayBrightly '" " for x in _/TRACENAMES repeat x is [d,:.] and (isDomainOrPackage d) => addTraceItem d - atom x => + x isnt [.,:.] => isFunctor x => addTraceItem x (IS__GENVAR x => addTraceItem eval x; functionList:= [x,:functionList]) @@ -745,19 +745,19 @@ traceReply() == if $domains then displayList:= concat(prefix2String first $domains, [:concat('",",'" ",prefix2String x) for x in rest $domains]) - if atom displayList then displayList:= [displayList] + if displayList isnt [.,:.] then displayList:= [displayList] sayBrightly '" Domains traced: " sayBrightly flowSegmentedMsg(displayList,$LINELENGTH,6) if $packages then displayList:= concat(prefix2String first $packages, [:concat(", ",prefix2String x) for x in rest $packages]) - if atom displayList then displayList:= [displayList] + if displayList isnt [.,:.] then displayList:= [displayList] sayBrightly '" Packages traced: " sayBrightly flowSegmentedMsg(displayList,$LINELENGTH,6) if $constructors then displayList:= concat(abbreviate first $constructors, [:concat(", ",abbreviate x) for x in rest $constructors]) - if atom displayList then displayList:= [displayList] + if displayList isnt [.,:.] then displayList:= [displayList] sayBrightly '" Parameterized constructors traced:" sayBrightly flowSegmentedMsg(displayList,$LINELENGTH,6) @@ -768,7 +768,7 @@ addTraceItem d == _?t() == null _/TRACENAMES => sayMSG bright '"nothing is traced" - for x in _/TRACENAMES | atom x and not IS__GENVAR x repeat + for x in _/TRACENAMES | x isnt [.,:.] and not IS__GENVAR x repeat if llm:= get(x,'localModemap,$InteractiveFrame) then x:= ([CADAR llm]) sayMSG ['"Function",:bright rassocSub(x,$mapSubNameAlist),'"traced"] |