From d2412069e4fc43a4bc6cc28ce4c57e02f8baee41 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sun, 11 May 2008 02:25:14 +0000 Subject: fix fallout from previous commit --- src/interp/format.boot | 5 ++--- src/interp/info.boot | 2 +- src/interp/lisplib.boot | 2 +- src/interp/macex.boot | 2 +- src/interp/msg.boot | 8 ++++---- src/interp/newfort.boot | 7 +++++++ src/interp/nruncomp.boot | 12 ++++++------ src/interp/package.boot | 2 +- src/interp/postpar.boot | 2 +- src/interp/pspad1.boot | 8 ++++---- src/interp/pspad2.boot | 2 +- src/interp/showimp.boot | 2 +- 12 files changed, 30 insertions(+), 24 deletions(-) (limited to 'src') diff --git a/src/interp/format.boot b/src/interp/format.boot index 64d0ee28..d1e6e4df 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -389,8 +389,7 @@ form2String1 u == STRINGP u => formWrapId u WRITE_-TO_-STRING formWrapId u u1 := u - op := CAR u - argl := CDR u + [op,:argl] := u op='Join or op= 'mkCategory => formJoin1(op,argl) $InteractiveMode and IDENTP op and (u:= constructor? op) => null argl => app2StringWrap(formWrapId constructorName op, u1) @@ -438,7 +437,7 @@ form2String1 u == argl := rest argl (null argl) or null (first argl) => [lo, '".."] [lo, '"..", form2String1 first argl] - isBinaryInfix op => outputTran [op,:argl] + isBinaryInfix op => formatAsFortranExpresion [op,:argl] -- COMPILED_-FUNCTION_-P(op) => form2String1 coerceMap2E(u1,NIL) application2String(op,[form2String1 x for x in argl], u1) diff --git a/src/interp/info.boot b/src/interp/info.boot index e71e1218..21bc44ba 100644 --- a/src/interp/info.boot +++ b/src/interp/info.boot @@ -258,7 +258,7 @@ actOnInfo(u,$e) == -- SAY("augmenting ",name,": ",cat) -- put(name, "value", (vval, cat, venv), $e) member(cat,first ocatvec.4) or - ASSOC(cat,CADR ocatvec.4) is [.,"T",.] => $e + assoc(cat,second ocatvec.4) is [.,"T",.] => $e --SAY("Category extension error: --cat shouldn't be a join --what was being asserted is an ancestor of what was known diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 74c00370..57140a59 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -546,7 +546,7 @@ transformOperationAlist operationAlist == implementation = 'mkRecord => 'mkRecord keyedSystemError("S2IL0025",[implementation]) signatureItem:= - if u:= ASSOC([op,sig],$functionLocations) then n := [n,:rest u] + if u:= assoc([op,sig],$functionLocations) then n := [n,:rest u] kind = 'ELT => condition = 'T => [sig,n] [sig,n,condition] diff --git a/src/interp/macex.boot b/src/interp/macex.boot index 41b4c6b9..26796b5c 100644 --- a/src/interp/macex.boot +++ b/src/interp/macex.boot @@ -124,7 +124,7 @@ mac0Define(sy, state, body) == -- Returns [state, body] or NIL. mac0Get sy == - IFCDR ASSOC(sy, $pfMacros) + IFCDR assoc(sy, $pfMacros) -- Returns [sy, state] or NIL. mac0GetName body == diff --git a/src/interp/msg.boot b/src/interp/msg.boot index a4b40645..4f658fd2 100644 --- a/src/interp/msg.boot +++ b/src/interp/msg.boot @@ -163,7 +163,7 @@ processChPosesForOneLine msgList == for msg in msgList repeat if getMsgFTTag? msg then putFTText (msg,chPosList) - posLetter := CDR ASSOC(poCharPosn getMsgPos msg,chPosList) + posLetter := rest assoc(poCharPosn getMsgPos msg,chPosList) oldPre := getMsgPrefix msg setMsgPrefix (msg,STRCONC(oldPre,_ MAKE_-FULL_-CVEC ($preLength - 4 - SIZE oldPre),posLetter) ) @@ -211,7 +211,7 @@ insertPos(newPos,posList) == putFTText (msg,chPosList) == tag := getMsgFTTag? msg pos := poCharPosn getMsgPos msg - charMarker := CDR ASSOC(pos,chPosList) + charMarker := rest assoc(pos,chPosList) tag = 'FROM => markingText := ['"(from ",charMarker,'" and on) "] setMsgText(msg,[:markingText,:getMsgText msg]) @@ -220,7 +220,7 @@ putFTText (msg,chPosList) == setMsgText(msg,[:markingText,:getMsgText msg]) tag = 'FROMTO => pos2 := poCharPosn getMsgPos2 msg - charMarker2 := CDR ASSOC(pos2,chPosList) + charMarker2 := rest assoc(pos2,chPosList) markingText := ['"(from ",charMarker,'" up to ",_ charMarker2,'") "] setMsgText(msg,[:markingText,:getMsgText msg]) @@ -444,7 +444,7 @@ desiredMsg (erMsgKey,:optCatFlag) == isKeyQualityP (key,qual) == --returns pair if found, else NIL found := false - while not found and (qualPair := ASSOC(key,$specificMsgTags)) repeat + while not found and (qualPair := assoc(key,$specificMsgTags)) repeat if CDR qualPair = qual then found := true qualPair diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index 5f66a94b..c115dfcf 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -363,6 +363,13 @@ fortexp0 x == [t,:f] := f l := [t,:l] NREVERSE ['"...",:l] + +++ This formating routine is essentially used to print +++ values/expreions used to instantiate constructors. +formatAsFortranExpresion x == + $fortInts2Floats := false + fortranCleanUp exp2Fort1 segment fortPre outputTran x + dispfortexp x == if atom(x) or x is [op,:.] and not object2Identifier op in diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 749488e1..5d9c811a 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -473,10 +473,10 @@ NRTcheckVector domainShell == -- (d) op-signature-- store missing function info in $CheckVectorList v:= domainShell.i v=true => nil --item is marked; ignore - null v => nil --a domain, which setVector4part3 will fill in - atom first v => nil --category form; ignore + v=nil => nil --a domain, which setVector4part3 will fill in atom v => systemErrorHere '"CheckVector" - ASSOC(first v,alist) => nil + atom first v => nil --category form; ignore + assoc(first v,alist) => nil alist:= [[first v,:$SetFunctions.i],:alist] alist @@ -527,10 +527,10 @@ reverseCondlist cl == alist := nil for [x,:y] in cl repeat for z in y repeat - u := ASSOC(z,alist) + u := assoc(z,alist) null u => alist := [[z,x],:alist] - member(x,CDR u) => nil - RPLACD(u,[x,:CDR u]) + member(x,rest u) => nil + RPLACD(u,[x,:rest u]) alist NRTsetVector4Part2(uncondList,condList) == diff --git a/src/interp/package.boot b/src/interp/package.boot index bc38f77a..131ba589 100644 --- a/src/interp/package.boot +++ b/src/interp/package.boot @@ -81,7 +81,7 @@ processPackage($definition is [name,:args],[$catsig,:argssig],code,locals,$e) == opt(u,alist) == ATOM u => u for v in u repeat - if (a:=ASSOC(v,alist)) then + if (a:=assoc(v,alist)) then [.,:i]:=a u:=replace(v,["getShellEntry","$",i],u) where replace(old,new,l) == diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index 9c6a3662..634a7960 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -309,7 +309,7 @@ postForm u == op':= true=> op $BOOT => op - GET(op,'Led) or GET(op,'Nud) or op = 'IN => op + GETL(op,'Led) or GETL(op,'Nud) or op = 'IN => op numOfArgs:= (argl' is [["Tuple",:l]] => #l; 1) INTERNL("*",STRINGIMAGE numOfArgs,PNAME op) [op',:argl'] diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot index 5813a431..284d5705 100644 --- a/src/interp/pspad1.boot +++ b/src/interp/pspad1.boot @@ -284,8 +284,8 @@ format(x,:options) == getOp(op,kind) == kind = 'Led => MEMQ(op,'(_div _exquo)) => nil - GET(op,'Led) - GET(op,'Nud) + GETL(op,'Led) + GETL(op,'Nud) formatDollar(name,p,argl) == name := markMacroTran name @@ -446,7 +446,7 @@ formatSelection1 [f,x] == formatSelectionOp f and format "." and formatPren x formatSelectionOp op == - op is [f,.] and not GET(f,'Nud) or + op is [f,.] and not GETL(f,'Nud) or 1000 < pspadBindingPowerOf("right",op) => formatSelectionOp1 op formatPren1("formatSelectionOp1",op) @@ -498,7 +498,7 @@ formatPrefix(op,arg,lbp,rbp,:options) == formatPrefixOp(op,:options) == qualification := IFCAR options op=char '" " => format " =" - qualification or GET(op,"Nud") and ^MEMQ(op,$spadTightList) => + qualification or GETL(op,"Nud") and ^MEMQ(op,$spadTightList) => formatQual(op,qualification) and format " " format op diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot index d30defdb..e6528a19 100644 --- a/src/interp/pspad2.boot +++ b/src/interp/pspad2.boot @@ -548,7 +548,7 @@ formatPileLine($m,x,newLineIfTrue) == --====================================================================== nBlanks m == "STRCONC"/[char('_ ) for i in 1..m] -isNewspadOperator op == GET(op,"Led") or GET(op,"Nud") +isNewspadOperator op == GETL(op,"Led") or GETL(op,"Nud") isTrue x == x="true" or x is '(QUOTE T) diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot index b94fe63f..d593b847 100644 --- a/src/interp/showimp.boot +++ b/src/interp/showimp.boot @@ -102,7 +102,7 @@ showFrom(D,:option) == $predicateList: local := getConstructorPredicatesFromDB nam for (opSig := [op,sig]) in getDomainSigs1(D,ops) repeat u := from?(D,op,sig) - x := ASSOC(u,alist) => RPLACD(x,[opSig,:rest x]) + x := assoc(u,alist) => RPLACD(x,[opSig,:rest x]) alist := [[u,opSig],:alist] for [conform,:l] in alist repeat sayBrightly concat('"From ",form2String conform,'":") -- cgit v1.2.3