diff options
Diffstat (limited to 'src')
36 files changed, 289 insertions, 244 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 961cad8f..719d583d 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -359,15 +359,18 @@ bfReduce(op,y)== bfReduceCollect(op,y)== y is ["COLLECT",:.] => - body := y.1 - itl := y.2 + body := second y + itl := third y a := op is ["QUOTE",:.] => second op op op := bfReName a init := a has SHOETHETA or op has SHOETHETA bfOpReduce(op,init,body,itl) - bfReduce(op,bfTupleConstruct (y.1)) + seq := + y = nil => bfTuple nil + second y + bfReduce(op,bfTupleConstruct seq) -- delayed collect diff --git a/src/boot/parser.boot b/src/boot/parser.boot index eeb147ac..7bf4bef4 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -691,6 +691,8 @@ bpCompare()== and (bpIs() or bpTrap()) and bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1()) or true) + or bpLeave() + or bpThrow() bpAnd() == bpLeftAssoc('(AND),function bpCompare) diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 4ba335aa..b1e8ab77 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -472,11 +472,11 @@ (|bfLp| |it| |body|))))))) (DEFUN |bfReduceCollect| (|op| |y|) - (PROG (|init| |a| |itl| |body|) + (PROG (|seq| |init| |a| |itl| |body|) (RETURN (COND ((AND (CONSP |y|) (EQ (CAR |y|) 'COLLECT)) - (SETQ |body| (ELT |y| 1)) (SETQ |itl| (ELT |y| 2)) + (SETQ |body| (CADR |y|)) (SETQ |itl| (CADDR |y|)) (SETQ |a| (COND ((AND (CONSP |op|) (EQ (CAR |op|) 'QUOTE)) @@ -485,7 +485,9 @@ (SETQ |op| (|bfReName| |a|)) (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA))) (|bfOpReduce| |op| |init| |body| |itl|)) - (T (|bfReduce| |op| (|bfTupleConstruct| (ELT |y| 1)))))))) + (T (SETQ |seq| + (COND ((NULL |y|) (|bfTuple| NIL)) (T (CADR |y|)))) + (|bfReduce| |op| (|bfTupleConstruct| |seq|))))))) (DEFUN |bfDCollect| (|y| |itl|) (LIST 'COLLECT |y| |itl|)) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index afed4d9f..b3ef4b0e 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -747,13 +747,14 @@ (AND (|bpBracket| |f|) (|bpPush| (|bfConstruct| (|bpPop1|))))) (DEFUN |bpCompare| () - (AND (|bpIs|) - (OR (AND (|bpInfKey| '(SHOEEQ SHOENE LT LE GT GE IN)) - (OR (|bpIs|) (|bpTrap|)) - (|bpPush| - (|bfInfApplication| (|bpPop2|) (|bpPop2|) - (|bpPop1|)))) - T))) + (OR (AND (|bpIs|) + (OR (AND (|bpInfKey| '(SHOEEQ SHOENE LT LE GT GE IN)) + (OR (|bpIs|) (|bpTrap|)) + (|bpPush| + (|bfInfApplication| (|bpPop2|) (|bpPop2|) + (|bpPop1|)))) + T)) + (|bpLeave|) (|bpThrow|))) (DEFUN |bpAnd| () (|bpLeftAssoc| '(AND) #'|bpCompare|)) diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index e52d92ea..c1799071 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -14,21 +14,38 @@ (OR (EQ |x| (CAR |l|)) (|objectMember?| |x| (CDR |l|)))) (T (EQ |x| |l|)))) -(DEFUN |genericMember?| (|x| |l| |p|) +(DEFUN |symbolMember?| (|s| |l|) (COND ((NULL |l|) NIL) ((CONSP |l|) - (OR (APPLY |p| |x| (CAR |l|) NIL) - (|genericMember?| |x| (CDR |l|) |p|))) - (T (APPLY |p| |x| |l| NIL)))) + (OR (EQ |s| (CAR |l|)) (|symbolMember?| |s| (CDR |l|)))) + (T (EQ |s| |l|)))) -(DEFUN |symbolMember?| (|x| |l|) (|genericMember?| |x| |l| #'EQ)) - -(DEFUN |stringMember?| (|s| |l|) (|genericMember?| |s| |l| #'STRING=)) +(DEFUN |stringMember?| (|s| |l|) + (COND + ((NULL |l|) NIL) + ((CONSP |l|) + (OR (STRING= |s| (CAR |l|)) (|stringMember?| |s| (CDR |l|)))) + (T (STRING= |s| |l|)))) -(DEFUN |charMember?| (|c| |l|) (|genericMember?| |c| |l| #'CHAR=)) +(DEFUN |charMember?| (|c| |l|) + (COND + ((NULL |l|) NIL) + ((CONSP |l|) + (OR (CHAR= |c| (CAR |l|)) (|charMember?| |c| (CDR |l|)))) + (T (CHAR= |c| |l|)))) -(DEFUN |scalarMember?| (|x| |l|) (|genericMember?| |x| |l| #'EQL)) +(DEFUN |scalarMember?| (|x| |l|) + (COND + ((NULL |l|) NIL) + ((CONSP |l|) + (OR (EQL |x| (CAR |l|)) (|scalarMember?| |x| (CDR |l|)))) + (T (CHAR= |x| |l|)))) -(DEFUN |listMember?| (|x| |l|) (|genericMember?| |x| |l| #'EQUAL)) +(DEFUN |listMember?| (|x| |l|) + (COND + ((NULL |l|) NIL) + ((CONSP |l|) + (OR (EQUAL |x| (CAR |l|)) (|listMember?| |x| (CDR |l|)))) + (T (EQUAL |x| |l|)))) diff --git a/src/interp/as.boot b/src/interp/as.boot index 6652448e..7108d5a4 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -140,7 +140,7 @@ asMakeAlist con == --TTT in case we put the wrong thing in for niladic catgrs --if atom(form) and kind='category then form:=[form] if atom(form) then form:=[form] - kind = 'function => asMakeAlistForFunction con + kind is 'function => asMakeAlistForFunction con abb := asyAbbreviation(con,#(KDR sig)) if null KDR form then PUT(opOf form,'NILADIC,'T) modemap := asySubstMapping LASSOC(con,$mmAlist) @@ -159,7 +159,7 @@ asMakeAlist con == niladicPart := symbolMember?(con,$niladics) and [['NILADIC,:true]] falist := TAKE(#KDR form,$FormalMapVariableList) constructorCategory := - kind = 'category => + kind is 'category => talist := TAKE(#KDR form, $TriangleVariableList) SUBLISLIS(talist, falist, $constructorCategory) SUBLISLIS(falist,KDR form,$constructorCategory) @@ -167,7 +167,7 @@ asMakeAlist con == exportAlist := asGetExports(kind, form, constructorCategory) constructorModemap := SUBLISLIS(falist,KDR form,modemap) --TTT fix a niladic category constructormodemap (remove the joins) - if kind = 'category then + if kind is 'category then constructorModemap.mmTarget := $Category res := [['constructorForm,:form],:constantPart,:niladicPart, ['constructorKind,:kind], @@ -268,14 +268,14 @@ asGetModemaps(opAlist,oform,kind,modemap) == kind in '(category function) => "*1" form pred1 := - kind = 'category => [["*1",form]] + kind is 'category => [["*1",form]] nil signature := CDAR modemap domainList := [[a,m] for a in rest form for m in rest signature | asIsCategoryForm m] catPredList:= - kind = 'function => [["isFreeFunction","*1",opOf form]] + kind is 'function => [["isFreeFunction","*1",opOf form]] [['ofCategory,:u] for u in [:pred1,:domainList]] -- for [op,:itemlist] in SUBLISLIS(rpvl, $FormalMapVariableList,opAlist) repeat -- the code seems to oscillate between generating $FormalMapVariableList @@ -318,7 +318,7 @@ asyExtractDescription str == str trimComments str == - str = nil or str = '"" => '"" + str = nil or str is '"" => '"" m := maxIndex str str := subString(str,0,m) trimString str @@ -340,13 +340,13 @@ asyExportAlist con == asyMakeOperationAlist(con,proplist, key) == oplist := - u := LASSOC('domExports,proplist) => + u := symbolLassoc('domExports,proplist) => kind := 'domain u - u := LASSOC('catExports,proplist) => + u := symbolLassoc('catExports,proplist) => kind := 'category u - key = 'domain => + key is 'domain => kind := 'domain u := NIL return nil @@ -364,7 +364,7 @@ asyMakeOperationAlist(con,proplist, key) == ----------> Constants change <-------------- id pred := - LASSOC('condition,r) is p => hackToRemoveAnd p + symbolLassoc('condition,r) is p => hackToRemoveAnd p nil sig := asySignature(asytranForm(form,[idForm],nil),nil) entry := @@ -390,7 +390,7 @@ asyAncestors x == x is ['Apply,:r] => asyAncestorList r x is [op,y,:.] and op in '(PretendTo RestrictTo) => asyAncestors y atom x => - x = '_% => '_$ + x is '_% => '_$ symbolMember?(x, $niladics) => [x] niladicConstructorFromDB x => [x] x @@ -436,11 +436,11 @@ mkNiladics u == --OLD DEFINITION FOLLOWS asytranDeclaration(dform,levels,predlist,local?) == ['Declare,id,form,r] := dform - id = 'failed => id - KAR dform ~= 'Declare => systemError '"asytranDeclaration" - if levels = '(top) then + id is 'failed => id + KAR dform isnt 'Declare => systemError '"asytranDeclaration" + if levels is '(top) then if form isnt ['Apply,"->",:.] then HPUT($constantHash,id,true) - comments := LASSOC('documentation,r) or '"" + comments := symbolLassoc('documentation,r) or '"" idForm := levels is ['top,:.] => form is ['Apply,'_-_>,source,target] => [id,:asyArgs source] @@ -459,14 +459,14 @@ asytranDeclaration(dform,levels,predlist,local?) == 'domain 'domain first levels - typeCode := LASSOC('symeTypeCode,r) + typeCode := symbolLassoc('symeTypeCode,r) record := [idForm,newsig,asyMkpred predlist,key,true,comments,typeCode,:$asyFile] if not local? then ht := - levels = '(top) => $conHash + levels is '(top) => $conHash $docHashLocal HPUT(ht,id,[record,:HGET(ht,id)]) - if levels = '(top) then asyMakeOperationAlist(id,r, key) + if levels is '(top) then asyMakeOperationAlist(id,r, key) ['Declare,id,newsig,r] asyLooksLikeCatForm? x == @@ -476,13 +476,13 @@ asyLooksLikeCatForm? x == --asytranDeclaration(dform,levels,predlist,local?) == -- ['Declare,id,form,r] := dform --- id = 'failed => id +-- id is 'failed => id -- levels isnt ['top,:.] => asytranForm(form,[id,:levels],local?) -- idForm := -- form is ['Apply,'_-_>,source,target] => [id,:asyArgs source] -- id -- if form isnt ['Apply,"->",:.] then HPUT($constantHash,id,true) --- comments := LASSOC('documentation,r) or '"" +-- comments := symbolLassoc('documentation,r) or '"" -- newsig := asytranForm(form,[idForm,:levels],local?) -- key := -- id in '(%% Category Type) => 'constant @@ -493,10 +493,10 @@ asyLooksLikeCatForm? x == -- record := [newsig,asyMkpred predlist,key,true,comments,:$asyFile] -- if not local? then -- ht := --- levels = '(top) => $conHash +-- levels is '(top) => $conHash -- $docHashLocal -- HPUT(ht,id,[record,:HGET(ht,id)]) --- if levels = '(top) then asyMakeOperationAlist(id,r) +-- if levels is '(top) then asyMakeOperationAlist(id,r) -- ['Declare,id,newsig,r] asyIsCatForm form == @@ -541,13 +541,13 @@ asytranForm1(form,levels,local?) == form is ['Define,:.] => form is ['Define,['Declare,.,x,:.],rest] => --TTT i don't know about this one but looks ok - x = 'Category => asytranForm1(rest,levels, local?) + x is 'Category => asytranForm1(rest,levels, local?) asytranForm1(x,levels,local?) error '"DEFINE forms are not handled yet" - if form = '_% then $hasPerCent := true + if form is '_% then $hasPerCent := true IDENTP form => - form = "%" => "$" - GETL(form,"NILADIC") => [form] + form is "%" => "$" + form has NILADIC => [form] form [asytranForm(x,levels,local?) for x in form] @@ -562,7 +562,7 @@ asytranApply(['Apply,name,:arglist],levels,local?) == name is 'string => asytranLiteral first arglist name is 'integer => asytranLiteral first arglist name is 'float => asytranLiteral first arglist - name = 'Enumeration => + name is 'Enumeration => ["Enumeration",:[asytranEnumItem arg for arg in arglist]] [:argl,lastArg] := arglist [name,:[asytranFormSpecial(arg,levels,true) for arg in argl], @@ -691,9 +691,9 @@ asyCosigType u == u is [name,t] => t is [fn,:.] => asyComma? fn => fn - fn = 'With => 'T + fn is 'With => 'T nil - t = 'Type => 'T + t is 'Type => 'T error '"Unknown atomic type" error false @@ -798,7 +798,7 @@ asySig1(u,name?,target?) == name? and u is [name,t] => t u x is [fn,:r] => - fn = 'Join => asyTypeJoin r ---------> jump out to newer code 4/94 + fn is 'Join => asyTypeJoin r ---------> jump out to newer code 4/94 fn in '(RestrictTo PretendTo) => asySig(first r,name?) asyComma? fn => u := [asySig(x,name?) for x in r] @@ -808,20 +808,20 @@ asySig1(u,name?,target?) == -- in the interpreter ['Multi,:u] u - fn = 'With => asyCATEGORY r - fn = 'Third => + fn is 'With => asyCATEGORY r + fn is 'Third => r is [b] => b is ['With,:s] => asyCATEGORY s b is ['Blank,:.] => asyCATEGORY nil error x - fn = 'Apply and r is ['_-_>,:s] => asyMapping(s,name?) - fn = '_-_> => asyMapping(r,name?) - fn = 'Declare and r is [name,typ,:.] => + fn is 'Apply and r is ['_-_>,:s] => asyMapping(s,name?) + fn is '_-_> => asyMapping(r,name?) + fn is 'Declare and r is [name,typ,:.] => asySig1(typ, name?, target?) x is '(_%) => '(_$) [fn,:[asySig(x,name?) for x in r]] ---x = 'Type => $Type - x = '_% => '_$ +--x is 'Type => $Type + x is '_% => '_$ x -- old version was : @@ -846,19 +846,19 @@ asyMapping([a,b],name?) == --============================================================================ asyType x == x is [fn,:r] => - fn = 'Join => asyTypeJoin r + fn is 'Join => asyTypeJoin r fn in '(RestrictTo PretendTo) => asyType first r asyComma? fn => u := [asyType x for x in r] u - fn = 'With => asyCATEGORY r - fn = '_-_> => asyTypeMapping r - fn = 'Apply => r --- fn = 'Declare and r is [name,typ,:.] => typ + fn is 'With => asyCATEGORY r + fn is '_-_> => asyTypeMapping r + fn is 'Apply => r +-- fn is 'Declare and r is [name,typ,:.] => typ x is '(_%) => '(_$) x ---x = 'Type => $Type - x = '_% => '_$ +--x is 'Type => $Type + x is '_% => '_$ x asyTypeJoin r == @@ -914,20 +914,20 @@ asyTypeMapping([a,b]) == asyTypeUnit x == x is [fn,:r] => - fn = 'Join => systemError 'Join ----->asyTypeJoin r + fn is 'Join => systemError 'Join ----->asyTypeJoin r fn in '(RestrictTo PretendTo) => asyTypeUnit first r asyComma? fn => u := [asyTypeUnit x for x in r] u - fn = 'With => asyCATEGORY r - fn = '_-_> => asyTypeMapping r - fn = 'Apply => asyTypeUnitList r - fn = 'Declare and r is [name,typ,:.] => asyTypeUnitDeclare(name,typ) + fn is 'With => asyCATEGORY r + fn is '_-_> => asyTypeMapping r + fn is 'Apply => asyTypeUnitList r + fn is 'Declare and r is [name,typ,:.] => asyTypeUnitDeclare(name,typ) x is '(_%) => '(_$) [fn,:asyTypeUnitList r] GETL(x,"NILADIC") => [x] ---x = 'Type => $Type - x = '_% => '_$ +--x is 'Type => $Type + x is '_% => '_$ x asyTypeUnitList x == [asyTypeUnit y for y in x] @@ -1068,7 +1068,7 @@ asyUnTuple x == asyTypeItem x == atom x => - x = '_% => '_$ + x is '_% => '_$ x x is ['_-_>,a,b] => ['Mapping,b,:asyUnTuple a] @@ -1117,7 +1117,7 @@ asCategoryParts(kind,conform,category,:options) == main where $oplist := listSort(function GLESSEQP,$oplist) res := [$attrlist,:$oplist] if cons? then res := [listSort(function GLESSEQP,$conslist),:res] - if kind = 'category then + if kind is 'category then tvl := TAKE(#rest conform,$TriangleVariableList) res := SUBLISLIS($FormalMapVariableList,tvl,res) res @@ -1129,7 +1129,7 @@ asCategoryParts(kind,conform,category,:options) == main where constructor? opOf attr => $conslist := [[attr,:pred],:$conslist] nil - opOf attr = 'nothing => 'skip + opOf attr is 'nothing => 'skip $attrlist := [[opOf attr,IFCDR attr,:pred],:$attrlist] item is ['TYPE,op,type] => $oplist := [[op,[type],:pred],:$oplist] diff --git a/src/interp/ax.boot b/src/interp/ax.boot index 13c24611..1c56ab71 100644 --- a/src/interp/ax.boot +++ b/src/interp/ax.boot @@ -151,7 +151,7 @@ optcomma [op,:args] == [op,:args] axFormatDecl(sym, type) == - if sym = '$ then sym := '% + if sym is '$ then sym := '% opOf type in '(StreamAggregate FiniteLinearAggregate) => ['Declare, sym, 'Type] ['Declare, sym, axFormatType type] @@ -165,7 +165,7 @@ axFormatAttrib(typeform) == axFormatType(typeform) == atom typeform => - typeform = '$ => '% + typeform is '$ => '% string? typeform => ['Apply,'Enumeration, makeSymbol typeform] integer? typeform => @@ -185,8 +185,8 @@ axFormatType(typeform) == :[axFormatType a for a in args]], ['Apply, 'List, 'Symbol] ] typeform is [op] => - op = '$ => '% - op = 'Void => ['Comma] + op is '$ => '% + op is 'Void => ['Comma] op typeform is ['local, val] => axFormatType val typeform is ['QUOTE, val] => axFormatType val @@ -243,14 +243,14 @@ axFormatOpList ops == ['Sequence,:[axFormatOp o for o in ops]] axOpTran(name) == atom name => - name = 'elt => 'apply - name = 'setelt => 'set! - name = 'SEGMENT => ".." - name = 1 => '_1 - name = 0 => '_0 + name is 'elt => 'apply + name is 'setelt => 'set! + name is 'SEGMENT => ".." + name is 1 => '_1 + name is 0 => '_0 name - opOf name = 'Zero => '_0 - opOf name = 'One => '_1 + opOf name is 'Zero => '_0 + opOf name is 'One => '_1 error "bad op name" axFormatOpSig(name, [result,:argtypes]) == @@ -264,19 +264,19 @@ axFormatConstantOp(name, [result]) == axFormatPred pred == atom pred => pred [op,:args] := pred - op = 'IF => axFormatOp pred + op is 'IF => axFormatOp pred op = "has" => [name,type] := args - if name = '$ then name := '% + if name is '$ then name := '% else name := axFormatOp name ftype := axFormatOp type if ftype is ['Declare,:.] then ftype := ['With, [], ftype] ['Test,['Has,name, ftype]] axArglist := [axFormatPred arg for arg in args] - op = 'AND => ['And,:axArglist] - op = 'OR => ['Or,:axArglist] - op = 'NOT => ['Not,:axArglist] + op is 'AND => ['And,:axArglist] + op is 'OR => ['Or,:axArglist] + op is 'NOT => ['Not,:axArglist] error "unknown predicate" @@ -350,7 +350,7 @@ axFormatDefaultOpSig(op, sig, catops) == #sig > 1 => axFormatOpSig(op,sig) nsig := MSUBST('$,'($), sig) -- dcSig listifies '$ ?? (catsigs := LASSOC(op, catops)) and - (catsig := assoc(nsig, catsigs)) and last(catsig) = 'CONST => + (catsig := assoc(nsig, catsigs)) and last(catsig) is 'CONST => axFormatConstantOp(op, sig) axFormatOpSig(op,sig) diff --git a/src/interp/bc-matrix.boot b/src/interp/bc-matrix.boot index 033bf212..18b93120 100644 --- a/src/interp/bc-matrix.boot +++ b/src/interp/bc-matrix.boot @@ -141,10 +141,10 @@ bcMatrixGen htPage == nrows := htpProperty(htPage,'nrows) ncols := htpProperty(htPage,'ncols) mat := htpProperty(htPage,'matrix) - formula := LASSOC('formula,mat) => + formula := symbolLassoc('formula,mat) => formula := formula.0 - rowVar := (LASSOC('rowVar,mat)).0 - colVar := (LASSOC('colVar,mat)).0 + rowVar := (symbolLassoc('rowVar,mat)).0 + colVar := (symbolLAssoc('colVar,mat)).0 strconc('"matrix([[",formula,'" for ",colVar,'" in 1..", STRINGIMAGE ncols,'"] for ",rowVar,'" in 1..",STRINGIMAGE nrows,'"])") mat := htpProperty(htPage,'matrix) => diff --git a/src/interp/bc-misc.boot b/src/interp/bc-misc.boot index 1d0d89e1..5d140aac 100644 --- a/src/interp/bc-misc.boot +++ b/src/interp/bc-misc.boot @@ -109,11 +109,11 @@ bcDefiniteIntegrateGen htPage == integrand := htpLabelInputString(htPage,'integrand) var := htpLabelInputString(htPage,'symbol) lowerLimit := - htpButtonValue(htPage,'fromButton) = 'fromPoint => + htpButtonValue(htPage,'fromButton) is 'fromPoint => htpLabelInputString(htPage,'from) '"%minusInfinity" upperLimit := - htpButtonValue(htPage,'toButton) = 'toPoint => + htpButtonValue(htPage,'toButton) is 'toPoint => htpLabelInputString(htPage,'to) '"%plusInfinity" varpart := strconc(var,'" = ",lowerLimit,'"..",upperLimit) @@ -287,7 +287,7 @@ bcDraw2DfunGen htPage == from1 := htpLabelInputString(htPage,'from1) to1 := htpLabelInputString(htPage,'to1) title := htpLabelInputString(htPage,'title) - if (title ~= '"") then + if (title isnt '"") then titlePart := strconc('"{}",'"title ==_"",title,'"_"") bcFinish('"draw",fun,bcDrawIt2(ind,from1,to1),titlePart) else @@ -334,8 +334,8 @@ bcDraw2DparGen htPage == to1 := htpLabelInputString(htPage,'to1) title := htpLabelInputString(htPage,'title) curvePart := strconc('"curve(",'"{}",fun1,'",{}",fun2,'")") - if (title ~= '"") then - titlePart := (title = '"" => nil; strconc('"{}",'"title ==_"",title,'"_"")) + if (title isnt '"") then + titlePart := (title is '"" => nil; strconc('"{}",'"title ==_"",title,'"_"")) bcFinish('"draw",curvePart,bcDrawIt2(ind,from1,to1),titlePart) else bcFinish('"draw",curvePart,bcDrawIt2(ind,from1,to1)) @@ -384,8 +384,8 @@ bcDraw2DSolveGen htPage == to2 := htpLabelInputString(htPage,'to2) title := htpLabelInputString(htPage,'title) clipPart := strconc('"{}",'"range==[{}",from1,'"..",to1,",{}",from2,'"..",to2,'"]") - if (title ~= '"") then - titlePart := (title = '"" => nil; strconc('"{}",'"title ==_"",title,'"_"")) + if (title isnt '"") then + titlePart := (title is '"" => nil; strconc('"{}",'"title ==_"",title,'"_"")) bcFinish('"draw",strconc(fun,'" = 0 "),ind1,ind2,clipPart,titlePart) else bcFinish('"draw",strconc(fun,'" = 0 "),ind1,ind2,clipPart) diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index a7afc084..05a0b57c 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -768,7 +768,7 @@ conOpPage1(conform,:options) == htpSetProperty(page,'domname,domname) --> !!note!! <-- htpSetProperty(page,'conform,conform) htpSetProperty(page,'signature,signature) - if selectedOperation := LASSOC('selectedOperation,IFCDR options) then + if selectedOperation := symbolLAssoc('selectedOperation,IFCDR options) then htpSetProperty(page,'selectedOperation,selectedOperation) for [a,:b] in bindingsAlist repeat htpSetProperty(page,a,b) koPage(page,'"operation") @@ -1076,7 +1076,7 @@ dbShowConsDoc1(htPage,conform,indexOrNil) == --NOTE that we pass conform is as "origin" getConstructorDocumentation conname == - LASSOC('constructor,getConstructorDocumentationFromDB conname) + symbolLassoc('constructor,getConstructorDocumentationFromDB conname) is [[nil,line,:.],:.] and line or '"" dbSelectCon(htPage,which,index) == diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index e6a330b6..5df41701 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -115,7 +115,8 @@ buildLibdbConEntry conname == DOWNCASE stringChar(symbolName kind,0) argl := rest $conform conComments := - LASSOC('constructor,$doc) is [[=nil,:r]] => libdbTrim concatWithBlanks r + symbolLassoc('constructor,$doc) is [[=nil,:r]] => + libdbTrim concatWithBlanks r '"" argpart:= subString(form2HtString ['f,:argl],1) sigpart:= libConstructorSig $conform diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index c8dd0098..5b46256d 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -612,10 +612,10 @@ dbShowOpParameters(htPage,opAlist,which,data) == htSayExpose(ops,exposeFlag) n := #opform do - n = 2 and LASSOC('Nud,PROPLIST op) => + n = 2 and symbolLassoc('Nud,PROPLIST op) => dbShowOpParameterJump(ops,which,count,single?) htSay('" {\em ",KAR args,'"}") - n = 3 and LASSOC('Led,PROPLIST op) => + n = 3 and symbolLassoc('Led,PROPLIST op) => htSay('"{\em ",KAR args,'"} ") dbShowOpParameterJump(ops,which,count,single?) htSay('" {\em ",KAR KDR args,'"}") diff --git a/src/interp/br-prof.boot b/src/interp/br-prof.boot index b26f1b18..aa867a79 100644 --- a/src/interp/br-prof.boot +++ b/src/interp/br-prof.boot @@ -86,7 +86,7 @@ dbShowInfoOp(htPage,op,sig,alist) == SUBLISLIS(IFCDR conform,TAKE(#faTypes,$FormalMapVariableList),faTypes) conform := htpProperty(htPage,'conform) conname := opOf conform ---argTypes := reverse ASSOCRIGHT LASSOC('arguments,alist) +--argTypes := reverse ASSOCRIGHT symbolLassoc('arguments,alist) --sig := or/[sig for [sig,:.] in LASSOC(op,opAlist) | rest sig = argTypes] ops := escapeSpecialChars STRINGIMAGE zeroOneConvert op oppart := ['"{\em ", ops, '"}"] diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index 0b627a34..d2fb762c 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -1221,9 +1221,9 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, ops := escapeSpecialChars STRINGIMAGE op n := #sig do - n = 2 and LASSOC('Nud,PROPLIST op) => + n = 2 and symbolLassoc('Nud,PROPLIST op) => htSay(ops,'" {\em ",quickForm2HtString KAR args,'"}") - n = 3 and LASSOC('Led,PROPLIST op) => + n = 3 and symbolLassoc('Led,PROPLIST op) => htSay('"{\em ",quickForm2HtString KAR args,'"} ",ops,'" {\em ",quickForm2HtString KAR KDR args,'"}") if unexposed? and $includeUnexposed? then htSayUnexposed() @@ -1328,7 +1328,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, htSaySaturn '"{\em Where:}" htSayStandard('"\newline\tab{2}{\em Where:}") firstTime := true - if ASSOC("$",$whereList) then + if symbolAssoc("$",$whereList) then htSayIndentRel(15,true) htSaySaturnAmpersand() htSayStandard '"{\em \$} is " diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index bce8723a..e933bd4b 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -362,7 +362,7 @@ spadType(x) == --called by \spadtype{x} from HyperDoc looksLikeDomainForm x == entry := getCDTEntry(opOf x,true) or return false - coSig := LASSOC('coSig,CDDR entry) + coSig := symbolLassoc('coSig,CDDR entry) k := #coSig atom x => k = 1 k ~= #x => false @@ -758,7 +758,7 @@ dbSearchAbbrev([.,:conlist],kind,filter) == null conlist => emptySearchPage('"abbreviation",filter) kind := intern kind if kind ~= 'constructor then - conlist := [x for x in conlist | LASSOC('kind,IFCDR IFCDR x) = kind] + conlist := [x for x in conlist | symbolLassoc('kind,IFCDR IFCDR x) = kind] conlist is [[nam,:.]] => conPage DOWNCASE nam cAlist := [[con,:true] for con in conlist] htPage := htInitPage('"",nil) @@ -768,7 +768,7 @@ dbSearchAbbrev([.,:conlist],kind,filter) == page := htInitPage([#conlist, '" Abbreviations Match {\em ",STRINGIMAGE filter,'"}"],nil) for [nam,abbr,:r] in conlist repeat - kind := LASSOC('kind,r) + kind := symbolLAssoc('kind,r) htSay('"\newline{\em ",s := STRINGIMAGE abbr) htSayStandard '"\tab{10}" htSay '"}" diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index a9c89ca5..4d4322e7 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -64,7 +64,7 @@ $FirstParamSlot == lookupDisplay(op,sig,vectorOrForm,suffix) == not $NRTmonitorIfTrue => nil - prefix := (suffix = '"" => ">"; "<") + prefix := (suffix is '"" => ">"; "<") sayBrightly concat(prefix,formatOpSignature(op,sig), '" from ", prefix2String devaluateDeeply vectorOrForm,suffix) @@ -107,7 +107,7 @@ compareSig(sig,tableSig,dollar,domain) == for s in rest sig for t in rest tableSig] lazyCompareSigEqual(s,tslot,dollar,domain) == - tslot = '$ => s = "$" or s = devaluate dollar + tslot is '$ => s is "$" or s = devaluate dollar integer? tslot and cons?(lazyt:=domain.tslot) and cons? s => lazyt is [.,.,.,[.,item,.]] and item is [.,[functorName,:.]] and functorName = first s => @@ -126,7 +126,7 @@ compareSigEqual(s,t,dollar,domain) == rest(domain).(POSN1(t,$FormalMapVariableList)) string? t and IDENTP s => (s := symbolName s; t) nil - s = '$ => compareSigEqual(dollar,u,dollar,domain) + s is '$ => compareSigEqual(dollar,u,dollar,domain) u => compareSigEqual(s,u,dollar,domain) s = u s='$ => compareSigEqual(dollar,t,dollar,domain) @@ -283,7 +283,7 @@ lookupInTable(op,sig,dollar,[domain,table]) == lookupInAddChain(op,sig,domain,dollar) or 'failed lookupDisplay(op,sig,domain,'" !! found in NEW table!!") slot - success ~= 'failed and success => success + success isnt 'failed and success => success subsumptionSig and (u:= SPADCALL(op,subsumptionSig,dollar,domain.1)) => u someMatch => lookupInAddChain(op,sig,domain,dollar) nil diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 129161a2..40055cde 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -76,7 +76,7 @@ getDocForDomain(name,op,sig) == ++ `op' and given signature `sigPart'. The operator `op' is assumed ++ to have been defined in the domain or catagory `abb'. getOpDoc(abb,op,:sigPart) == - u := LASSOC(op,getConstructorDocumentationFromDB abb) + u := symbolLassoc(op,getConstructorDocumentationFromDB abb) $argList : local := $FormalMapVariableList _$: local := '_$ sigPart is [sig] => or/[d for [s,:d] in u | sig = s] @@ -137,7 +137,7 @@ finalizeDocumentation() == docList := substitute("$","%",transDocList($op,$docList)) if u := [sig for [sig,:doc] in docList | null doc] then for y in u repeat - y = 'constructor => noHeading := true + y is 'constructor => noHeading := true y is [x,b] and b is ['attribute,:r] => attributes := [[x,:r],:attributes] signatures := [y,:signatures] @@ -215,11 +215,11 @@ transDoc(conname,doclist) == $x: local := nil rlist := reverse doclist for [$x,:lines] in rlist repeat - $attribute? : local := $x is [.,[key]] and key = 'attribute + $attribute? : local := $x is [.,[key]] and key is 'attribute null lines => $attribute? => nil checkDocError1 ['"Not documented!!!!"] - u := checkTrim($x,(string? lines => [lines]; $x = 'constructor => first lines; lines)) + u := checkTrim($x,(string? lines => [lines]; $x is 'constructor => first lines; lines)) $argl : local := nil --set by checkGetArgs -- tpd: related domain information doesn't exist -- if v := checkExtract('"Related Domains:",u) then @@ -244,7 +244,7 @@ transDoc(conname,doclist) == -- n=0 and atom x => [x] -- x longline := - $x = 'constructor => + $x is 'constructor => v :=checkExtract('"Description:",u) or u and checkExtract('"Description:", [strconc('"Description: ",first u),:rest u]) @@ -409,7 +409,7 @@ checkGetParse s == ncParseFromString removeBackslashes s ++ remove non-leading backslash characters from string `s'. removeBackslashes s == - s = '"" => '"" + s is '"" => '"" (k := charPosition($charBack,s,0)) < #s => k = 0 => removeBackslashes subString(s,1) strconc(subString(s,0,k),removeBackslashes subString(s,k + 1)) @@ -458,25 +458,25 @@ checkGetStringBeforeRightBrace u == -- acc := nil -- while u repeat -- x := first u --- x = '"\begin" and checkTranVerbatimMiddle u is [middle,:r] => +-- x is '"\begin" and checkTranVerbatimMiddle u is [middle,:r] => -- acc := [$charRbrace,:middle,$charLbrace,'"\spadpaste",:acc] -- u := r --- if x = '"\spadcommand" then x := '"\spadpaste" +-- if x is '"\spadcommand" then x := '"\spadpaste" -- acc := [x,:acc] -- u := rest u -- nreverse acc -- -- checkTranVerbatimMiddle u == -- (y := IFCAR (v := IFCDR u)) = $charLbrace and --- (y := IFCAR (v := IFCDR v)) = '"verbatim" and +-- (y := IFCAR (v := IFCDR v)) is '"verbatim" and -- (y := IFCAR (v := IFCDR v)) = $charRbrace => -- w := IFCDR v -- middle := nil --- while w and (z := first w) ~= '"\end" repeat +-- while w and (z := first w) isnt '"\end" repeat -- middle := [z,:middle] -- w := rest w -- if (y := IFCAR (w := IFCDR w)) = $charLbrace and --- (y := IFCAR (w := IFCDR w)) = '"verbatim" and +-- (y := IFCAR (w := IFCDR w)) is '"verbatim" and -- (y := IFCAR (w := IFCDR w)) = $charRbrace then -- u := IFCDR w -- else @@ -488,20 +488,20 @@ checkGetStringBeforeRightBrace u == -- acc := nil -- while u repeat -- x := first u --- x = '"\begin" and (y := IFCAR (v := IFCDR u)) = $charLbrace and --- (y := IFCAR (v := IFCDR v)) = '"verbatim" and +-- x is '"\begin" and (y := IFCAR (v := IFCDR u)) = $charLbrace and +-- (y := IFCAR (v := IFCDR v)) is '"verbatim" and -- (y := IFCAR (v := IFCDR v)) = $charRbrace => -- w := IFCDR v -- middle := nil --- while w and (z := first w) ~= '"\end" repeat +-- while w and (z := first w) isnt '"\end" repeat -- middle := [z,:middle] -- w := rest w -- if (y := IFCAR (w := IFCDR w)) = $charLbrace and --- (y := IFCAR (w := IFCDR w)) = '"verbatim" and +-- (y := IFCAR (w := IFCDR w)) is '"verbatim" and -- (y := IFCAR (w := IFCDR w)) = $charRbrace then -- u := IFCDR w -- acc := [$charRbrace,:middle,$charLbrace,'"\spadpaste",:acc] --- if x = '"\spadcommand" then x := '"\spadpaste" +-- if x is '"\spadcommand" then x := '"\spadpaste" -- acc := [x,:acc] -- u := rest u -- nreverse acc @@ -566,7 +566,7 @@ checkComments(nameSig,lines) == main where main() == $checkErrorFlag: local := false margin := checkGetMargin lines - if null $attribute? and nameSig ~= 'constructor then + if null $attribute? and nameSig isnt 'constructor then lines := [checkTransformFirsts(first nameSig,first lines,margin),:rest lines] u := checkIndentedLines(lines, margin) @@ -607,10 +607,10 @@ checkIndentedLines(u, margin) == verbatim => u2 := [:u2, $charFauxNewline] u2 := [:u2, '"\blankline "] s := subString(x, k) - s = '"\begin{verbatim}" => + s is '"\begin{verbatim}" => verbatim := true u2 := [:u2, s] - s = '"\end{verbatim}" => + s is '"\end{verbatim}" => verbatim := false u2 := [:u2, s] verbatim => u2 := [:u2, subString(x, margin)] @@ -1039,7 +1039,7 @@ checkBeginEnd u == IDENTITY x := first u string? x and x.0 = $charBack and #x > 2 and not HGET($htMacroTable,x) - and not (x = '"\spadignore") and IFCAR IFCDR u = $charLbrace + and not (x is '"\spadignore") and IFCAR IFCDR u = $charLbrace and not (substring?('"\radiobox",x,0) or substring?('"\inputbox",x,0))=> --allow 0 argument guys to pass through @@ -1111,7 +1111,7 @@ checkLookForRightBrace(u) == --return line beginning with right brace checkInteger s == CHARP s => false - s = '"" => false + s is '"" => false and/[digit? stringChar(s,i) for i in 0..maxIndex s] checkTransformFirsts(opname,u,margin) == @@ -1296,7 +1296,7 @@ checkDecorateForHt u == while u repeat x := first u do - if x = '"\em" then + if x is '"\em" then if count > 0 then spadflag := count - 1 else checkDocError ['"\em must be enclosed in braces"] if x in '("\s" "\spadop" "\spadtype" "\spad" "\spadpaste" "\spadcommand" "\footnote") then spadflag := count @@ -1307,7 +1307,7 @@ checkDecorateForHt u == else if not spadflag and x in '("+" "*" "=" "==" "->") then if $checkingXmptex? then checkDocError ["Symbol ",x,'" appearing outside \spad{}"] - x = '"$" or x = '"%" => checkDocError ['"Unescaped ",x] + x is '"$" or x is '"%" => checkDocError ['"Unescaped ",x] -- not spadflag and string? x and (member(x,$argl) or #x = 1 -- and alphabetic? x.0) and not (x in '("a" "A")) => -- checkDocError1 ['"Naked ",x] diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 5b23299a..9aba4f1b 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -347,15 +347,15 @@ intersectionContour(c,c') == --3. property="mode" is covered by modeCompare prop="mode" => nil modeCompare(p,p') == - pair:= assoc("mode",p) => - pair':= assoc("mode",p') => + pair := symbolAssoc("mode",p) => + pair' := symbolAssoc("mode",p') => m'':= unifiable(rest pair,rest pair') => [["mode",:m'']] stackSemanticError(['"%b",$var,'"%d","has two modes: "],nil) --stackWarning ("mode for",'"%b",$var,'"%d","introduced conditionally") [["conditionalmode",:rest pair]] --LIST pair --stackWarning ("mode for",'"%b",$var,'"%d","introduced conditionally") - pair':= assoc("mode",p') => [["conditionalmode",:rest pair']] + pair' := symbolAssoc("mode",p') => [["conditionalmode",:rest pair']] --LIST pair' unifiable(m1,m2) == m1=m2 => m1 @@ -384,7 +384,7 @@ addContour(c,E is [cur,:tail]) == if p="conditionalmode" then pv.first := "mode" --check for conflicts with earlier mode - if vv:=LASSOC("mode",e) then + if vv := symbolLassoc("mode",e) then if v ~=vv then stackWarning('"The conditional modes %1p and %2p conflict", [v,vv]) @@ -509,7 +509,7 @@ prEnv E == for x in E for i in 1.. repeat for y in x for j in 1.. repeat SAY('"******CONTOUR ",j,'", LEVEL ",i,'":******") - for z in y | not LASSOC("modemap",rest z) repeat + for z in y | null symbolLassoc("modemap",rest z) repeat TERPRI() SAY("Properties Of: ",first z) for u in rest z repeat @@ -525,7 +525,7 @@ prModemaps E == for x in E for i in 1.. repeat for y in x for j in 1.. repeat for z in y | not member(first z,listOfOperatorsSeenSoFar) and - (modemap:= LASSOC("modemap",rest z)) repeat + (modemap := symbolLassoc("modemap",rest z)) repeat listOfOperatorsSeenSoFar:= [first z,:listOfOperatorsSeenSoFar] TERPRI() PRIN1 first z @@ -626,7 +626,7 @@ diagnoseUnknownType(t,e) == isConstantId(name,e) == IDENTP name => pl:= getProplist(name,e) => - (LASSOC("value",pl) or LASSOC("mode",pl) => false; true) + (symbolLassoc("value",pl) or symbolLassoc("mode",pl) => false; true) true false @@ -1003,7 +1003,7 @@ displayModemaps E == for x in E for i in 1.. repeat for y in x for j in 1.. repeat for z in y | not member(first z,listOfOperatorsSeenSoFar) and - (modemaps:= LASSOC("modemap",rest z)) repeat + (modemaps := symbolLassoc("modemap",rest z)) repeat listOfOperatorsSeenSoFar:= [first z,:listOfOperatorsSeenSoFar] displayOpModemaps(first z,modemaps) @@ -1094,7 +1094,7 @@ $middleEndMacroList == --middleEndExpand: %Form -> %Code middleEndExpand x == - x = '%false or x = '%nil => 'NIL + x is '%false or x is '%nil => 'NIL IDENTP x and (x' := x has %Rename) => x' atomic? x => x [op,:args] := x @@ -1476,7 +1476,7 @@ massageBackendCode x == if (u := first x) = "MAKEPROP" and $TRACELETFLAG then x.first := "MAKEPROP-SAY" u in '(DCQ RELET PRELET SPADLET SETQ %LET) => - if u ~= 'DCQ and u ~= 'SETQ then + if u isnt 'DCQ and u isnt 'SETQ then nconc(x,$FUNNAME__TAIL) x.first := "LETT" massageBackendCode CDDR x @@ -1489,7 +1489,7 @@ massageBackendCode x == -- Even if user used Lisp-level instructions to assign to -- this variable, we still want to note that it is a Lisp-level -- special variable. - u = 'SETQ and isLispSpecialVariable second x => + u is 'SETQ and isLispSpecialVariable second x => noteSpecialVariable second x IDENTP u and GET(u,"ILAM") ~= nil => x.first := eval u @@ -1557,7 +1557,7 @@ simplifySEQ form == needsPROG? form == atomic? form => false op := form.op - op = 'RETURN => true + op is 'RETURN => true op in '(LOOP PROG) => false form is ['BLOCK,=nil,:.] => false or/[needsPROG? x for x in form] diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index 31671f2e..08d0b181 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -96,21 +96,22 @@ simpHasPred(pred,:options) == main where simp pred == pred is [op,:r] => op = "has" => simpHas(pred,first r,second r) - op = 'HasCategory => simp ["has",first r,simpDevaluate second r] - op = 'HasSignature => + op is 'HasCategory => simp ["has",first r,simpDevaluate second r] + op is 'HasSignature => [op,sig] := simpDevaluate second r ["has",first r,['SIGNATURE,op,sig]] - op = 'HasAttribute => + op is 'HasAttribute => form := ["has",a := first r,['ATTRIBUTE,b := simpDevaluate second r]] simpHasAttribute(form,a,b) op in '(AND OR NOT) => null (u := MKPF([simp p for p in r],op)) => nil - u = '%true or u is '(QUOTE T) => true + u is '%true or u is '(QUOTE T) => true simpBool u - op = 'hasArgs => ($hasArgs => $hasArgs = r; pred) + op is 'hasArgs => ($hasArgs => $hasArgs = r; pred) null r and opOf op = "has" => simp first pred - pred = '%true or pred is '(QUOTE T) => true - op1 := LASSOC(op,'((and . AND)(or . OR)(not . NOT))) => simp [op1,:r] + pred is '%true or pred is '(QUOTE T) => true + op1 := symbolLassoc(op,'((and . AND)(or . OR)(not . NOT))) => + simp [op1,:r] simp first pred --REMOVE THIS HACK !!!! pred in '(T etc) => pred null pred => nil @@ -134,7 +135,7 @@ simpHasSignature(pred,conform,op,sig) == --eval w/o loading IDENTP conform => pred [conname,:args] := conform n := #sig - u := LASSOC(op,getConstructorOperationsFromDB conname) + u := symbolLassoc(op,getConstructorOperationsFromDB conname) candidates := [x for (x := [sig1,:.]) in u | #sig1 = #sig] or return false match := or/[x for (x := [sig1,:.]) in candidates | sig = sublisFormal(args,sig1)] or return false @@ -168,9 +169,9 @@ simpCatHasAttribute(domform,attr) == hasIdent pred == pred is [op,:r] => - op = 'QUOTE => false + op is 'QUOTE => false or/[hasIdent x for x in r] - pred = '_$ => false + pred is '_$ => false IDENTP pred => true false @@ -232,7 +233,7 @@ encodeUnion(id,new:=[a,:b],alist) == [new,:alist] moreGeneralCategoryPredicate(id,new,old) == - old = 'T or new = 'T => 'T + old is 'T or new is 'T => 'T old is ["has",a,b] and new is ["has",=a,c] => tempExtendsCat(b,c) => new tempExtendsCat(c,b) => old @@ -285,7 +286,7 @@ mkCategoryExtensionAlist cform == for [cat,:pred] in catlist repeat newList := getCategoryExtensionAlist0 cat finalList := - pred = 'T => newList + pred is 'T => newList [[a,:quickAnd(b,pred)] for [a,:b] in newList] extendsList:= catPairUnion(extendsList,finalList,cop,cat) extendsList @@ -301,7 +302,7 @@ mkCategoryExtensionAlistBasic cform == for [cat,pred,:.] in category.4.1 repeat newList := getCategoryExtensionAlist0 cat finalList := - pred = 'T => newList + pred is 'T => newList [[a,:quickAnd(b,pred)] for [a,:b] in newList] extendsList:= catPairUnion(extendsList,finalList,cop,cat) extendsList @@ -392,7 +393,7 @@ categoryParts(conform,category,:options) == main where constructor? opOf attr => $conslist := [[attr,:pred],:$conslist] nil - opOf attr = 'nothing => 'skip + opOf attr is 'nothing => 'skip $attrlist := [[opOf attr,IFCDR attr,:pred],:$attrlist] item is ['TYPE,op,type] => $oplist := [[op,[type],:pred],:$oplist] @@ -455,12 +456,12 @@ squeeze1(l) == updateCategoryTable(cname,kind) == $updateCatTableIfTrue => - kind = 'package => nil - kind = 'category => updateCategoryTableForCategory(cname) + kind is 'package => nil + kind is 'category => updateCategoryTableForCategory(cname) updateCategoryTableForDomain(cname,getConstrCat( getConstructorCategoryFromDB cname)) --+ - kind = 'domain => + kind is 'domain => updateCategoryTableForDomain(cname,getConstrCat( getConstructorCategoryFromDB cname)) diff --git a/src/interp/compat.boot b/src/interp/compat.boot index 712037f4..964d2dab 100644 --- a/src/interp/compat.boot +++ b/src/interp/compat.boot @@ -52,7 +52,7 @@ rwrite(key,val,stream) == system() == -- VM version of system command string := getSystemCommandLine() - if string = '"" then string := '"sh" + if string is '"" then string := '"sh" sayMessage ['" Return Code = ", runCommand string] terminateSystemCommand() diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index e792c690..ff7f5787 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1046,7 +1046,7 @@ replaceExitEtc(x,tag,opFlag,opMode) == --bound in compSeq1 and compDefineCapsuleFunction $finalEnv => intersectionEnvironment($finalEnv,t.env) t.env - if opFlag = 'TAGGEDreturn then + if opFlag is 'TAGGEDreturn then x.op := '%return else x.op := "THROW" @@ -1399,7 +1399,7 @@ checkExternalEntity(id,type,lang,e) == get(id,"modemap",e) => stackAndThrow('"%1b already names exported operations in scope",[id]) -- We don't type check builtin declarations at the moment. - lang = 'Builtin or lang = 'Lisp => id + lang is 'Builtin or lang is 'Lisp => id -- Only functions are accepted at the moment. And all mentioned -- types must be those that are supported by the FFI. type' := checkExternalEntityType(type,e) diff --git a/src/interp/database.boot b/src/interp/database.boot index 680d7334..ef523a1f 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -405,7 +405,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 ~= 'isFreeFunction and atom c => [a,b,[c]] + x is [a,b,c] and a isnt 'isFreeFunction and atom c => [a,b,[c]] x --pp pred [mmpat, patternAlist, partial, patvars] := @@ -683,7 +683,7 @@ getOplistForConstructorForm (form := [op,:argl]) == getOplistWithUniqueSignatures(op,pairlis,signatureAlist) == alist:= nil - for [sig,:[slotNumber,pred,kind]] in signatureAlist | kind ~= 'Subsumed repeat + for [sig,:[slotNumber,pred,kind]] in signatureAlist | kind isnt 'Subsumed repeat alist:= insertAlist(SUBLIS(pairlis,[op,sig]), SUBLIS(pairlis,[pred,[kind,nil,slotNumber]]), alist) diff --git a/src/interp/define.boot b/src/interp/define.boot index eb9ab532..c0784042 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -194,7 +194,7 @@ makeCompactDirect1(op,items) == predCode = -1 => return nil --> drop items with NIL slots if lookup function is incomplete if null slot then - $lookupFunction = 'lookupIncomplete => return nil + $lookupFunction is 'lookupIncomplete => return nil slot := 1 --signals that operation is not present n := #sig - 1 $byteAddress := $byteAddress + n + 4 @@ -290,8 +290,8 @@ NRTgetLookupFunction(domform,exCategory,addForm) == getExportCategory form == [op,:argl] := form - op = 'Record => ['RecordCategory,:argl] - op = 'Union => ['UnionCategory,:argl] + op is 'Record => ['RecordCategory,:argl] + op is 'Union => ['UnionCategory,:argl] functorModemap := getConstructorModemapFromDB op [[.,target,:tl],:.] := functorModemap EQSUBSTLIST(argl,$FormalMapVariableList,target) @@ -376,7 +376,7 @@ expandType(lazyt,template,domform) == [functorName,:[expandTypeArgs(a,template,domform) for a in argl]] expandTypeArgs(u,template,domform) == - u = '$ => u --template.0 -------eliminate this as $ is rep by 0 + u is '$ => u --template.0 -------eliminate this as $ is rep by 0 integer? u => expandType(templateVal(template, domform, u), template,domform) u is ['NRTEVAL,y] => y --eval y u is ['QUOTE,y] => y @@ -578,7 +578,7 @@ compDefine1(form,m,e) == compDefineAddSignature([op,:argl],signature,e) == (sig:= hasFullSignature(argl,signature,e)) and - not assoc(['$,:sig],LASSOC('modemap,getProplist(op,e))) => + null assoc(['$,:sig],symbolLassoc('modemap,getProplist(op,e))) => declForm:= [":",[op,:[[":",x,m] for x in argl for m in sig.source]],signature.target] [.,.,e]:= comp(declForm,$EmptyMode,e) diff --git a/src/interp/format.boot b/src/interp/format.boot index fd0763e2..722d8c8a 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -722,7 +722,7 @@ pred2English x == concat(pred2English a,'": ",form2String abbreviate b) x is [op,a,b] and op in '(isDomain domainEqual) => concat(pred2English a,'" = ",form2String abbreviate b) - x is [op,:.] and (translation := LASSOC(op,'( + x is [op,:.] and (translation := symbolLassoc(op,'( (_< . " < ") (_<_= . " <= ") (_> . " > ") (_>_= . " >= ") (_= . " = ") (_~_= . " _~_= ")))) => concat(pred2English a,translation,pred2English b) diff --git a/src/interp/g-timer.boot b/src/interp/g-timer.boot index 2877c4b7..26221309 100644 --- a/src/interp/g-timer.boot +++ b/src/interp/g-timer.boot @@ -78,7 +78,7 @@ makeLongStatStringByProperty _ if otherStatTotal > 0 then str := makeStatString(str,normalizeStatAndStringify otherStatTotal,'O,flag) total := total + otherStatTotal - cl := first LASSOC('other,listofnames) + cl := first symbolLassoc('other,listofnames) cl := first LASSOC(cl,listofclasses) PUT(cl,classprop, otherStatTotal + GETL(cl,classprop)) if flag ~= 'long then diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index ba63390b..88a4b6cf 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -232,7 +232,7 @@ get1(x,prop,e) == --this is the old get cons? x => get(x.op,prop,e) prop="modemap" and $insideCapsuleFunctionIfTrue=true => - LASSOC("modemap",getProplist(x,$CapsuleModemapFrame)) + symbolLassoc("modemap",getProplist(x,$CapsuleModemapFrame)) or get2(x,prop) LASSOC(prop,getProplist(x,e)) or get2(x,prop) @@ -719,9 +719,10 @@ augProplistOf(var,prop,val,e) == semchkProplist(x,proplist,prop,val) == prop="isLiteral" => - LASSOC("value",proplist) or LASSOC("mode",proplist) => warnLiteral x + symbolLassoc("value",proplist) or symbolLassoc("mode",proplist) => + warnLiteral x prop in '(mode value) => - LASSOC("isLiteral",proplist) => warnLiteral x + symbolLassoc("isLiteral",proplist) => warnLiteral x addBinding(var,proplist,e is [[curContour,:tailContour],:tailEnv]) == sameObject?(proplist,getProplist(var,e)) => e diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot index 641fedd7..7d5e5588 100644 --- a/src/interp/ht-util.boot +++ b/src/interp/ht-util.boot @@ -269,7 +269,7 @@ bcSadFaces() == htLispLinks(links,:option) == [links,options] := beforeAfter('options,links) - indent := LASSOC('indent,options) or 5 + indent := symbolLAssoc('indent,options) or 5 iht '"\newline\indent{" iht stringize indent iht '"}\beginitems" diff --git a/src/interp/htsetvar.boot b/src/interp/htsetvar.boot index 614b24a5..8c1af47e 100644 --- a/src/interp/htsetvar.boot +++ b/src/interp/htsetvar.boot @@ -430,7 +430,7 @@ htCacheSet htPage == num := chkAllNonNegativeInteger htpLabelInputString(htPage,htMakeLabel('"c",i)) $cacheAlist := ADDASSOC(makeSymbol name,num,$cacheAlist) - if (n := LASSOC('all,$cacheAlist)) then + if (n := symbolLAssoc('all,$cacheAlist)) then $cacheCount := n $cacheAlist := deleteAssoc('all,$cacheAlist) htInitPage('"Cache Summary",nil) diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 584eeac3..f295d9e9 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -2732,7 +2732,7 @@ undoSingleStep(changes,env) == -- pp '"----Undoing 1 step--------" -- pp changes for (change := [name,:changeList]) in changes repeat - if LASSOC('localModemap,changeList) then + if symbolLassoc('localModemap,changeList) then changeList := undoLocalModemapHack changeList pairlist := ASSQ(name,env) => proplist := rest pairlist => diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 67378673..e2b84477 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -51,7 +51,7 @@ NRTgenInitialAttributeAlist attributeList == alist := [x for x in attributeList | -- throw out constructors not symbolMember?(opOf first x,allConstructors())] $lisplibAttributes := simplifyAttributeAlist - [[a,:b] for [a,b] in SUBLIS($pairlis,alist) | a ~= 'nothing] + [[a,:b] for [a,b] in SUBLIS($pairlis,alist) | a isnt 'nothing] simplifyAttributeAlist al == al is [[a,:b],:r] => @@ -70,7 +70,7 @@ predicateBitIndex x == pn(x,false) where pn(x,flag) == u := simpBool transHasCode x - u = 'T => 0 + u is 'T => 0 u = nil => -1 p := POSN1(u,$NRTslot1PredicateList) => p + 1 not flag => pn(predicateBitIndexRemop x,true) @@ -84,12 +84,12 @@ predicateBitIndexRemop p== p predicateBitRef x == - x = 'T => 'T + x is 'T => 'T ['testBitVector,'pv_$,predicateBitIndex x] makePrefixForm(u,op) == u := MKPF(u,op) - u = ''T => 'T + u is ''T => 'T u --======================================================================= @@ -128,7 +128,7 @@ isHasDollarPred pred == pred is [op,:r] => op in '(AND and %and OR or %or NOT not %not) => or/[isHasDollarPred x for x in r] - op in '(HasCategory HasAttribute) => first r = '$ + op in '(HasCategory HasAttribute) => first r is '$ false stripOutNonDollarPreds pred == @@ -301,7 +301,7 @@ findModule cname == loadLibIfNotLoaded libName == -- replaces old SpadCondLoad -- loads is library is not already loaded - $PrintOnly = 'T => NIL + $PrintOnly => NIL GETL(libName,'LOADED) => NIL loadLib libName @@ -360,14 +360,14 @@ loadIfNecessary u == loadLibIfNecessary(u,true) loadIfNecessaryAndExists u == loadLibIfNecessary(u,nil) loadLibIfNecessary(u,mustExist) == - u = '$EmptyMode => u + u is '$EmptyMode => u cons? u => loadLibIfNecessary(first u,mustExist) value:= functionp(u) or macrop(u) => u GETL(u,'LOADED) => u loadLib u => u null $InteractiveMode and ((null (y:= getProplist(u,$CategoryFrame))) - or (null LASSOC('isFunctor,y)) and (null LASSOC('isCategory,y))) => + or (null symbolLassoc('isFunctor,y)) and (null symbolLAssoc('isCategory,y))) => y:= getConstructorKindFromDB u => y = "category" => updateCategoryFrameForCategory u @@ -419,7 +419,7 @@ systemDependentMkAutoload(fn,cnam) == cosig := getDualSignatureFromDB cnam file := getConstructorModuleFromDB cnam SET_-LIB_-FILE_-GETTER(file, cnam) - kind = 'category => + kind is 'category => ASHARPMKAUTOLOADCATEGORY(file, cnam, asharpName, cosig) ASHARPMKAUTOLOADFUNCTOR(file, cnam, asharpName, cosig) symbolFunction(cnam) := mkAutoLoad(fn, cnam) @@ -562,7 +562,7 @@ initializeLisplib libName == resetErrorCount() $libFile := writeLib1(libName,'ERRORLIB,$libraryDirectory) ADDOPTIONS('FILE,$libFile) - if pathnameTypeId(_/EDITFILE) = 'SPAD + if pathnameTypeId(_/EDITFILE) is 'SPAD then LAM_,FILEACTQ('VERSION,['_/VERSIONCHECK,_/MAJOR_-VERSION]) ++ If compilation produces an error, issue inform user and @@ -692,10 +692,10 @@ transformOperationAlist operationAlist == kind:= implementation is [eltEtc,.,n] and eltEtc in '(CONST ELT) => eltEtc implementation is [impOp,:.] => - impOp = 'XLAM => implementation + impOp is 'XLAM => implementation impOp in '(CONST Subsumed) => impOp keyedSystemError("S2IL0025",[impOp]) - implementation = 'mkRecord => 'mkRecord + implementation is 'mkRecord => 'mkRecord keyedSystemError("S2IL0025",[implementation]) signatureItem:= if u:= assoc([op,sig],$functionLocations) then n := [n,:rest u] @@ -830,7 +830,7 @@ getAllAldorObjectFiles dir == -- only sensical .asy files. dupAOs := MAPCAN(function PATHNAME_-NAME,asys) [asys,[f for f in asos - | PATHNAME_-NAME f = '"ao" and not member(PATHNAME_-NAME f,dupAOs)]] + | PATHNAME_-NAME f is '"ao" and not member(PATHNAME_-NAME f,dupAOs)]] @@ -869,7 +869,7 @@ compDefineExports(form,ops,sig,e) == fixupSigloc entry where fixupSigloc entry == [opsig,pred,funsel] := entry - if pred ~= 'T then + if pred isnt 'T then entry.rest.first := simpBool pred funsel is [op,a,:.] and op in '(ELT CONST) => entry.rest.rest.first := [op,a,nil] diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index 6abd17c2..e338027a 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -165,7 +165,7 @@ addModemap1(op,mc,sig,pred,fn,e) == if mc="Rep" then sig := substituteDollarIfRepHack sig currentProplist:= getProplist(op,e) or nil newModemapList:= - mkNewModemapList(mc,sig,pred,fn,LASSOC('modemap,currentProplist),e,nil) + mkNewModemapList(mc,sig,pred,fn,symbolLassoc('modemap,currentProplist),e,nil) newProplist:= augProplist(currentProplist,'modemap,newModemapList) newProplist':= augProplist(newProplist,"FLUID",true) unErrorRef op diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index ab55f37d..f2eec13e 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -102,9 +102,9 @@ deltaTran(item,compItem) == -- NOTE: sig is already in encoded form since it comes from $NRTdeltaList; -- so we need only encode dc. -- gdr 2008-11-28. dcCode := - dc = '$ => 0 + dc is '$ => 0 NRTassocIndex dc or keyedSystemError("S2NR0004",[dc]) - kindFlag:= (kind = 'CONST => 'CONST; nil) + kindFlag:= (kind is 'CONST => 'CONST; nil) [sig,dcCode,op,:kindFlag] NRTreplaceAllLocalReferences(form) == @@ -140,13 +140,13 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) == --------------FUNCTIONS CALLED DURING CAPSULE FUNCTION COMPILATION------------- listOfBoundVars form == -- Only called from the function genDeltaEntry below - form = '$ => [] + form is '$ => [] IDENTP form and (u:=get(form,'value,$e)) => u:=u.expr KAR u in '(Union Record) => listOfBoundVars u [form] atom form => [] - first form = 'QUOTE => [] + first form is 'QUOTE => [] -- We don't want to pick up the tag, only the domain first form = ":" => listOfBoundVars third form first form = "Enumeration" => [] @@ -165,7 +165,7 @@ optDeltaEntry(op,sig,dc,eltOrConst) == $killOptimizeIfTrue = true => nil -- references to modemaps from current domain are folded in a later -- stage of the compilation process. - dc = '$ => nil + dc is '$ => nil ndc := atom dc and (dcval := get(dc,'value,$e)) => dcval.expr dc @@ -198,8 +198,8 @@ genDeltaEntry(opMmPair,e) == --$NRTdeltaLength=0.. always equals length of $NRTdeltaList [op,[dc,:sig],[.,cform:=[eltOrConst,.,nsig]]] := opMmPair if $profileCompiler = true then profileRecord(dc,op,sig) - eltOrConst = 'XLAM => cform - if eltOrConst = 'Subsumed then eltOrConst := 'ELT + eltOrConst is 'XLAM => cform + if eltOrConst is 'Subsumed then eltOrConst := 'ELT if atom dc then dc = "$" => nsig := sig if integer? nsig then nsig := MSUBST("$",dc,substitute("$$","$",sig)) @@ -311,7 +311,7 @@ NRTaddInner x == NRTinnerGetLocalIndex y x is ['SubDomain,y,:.] => NRTinnerGetLocalIndex y getConstructorSignature first x is [.,:ml] => - for y in rest x for m in ml | not (y = '$) repeat + for y in rest x for m in ml | y isnt '$ repeat isCategoryForm(m,$CategoryFrame) => NRTinnerGetLocalIndex y x is ["Enumeration",:.] => for y in rest x repeat NRTinnerGetLocalIndex y @@ -331,14 +331,14 @@ consSig(sig,dc) == [consDomainName(sigpart,dc) for sigpart in sig] consDomainName(x,dc) == x = dc => ''$ - x = '$ => ''$ - x = "$$" => ['devaluate,'$] + x is '$ => ''$ + x is "$$" => ['devaluate,'$] x is [op,:argl] => - (op = 'Record) or (op = 'Union and argl is [[":",:.],:.]) => + (op is 'Record) or (op is 'Union and argl is [[":",:.],:.]) => mkList [MKQ op, :[['%list,MKQ '_:,MKQ tag,consDomainName(dom,dc)] for [.,tag,dom] in argl]] - isFunctor op or op = 'Mapping or constructor? op => + isFunctor op or op is 'Mapping or constructor? op => -- call to constructor? needed if op was compiled in $bootStrapMode mkList [MKQ op,:[consDomainName(y,dc) for y in argl]] substitute('$,"$$",x) @@ -352,7 +352,7 @@ consDomainName(x,dc) == MKQ x consDomainForm(x,dc) == - x = '$ => '$ + x is '$ => '$ x is [op,:argl] => op = ":" and argl is [tag, value] => [op, tag, consDomainForm(value,dc)] [op,:[consDomainForm(y,dc) for y in argl]] @@ -373,7 +373,7 @@ NRTdescendCodeTran(u,condList) == u.first := '%list u.rest := nil $template.i := - fn = 'IDENTITY => a + fn is 'IDENTITY => a fn is ['dispatchFunction,fn'] => fn' fn nil --code for this will be generated by the instantiator @@ -411,7 +411,7 @@ stuffSlot(dollar,i,item) == atom item => [symbolFunction item,:dollar] item is [n,:op] and integer? n => ['newGoGet,dollar,:item] item is ['CONS,.,['FUNCALL,a,b]] => - b = '$ => ['makeSpadConstant,eval a,dollar,i] + b is '$ => ['makeSpadConstant,eval a,dollar,i] sayBrightlyNT '"Unexpected constant environment!!" pp devaluate b nil @@ -422,7 +422,7 @@ stuffDomainSlots dollar == infovec := GETL(opOf domname,'infovec) lookupFunction := getLookupFun infovec lookupFunction := - lookupFunction = 'lookupIncomplete => function lookupIncomplete + lookupFunction is 'lookupIncomplete => function lookupIncomplete function lookupComplete template := infovec.0 if vectorRef(template,5) then @@ -610,7 +610,7 @@ reverseCondlist cl == alist NRTsetVector4a(sig,form,cond) == - sig = '$ => + sig is '$ => domainList := [simplifyVMForm COPY comp(d,$EmptyMode,$e).expr or d for d in $domainShell.4.0] @@ -658,7 +658,7 @@ NRToptimizeHas u == $hasCategoryAlist := [[u,:(y:=gensym())],:$hasCategoryAlist] y a="has" => NRToptimizeHas ['HasCategory,first b,MKQ second b] - a = 'QUOTE => u + a is 'QUOTE => u [NRToptimizeHas a,:NRToptimizeHas b] u @@ -675,10 +675,10 @@ changeDirectoryInSlot1() == --called by buildFunctor -- $NRTdeltaList = nil ===> all slot numbers become nil $lisplibOperationAlist := [sigloc entry for entry in $domainShell.1] where sigloc [opsig,pred,fnsel] == - if pred ~= 'T then + if pred isnt 'T then pred := simpBool pred $NRTslot1PredicateList := insert(pred,$NRTslot1PredicateList) - fnsel is [op,a,:.] and (op = 'ELT or op = 'CONST) => + fnsel is [op,a,:.] and (op is 'ELT or op is 'CONST) => if $insideCategoryPackageIfTrue then opsig := substitute('$,second($functorForm),opsig) [opsig,pred,[op,a,vectorLocation(first opsig,second opsig)]] diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 36aa4372..19d7a4df 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -221,18 +221,18 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == nil slot := vectorRef(domain,loc) cons? slot => - slot.op = 'newGoGet => someMatch:=true + slot.op is 'newGoGet => someMatch:=true --treat as if operation were not there --if sameObject?(QCAR slot,'newGoGet) then -- UNWIND_-PROTECT --break infinite recursion -- ((SETELT(domain,loc,'skip); slot := replaceGoGetSlot rest slot), - -- if domain.loc = 'skip then domain.loc := slot) + -- if domain.loc is 'skip then domain.loc := slot) return (success := slot) - slot = 'skip => --recursive call from above 'replaceGoGetSlot + slot is 'skip => --recursive call from above 'replaceGoGetSlot return (success := newLookupInAddChain(op,sig,domain,dollar)) systemError '"unexpected format" start := QSPLUS(start,QSPLUS(numTableArgs,4)) - success ~= 'failed and success => + success isnt 'failed and success => if $monitorNewWorld then sayLooking1('"<----",uu) where uu() == cons? success => [first success,:devaluate rest success] @@ -316,7 +316,7 @@ newLookupInCategories(op,sig,dom,dollar) == valueList := [MKQ val for val in valueList] nsig := MSUBST(dom.0,dollar.0,sig) for i in 0..maxIndex packageVec | - (entry := vectorRef(packageVec,i)) and entry ~= 'T repeat + (entry := vectorRef(packageVec,i)) and entry isnt 'T repeat package := vector? entry => if $monitorNewWorld then @@ -665,7 +665,7 @@ resolveNiladicConstructors form == newHasTest(domform,catOrAtt) == domform is [dom,:.] and dom in '(Union Record Mapping Enumeration) => ofCategory(domform, catOrAtt) - catOrAtt = '(Type) => true + catOrAtt is '(Type) => true asharpConstructorFromDB opOf domform => fn(domform,catOrAtt) where -- atom (infovec := getInfovec opOf domform) => fn(domform,catOrAtt) where fn(a,b) == @@ -674,11 +674,11 @@ newHasTest(domform,catOrAtt) == b is ["SIGNATURE",:opSig] => HasSignature(evalDomain a,opSig) b is ["ATTRIBUTE",attr] => HasAttribute(evalDomain a,attr) - hasCaty(a,b,NIL) ~= 'failed + hasCaty(a,b,NIL) isnt 'failed HasCategory(evalDomain a,b) => true -- for asharp domains: must return Boolean op := opOf catOrAtt isAtom := atom catOrAtt - not isAtom and op = 'Join => + 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' --getConstructorKindFromDB opOf domform = "category" => throwKeyedMsg("S2IS0025",NIL) diff --git a/src/interp/profile.boot b/src/interp/profile.boot index 2998c438..7c1a8a9b 100644 --- a/src/interp/profile.boot +++ b/src/interp/profile.boot @@ -73,19 +73,19 @@ profileRecord(label,name,info) == --name: info is var: type or op: sig $profileAlist profileDisplay() == - profileDisplayOp('constructor,LASSOC('constructor,$profileAlist) ) + profileDisplayOp('constructor,symbolLassoc('constructor,$profileAlist) ) for [op,:alist1] in $profileAlist | op ~= 'constructor repeat profileDisplayOp(op,alist1) profileDisplayOp(op,alist1) == sayBrightly op - if LASSOC('arguments,alist1) then + if symbolLassoc('arguments,alist1) then sayBrightly '" arguments" - for [x,:t] in MSORT LASSOC('arguments,alist1) repeat + for [x,:t] in MSORT symbolLAssoc('arguments,alist1) repeat sayBrightly concat('" ",x,": ",prefix2String t) - if LASSOC('locals,alist1) then + if symbolLassoc('locals,alist1) then sayBrightly '" locals" - for [x,:t] in MSORT LASSOC('locals,alist1) repeat + for [x,:t] in MSORT symbolLassoc('locals,alist1) repeat sayBrightly concat('" ",x,": ",prefix2String t) for [con,:alist2] in alist1 | not (con in '(locals arguments)) repeat sayBrightly concat('" ",prefix2String con) diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index fb967599..d047296e 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -374,3 +374,20 @@ subString(s,f,n == nil) == quoteForm t == ["QUOTE",t] + +--% assoc + +symbolAssoc(s,l) == + or/[symbolEq?(s,first x) and leave x for x in l | cons? x] or nil + +scalarAssoc(c,l) == + or/[scalarEq?(c,first x) and leave x for x in l | cons? x] or nil + +stringAssoc(s,l) == + or/[stringEq?(s,first x) and leave x for x in l | cons? x] or nil + +--% lassoc + +symbolLassoc(s,l) == + p := symbolAssoc(s,l) => rest p + nil diff --git a/src/interp/trace.boot b/src/interp/trace.boot index 24c59122..9f4ebaf0 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -138,8 +138,8 @@ trace1 l == ADDASSOC(x,$options,$optionAlist) optionList:= getTraceOptions $options argument:= - domainList:= LASSOC("of",optionList) => - LASSOC("ops",optionList) => + domainList := symbolLassoc("of",optionList) => + symbolLAssoc("ops",optionList) => throwKeyedMsg("S2IT0004",NIL) opList:= traceList => [["ops",:traceList]] @@ -586,7 +586,7 @@ mapLetPrint(x,val,currentFunction) == letPrint(x,val,currentFunction) == if $letAssoc and - ((y:= LASSOC(currentFunction,$letAssoc)) or (y:= LASSOC("all",$letAssoc))) then + ((y:= LASSOC(currentFunction,$letAssoc)) or (y:= symbolLassoc("all",$letAssoc))) then if (y="all" or symbolMember?(x,y)) and not (IS__GENVAR(x) or isSharpVarWithNum(x) or GENSYMP x) then sayBrightlyNT [:bright x,": "] @@ -604,7 +604,7 @@ letPrint(x,val,currentFunction) == letPrint2(x,printform,currentFunction) == $BreakMode:local := nil if $letAssoc and - ((y:= LASSOC(currentFunction,$letAssoc)) or (y:= LASSOC("all",$letAssoc))) then + ((y:= LASSOC(currentFunction,$letAssoc)) or (y:= symbolLAssoc("all",$letAssoc))) then if (y="all" or symbolMember?(x,y)) and not (IS__GENVAR(x) or isSharpVarWithNum(x) or GENSYMP x) then $BreakMode:='letPrint2 @@ -624,7 +624,7 @@ letPrint2(x,printform,currentFunction) == letPrint3(x,xval,printfn,currentFunction) == $BreakMode:local := nil if $letAssoc and - ((y:= LASSOC(currentFunction,$letAssoc)) or (y:= LASSOC("all",$letAssoc))) then + ((y:= LASSOC(currentFunction,$letAssoc)) or (y:= symbolLassoc("all",$letAssoc))) then if (y="all" or symbolMember?(x,y)) and not (IS__GENVAR(x) or isSharpVarWithNum(x) or GENSYMP x) then $BreakMode:='letPrint2 @@ -807,7 +807,7 @@ breaklet(fn,vars) == fn = "Undef" => nil fnEntry:= LASSOC(fn,$letAssoc) vars:= - pair:= ASSOC("BREAK",fnEntry) => union(vars,rest pair) + pair := symbolLassoc("BREAK",fnEntry) => union(vars,rest pair) vars $letAssoc:= null fnEntry => [[fn,:[["BREAK",:vars]]],:$letAssoc] |