diff options
Diffstat (limited to 'src')
88 files changed, 646 insertions, 558 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index fb5dc650..0fad28d3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,91 @@ +2009-08-14 Gabriel Dos Reis <gdr@cs.tamu.edu> + + + * boot/tokens.boot: Retire "^=". Introduce "~=". + * boot/ast.boot: Use "~=" instead of "^=". + * boot/includer.boot: Likewise. + * boot/translator.boot: Likewise. + * interp/as.boot: Likewise. + * interp/bc-misc.boot: Likewise. + * interp/bc-solve.boot: Likewise. + * interp/bc-util.boot: Likewise. + * interp/br-con.boot: Likewise. + * interp/br-data.boot: Likewise. + * interp/br-op1.boot: Likewise. + * interp/br-op2.boot: Likewise. + * interp/br-prof.boot: Likewise. + * interp/br-saturn.boot: Likewise. + * interp/br-search.boot: Likewise. + * interp/br-util.boot: Likewise. + * interp/c-doc.boot: Likewise. + * interp/c-util.boot: Likewise. + * interp/category.boot: Likewise. + * interp/cattable.boot: Likewise. + * interp/clam.boot: Likewise. + * interp/clammed.boot: Likewise. + * interp/compiler.boot: Likewise. + * interp/database.boot: Likewise. + * interp/define.boot: Likewise. + * interp/format.boot: Likewise. + * interp/fortcall.boot: Likewise. + * interp/functor.boot: Likewise. + * interp/g-cndata.boot: Likewise. + * interp/g-opt.boot: Likewise. + * interp/g-timer.boot: Likewise. + * interp/g-util.boot: Likewise. + * interp/guess.boot: Likewise. + * interp/ht-root.boot: Likewise. + * interp/ht-util.boot: Likewise. + * interp/htsetvar.boot: Likewise. + * interp/i-analy.boot: Likewise. + * interp/i-code.boot: Likewise. + * interp/i-coerce.boot: Likewise. + * interp/i-coerfn.boot: Likewise. + * interp/i-eval.boot: Likewise. + * interp/i-funsel.boot: Likewise. + * interp/i-intern.boot: Likewise. + * interp/i-map.boot: Likewise. + * interp/i-output.boot: Likewise. + * interp/i-resolv.boot: Likewise. + * interp/i-spec1.boot: Likewise. + * interp/i-spec2.boot: Likewise. + * interp/i-syscmd.boot: Likewise. + * interp/i-toplev.boot: Likewise. + * interp/i-util.boot: Likewise. + * interp/int-top.boot: Likewise. + * interp/interop.boot: Likewise. + * interp/intfile.boot: Likewise. + * interp/lisplib.boot: Likewise. + * interp/macex.boot: Likewise. + * interp/mark.boot: Likewise. + * interp/match.boot: Likewise. + * interp/modemap.boot: Likewise. + * interp/msg.boot: Likewise. + * interp/msgdb.boot: Likewise. + * interp/newfort.boot: Likewise. + * interp/nruncomp.boot: Likewise. + * interp/nrunfast.boot: Likewise. + * interp/nrungo.boot: Likewise. + * interp/nrunopt.boot: Likewise. + * interp/parse.boot: Likewise. + * interp/pathname.boot: Likewise. + * interp/pf2atree.boot: Likewise. + * interp/pf2sex.boot: Likewise. + * interp/postpar.boot: Likewise. + * interp/profile.boot: Likewise. + * interp/pspad1.boot: Likewise. + * interp/pspad2.boot: Likewise. + * interp/record.boot: Likewise. + * interp/scan.boot: Likewise. + * interp/setvars.boot: Likewise. + * interp/simpbool.boot: Likewise. + * interp/slam.boot: Likewise. + * interp/topics.boot: Likewise. + * interp/trace.boot: Likewise. + * interp/wi1.boot: Likewise. + * interp/wi2.boot: Likewise. + * interp/word.boot: Likewise. + 2009-08-05 Gabriel Dos Reis <gdr@cs.tamu.edu> * OpenAxiom-1.3.0 Released. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 95d7cbc5..8fe59706 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -756,7 +756,7 @@ bfReName x== x $translatingOldBoot and not bfSameMeaning x => oldName := bfGetOldBootName x - if newName ^= oldName then + if newName ~= oldName then warn [PNAME x, '" as `", PNAME newName, _ '"_' differs from Old Boot `", PNAME oldName,_ '"_' at ", diagnosticLocation $stok] @@ -1192,7 +1192,7 @@ bfCI(g,x,y)== if null a then [first x,y] else - b:=[[i,bfCARCDR(j,g)] for i in a for j in 0.. | i ^= "DOT"] + b:=[[i,bfCARCDR(j,g)] for i in a for j in 0.. | i ~= "DOT"] null b => [first x,y] [first x,["LET",b,y]] @@ -1419,7 +1419,7 @@ nativeArgumentType t == -- Allow 'string' for `pass-by-value' t = "string" => nativeType t -- anything else must use a modified reference type. - atom t or #t ^= 2 => + atom t or #t ~= 2 => coreError '"invalid argument type for a native function" [m,[c,t']] := t -- Require a modifier. @@ -1469,7 +1469,7 @@ genGCLnativeTranslation(op,s,t,op') == ccode := "strconc"/[gclTypeInC t, '" ", cop, '"(", :[cparm(x,a) for x in tails s for a in tails cargs], - '") { ", (t ^= "void" => '"return "; ""), + '") { ", (t ~= "void" => '"return "; ""), SYMBOL_-NAME op', '"(", :[gclArgsInC(x,a) for x in tails s for a in tails cargs], '"); }" ] diff --git a/src/boot/includer.boot b/src/boot/includer.boot index 481f099c..86f3a648 100644 --- a/src/boot/includer.boot +++ b/src/boot/includer.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -285,7 +285,7 @@ shoePrefix?(prefix,whole) == shoePlainLine?(s) == #s = 0 => true - s.0 ^= char ")" + s.0 ~= char ")" shoeSay? s == shoePrefix?('")say", s) shoeEval? s == shoePrefix?('")eval", s) diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot index 5e939d99..8872c9df 100644 --- a/src/boot/scanner.boot +++ b/src/boot/scanner.boot @@ -389,7 +389,7 @@ shoeW(b)== $n:=$n+1 l:=$sz endid:=shoeIdEnd($ln,$n) - if endid=l or QENUM($ln,endid)^=shoeESCAPE + if endid=l or QENUM($ln,endid)~=shoeESCAPE then $n:=endid [b,SUBSTRING($ln,n1,endid-n1)] @@ -421,7 +421,7 @@ shoeInteger1(zro) == n:=$n l:= $sz while $n<l and shoeDigit($ln.$n) repeat $n:=$n+1 - if $n=l or QENUM($ln,$n)^=shoeESCAPE + if $n=l or QENUM($ln,$n)~=shoeESCAPE then if n=$n and zro then '"0" else SUBSTRING($ln,n,$n-n) diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index bd54f16f..01cde61b 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -2964,17 +2964,22 @@ (SETQ |unstableArgs| (CONS |a| |unstableArgs|))))))) (SETQ |bfVar#174| (CDR |bfVar#174|)) (SETQ |bfVar#175| (CDR |bfVar#175|)))) + (SETQ |op'| + (COND + ((|%hasFeature| :WIN32) + (CONCAT "_" (SYMBOL-NAME |op'|))) + (#1='T (SYMBOL-NAME |op'|)))) (COND ((NULL |unstableArgs|) (LIST (LIST 'DEFUN |op| |args| (CONS (INTERN "ALIEN-FUNCALL" "SB-ALIEN") (CONS (LIST (INTERN "EXTERN-ALIEN" "SB-ALIEN") - (SYMBOL-NAME |op'|) + |op'| (CONS 'FUNCTION (CONS |rettype| |argtypes|))) |args|))))) - ('T + (#1# (LIST (LIST 'DEFUN |op| |args| (LIST (|bfColonColon| 'SB-SYS 'WITH-PINNED-OBJECTS) @@ -2983,7 +2988,7 @@ (CONS (LIST (INTERN "EXTERN-ALIEN" "SB-ALIEN") - (SYMBOL-NAME |op'|) + |op'| (CONS 'FUNCTION (CONS |rettype| |argtypes|))) (NREVERSE |newArgs|)))))))))))) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 75e3f3f5..618d4f4d 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -20,13 +20,13 @@ (LIST ";" 'SEMICOLON) (LIST "*" 'TIMES) (LIST "**" 'POWER) (LIST "/" 'SLASH) (LIST "+" 'PLUS) (LIST "-" 'MINUS) (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE) - (LIST "=" 'SHOEEQ) (LIST "^" 'NOT) (LIST "^=" 'SHOENE) - (LIST ".." 'SEG) (LIST "#" 'LENGTH) (LIST "=>" 'EXIT) - (LIST "->" 'ARROW) (LIST ":=" 'BEC) (LIST "==" 'DEF) - (LIST "==>" 'MDEF) (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN) - (LIST ")" 'CPAREN) (LIST "(|" 'OBRACK) (LIST "|)" 'CBRACK) - (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) (LIST "suchthat" 'BAR) - (LIST "'" 'QUOTE) (LIST "|" 'BAR))) + (LIST "=" 'SHOEEQ) (LIST "^" 'NOT) (LIST "^=" 'SHOENERETIRED) + (LIST "~=" 'SHOENE) (LIST ".." 'SEG) (LIST "#" 'LENGTH) + (LIST "=>" 'EXIT) (LIST "->" 'ARROW) (LIST ":=" 'BEC) + (LIST "==" 'DEF) (LIST "==>" 'MDEF) (LIST "<=>" 'TDEF) + (LIST "(" 'OPAREN) (LIST ")" 'CPAREN) (LIST "(|" 'OBRACK) + (LIST "|)" 'CBRACK) (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) + (LIST "suchthat" 'BAR) (LIST "'" 'QUOTE) (LIST "|" 'BAR))) (DEFUN |shoeKeyTableCons| () (PROG (|KeyTable|) @@ -169,7 +169,7 @@ (LIST 'OR '|or|) (LIST 'SLASH '/) (LIST 'POWER '**) (LIST 'MINUS '-) (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=) - (LIST 'GE '>=) (LIST 'SHOENE '^=))) + (LIST 'GE '>=) (LIST 'SHOENE '~=))) (|i| NIL)) (LOOP (COND @@ -204,7 +204,7 @@ (LIST '|cons| 'CONS) (LIST '|copy| 'COPY) (LIST '|croak| 'CROAK) (LIST '|drop| 'DROP) (LIST '|exit| 'EXIT) (LIST '|false| 'NIL) - (LIST '|first| 'CAR) + (LIST '|first| 'CAR) (LIST '|fourth| 'CADDDR) (LIST '|function| 'FUNCTION) (LIST '|genvar| 'GENVAR) (LIST 'IN 'MEMBER) (LIST '|is| 'IS) (LIST '|isnt| 'ISNT) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index a51fe58b..1623d61e 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -78,7 +78,8 @@ shoeKeyWords == [ _ ['">=","GE" ], _ ['"=", "SHOEEQ"], _ ['"^", "NOT"], _ - ['"^=","SHOENE" ], _ + ['"^=","SHOENERETIRED" ], _ + ['"~=","SHOENE" ], _ ['"..","SEG" ], _ ['"#", "LENGTH"], _ ['"=>","EXIT" ], _ @@ -194,7 +195,7 @@ for i in [ _ ["GT" ,">"], _ ["LE" ,"<="], _ ["GE" ,">="], _ - ["SHOENE" ,"^="] _ + ["SHOENE" ,"~="] _ ]_ repeat SETF (GET(first i,'SHOEINF),second i) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 50574ee5..c3e50f44 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -427,7 +427,7 @@ translateToplevel(b,export?) == :[first translateToplevel(d,true) for d in ds]] Import(m) => - if getOptionValue "import" ^= '"skip" then + if getOptionValue "import" ~= '"skip" then bootImport STRING m [["IMPORT-MODULE", STRING m]] @@ -755,7 +755,7 @@ defaultBootToLispFile file == getIntermediateLispFile(file,options) == out := NAMESTRING getOutputPathname(options) - out ^= nil => + out ~= nil => strconc(shoeRemoveStringIfNec (strconc('".",$effectiveFaslType),out),'".clisp") defaultBootToLispFile file @@ -766,7 +766,7 @@ translateBootFile(progname, options, file) == compileBootHandler(progname, options, file) == intFile := BOOTTOCL(file, getIntermediateLispFile(file,options)) - errorCount() ^= 0 => nil + errorCount() ~= 0 => nil intFile => objFile := compileLispHandler(progname, options, intFile) DELETE_-FILE intFile diff --git a/src/interp/as.boot b/src/interp/as.boot index c6ea5bde..15242412 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -358,7 +358,7 @@ asyMakeOperationAlist(con,proplist, key) == y := asyAncestors form [attrs, na] := asyFindAttrs y y := na - if opOf(y)^=con then ancestorAlist := [ [y,:true],:ancestorAlist] + if opOf(y) ~= con then ancestorAlist := [ [y,:true],:ancestorAlist] idForm := form is ['Apply,'_-_>,source,target] => [id,:asyArgs source] ----------> Constants change <-------------- @@ -368,8 +368,8 @@ asyMakeOperationAlist(con,proplist, key) == nil sig := asySignature(asytranForm(form,[idForm],nil),nil) entry := - --id ^= "%%" and IDENTP idForm => [[sig],nil,nil,'ASCONST] - id ^= "%%" and IDENTP idForm => + --id ~= "%%" and IDENTP idForm => [[sig],nil,nil,'ASCONST] + id ~= "%%" and IDENTP idForm => pred => [[sig],nil,asyPredTran pred,'ASCONST] [[sig],nil,true,'ASCONST] pred => [sig,nil,asyPredTran pred] @@ -437,7 +437,7 @@ mkNiladics u == asytranDeclaration(dform,levels,predlist,local?) == ['Declare,id,form,r] := dform id = 'failed => id - KAR dform ^= 'Declare => systemError '"asytranDeclaration" + KAR dform ~= 'Declare => systemError '"asytranDeclaration" if levels = '(top) then if form isnt ['Apply,"->",:.] then HPUT($constantHash,id,true) comments := LASSOC('documentation,r) or '"" @@ -528,7 +528,7 @@ asytranForm(form,levels,local?) == asytranForm1(form,levels,local?) == form is ['With,left,cat] => --- left ^= nil => error '"WITH cannot take a left argument yet" +-- left ~= nil => error '"WITH cannot take a left argument yet" asytranCategory(form,levels,nil,local?) form is ['Apply,:.] => asytranApply(form,levels,local?) form is ['Declare,:.] => asytranDeclaration(form,levels,nil,local?) @@ -755,7 +755,7 @@ asySplit(name,end) == createAbbreviation s == if STRINGP s then s := INTERN s a := constructor? s - a ^= s => a + a ~= s => a nil --============================================================================ diff --git a/src/interp/bc-misc.boot b/src/interp/bc-misc.boot index 46eaf266..020a5af6 100644 --- a/src/interp/bc-misc.boot +++ b/src/interp/bc-misc.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -287,7 +287,7 @@ bcDraw2DfunGen htPage == from1 := htpLabelInputString(htPage,'from1) to1 := htpLabelInputString(htPage,'to1) title := htpLabelInputString(htPage,'title) - if (title ^= '"") then + if (title ~= '"") then titlePart := STRCONC('"{}",'"title ==_"",title,'"_"") bcFinish('"draw",fun,bcDrawIt2(ind,from1,to1),titlePart) else @@ -334,7 +334,7 @@ bcDraw2DparGen htPage == to1 := htpLabelInputString(htPage,'to1) title := htpLabelInputString(htPage,'title) curvePart := STRCONC('"curve(",'"{}",fun1,'",{}",fun2,'")") - if (title ^= '"") then + if (title ~= '"") then titlePart := (title = '"" => nil; STRCONC('"{}",'"title ==_"",title,'"_"")) bcFinish('"draw",curvePart,bcDrawIt2(ind,from1,to1),titlePart) else @@ -384,7 +384,7 @@ bcDraw2DSolveGen htPage == to2 := htpLabelInputString(htPage,'to2) title := htpLabelInputString(htPage,'title) clipPart := STRCONC('"{}",'"range==[{}",from1,'"..",to1,",{}",from2,'"..",to2,'"]") - if (title ^= '"") then + if (title ~= '"") then titlePart := (title = '"" => nil; STRCONC('"{}",'"title ==_"",title,'"_"")) bcFinish('"draw",STRCONC(fun,'" = 0 "),ind1,ind2,clipPart,titlePart) else @@ -438,7 +438,7 @@ bcDraw3DfunGen htPage == from2 := htpLabelInputString(htPage,'from2) to2 := htpLabelInputString(htPage,'to2) title := htpLabelInputString(htPage,'title) - if (title ^= '"") then + if (title ~= '"") then titlePart := (title = '"" => nil;STRCONC('"{}",'"title ==_"",title,'"_"")) bcFinish('"draw",fun,bcDrawIt2(ind1,from1,to1),bcDrawIt2(ind2,from2,to2),titlePart) else @@ -488,7 +488,7 @@ bcDraw3DparGen htPage == title := htpLabelInputString(htPage,'title) curvePart := STRCONC('"curve(",'"{}",fun1,'",{}",fun2,'",{}",fun3,'")") tubePart := '"{}tubeRadius==.25,{}tubePoints==16" - if (title ^= '"") then + if (title ~= '"") then titlePart := (title = '"" => nil; STRCONC('"{}",'"title ==_"",title,'"_"")) bcFinish('"draw",curvePart,bcDrawIt2(ind,from1,to1),tubePart,titlePart) else @@ -553,7 +553,7 @@ bcDraw3Dpar1Gen htPage == r1 := bcDrawIt2(ind1,from1,to1) r2 := bcDrawIt2(ind2,from2,to2) surfacePart := STRCONC('"surface(",'"{}",fun1,'",{}",fun2,'",{}",fun3,'")") - if (title ^= '"") then + if (title ~= '"") then titlePart := (title = '"" => nil; STRCONC('"{}",'"title ==_"",title,'"_"")) bcFinish('"draw",surfacePart,r1,r2,titlePart) else @@ -844,7 +844,7 @@ bcRealLimit(a,b) == htShowPage() bcRealLimitGen htPage == - (p := htpButtonValue(htPage,'location)) ^= 'finitePoint => + (p := htpButtonValue(htPage,'location)) ~= 'finitePoint => fun := htpLabelInputString(htPage,'expression) var := htpLabelInputString(htPage,'variable) loc := diff --git a/src/interp/bc-solve.boot b/src/interp/bc-solve.boot index b9b0912c..1a8a5d21 100644 --- a/src/interp/bc-solve.boot +++ b/src/interp/bc-solve.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -276,7 +276,7 @@ bcLinearSolveMatrixInhomo(htPage,junk) == [f(i) for i in 1..ncols] where f(i) == spacer := (i > 99 => 0; i > 9 => 1; 2) prefix := STRCONC('"{\em Coefficient ",STRINGIMAGE i,'":}") - if spacer ^= 0 then + if spacer ~= 0 then prefix := STRCONC(prefix,'"\space{",STRINGIMAGE spacer,'"}") name := INTERN STRCONC('"c",STRINGIMAGE i) [prefix,"",30, 0,name, 'P] diff --git a/src/interp/bc-util.boot b/src/interp/bc-util.boot index e9f590dc..bc8719b1 100644 --- a/src/interp/bc-util.boot +++ b/src/interp/bc-util.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -96,7 +96,7 @@ bcvspace() == bcHt '"\vspace{1}\newline " bcString2WordList s == fn(s,0,MAXINDEX s) where fn(s,i,n) == i > n => nil - k := or/[j for j in i..n | s.j ^= char '_ ] + k := or/[j for j in i..n | s.j ~= char '_ ] null INTEGERP k => nil l := bcFindString(s,k + 1,n,char '_ ) null INTEGERP l => [SUBSTRING(s,k,nil)] diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index b6c9f566..d1c1911c 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -140,7 +140,7 @@ conPageConEntry entry == --% satBreak() --% htMakePage [['bcLinks,['"\menuitemstyle{Attributes}", --% [['text,'"\tab{19}All exported attributes"]],'koPage,'"attribute"]]] ---% if kind ^= 'category and (pathname := dbHasExamplePage conname) then +--% if kind ~= 'category and (pathname := dbHasExamplePage conname) then --% satBreak() --% htMakePage [['bcLinks,['"\menuitemstyle{Examples}", --% [['text,'"\tab{19}Examples illustrating use"]],'kxPage,pathname]]] @@ -151,7 +151,7 @@ conPageConEntry entry == --% htMakePage [['bcLinks,['"\menuitemstyle{Cross Reference}", --% [['text,'"\tab{19}Hierarchy and usage information"]],'kcPage,nil]]] --% htEndMenu(3) ---% if kind ^= 'category and nargs > 0 then addParameterTemplates conform +--% if kind ~= 'category and nargs > 0 then addParameterTemplates conform --% htShowPage() --% conform2String u == @@ -163,11 +163,11 @@ kxPage(htPage,name) == downlink name kdPageInfo(name,abbrev,nargs,conform,signature,file?) == htSay("{\sf ",name,'"}") - if abbrev ^= name then bcHt [" has abbreviation ",abbrev] + if abbrev ~= name then bcHt [" has abbreviation ",abbrev] if file? then bcHt ['" is a source file."] - if nargs = 0 then (if abbrev ^= name then bcHt '".") + if nargs = 0 then (if abbrev ~= name then bcHt '".") else - if abbrev ^= name then bcHt '" and" + if abbrev ~= name then bcHt '" and" bcHt nargs = 1 => '" takes one argument:" [" takes ",STRINGIMAGE nargs," arguments:"] @@ -179,12 +179,12 @@ kdPageInfo(name,abbrev,nargs,conform,signature,file?) == --sourceFileName := dbSourceFile INTERN name sourceFileName := getConstructorSourceFileFromDB INTERN name filename := extractFileNameFromPath sourceFileName - if filename ^= '"" then + if filename ~= '"" then htSayStandard '"\newline{}" htSay('"The source code for the constructor is found in ") htMakePage [['text,'"\unixcommand{",filename,'"}{",textEditor(), '" ", sourceFileName, '" ", name, '"}"]] - if nargs ^= 0 then htSay '"." + if nargs ~= 0 then htSay '"." htSaturnBreak() kArgPage(htPage,arg) == @@ -349,7 +349,7 @@ kePageDisplay(htPage,which,opAlist) == htpSetProperty(htPage,expandProperty,'lists) --mark as unexpanded htMakePage [['bcLinks,[menuButton(),'"",'dbShowOps,which,'names]]] htSayStandard '"\tab{2}" - if count ^= total then + if count ~= total then if count = 1 then htSay('"1 name for ") else htSay(STRINGIMAGE count,'" names for ") @@ -454,7 +454,7 @@ kcPage(htPage,junk) == message := '"Constructors mentioning this as an argument type" htMakePage [['bcLinks,['"\menuitemstyle{Dependents}", [['text,'"\tab{12}",message]],'kcdePage,nil]]] - if not asharpConstructorName? conname and kind ^= '"category" then + if not asharpConstructorName? conname and kind ~= '"category" then satBreak() htMakePage [['bcLinks,['"\menuitemstyle{Lineage}", '"\tab{12}Constructor hierarchy used for operation lookup",'ksPage,nil]]] @@ -463,14 +463,14 @@ kcPage(htPage,junk) == satBreak() htMakePage [['bcLinks,['"\menuitemstyle{Domains}",[['text,'"\tab{12}", '"All domains which are of this category"]],'kcdoPage,nil]]] - if kind ^= '"category" then + if kind ~= '"category" then satBreak() htMakePage [['bcLinks,['"\menuitemstyle{Clients}",'"\tab{12}Constructors",'kcuPage,nil]]] if HGET($defaultPackageNamesHT,conname) then htSay('" which {\em may use} this default package") -- htMakePage [['bcLinks,['"files",'"",'kcuPage,true]]] else htSay('" which {\em use} this ",kind) - if kind ^= '"category" or dbpHasDefaultCategory? xpart then + if kind ~= '"category" or dbpHasDefaultCategory? xpart then satBreak() message := kind = '"category" => ['"Constructors {\em used by} its default package"] @@ -535,7 +535,7 @@ kcaPage1(htPage,kind,article,whichever,fn, isCatDescendants?) == conform := htpProperty(htPage,'conform) conname := opOf conform ancestors := FUNCALL(fn, conform, domname) - if whichever ^= '"ancestor" then + if whichever ~= '"ancestor" then ancestors := augmentHasArgs(ancestors,conform) ancestors := listSort(function GLESSEQP,ancestors) --if domname then ancestors := substitute(domname,'$,ancestors) @@ -578,7 +578,7 @@ kcdePage(htPage,junk) == conname := INTERN name constring := STRCONC(name,args) conform := - kind ^= '"default package" => ncParseFromString constring + kind ~= '"default package" => ncParseFromString constring [INTERN name,:rest ncParseFromString STRCONC(char 'd,args)] --because of & pakname := -- kind = '"category" => INTERN STRCONC(name,char '_&) @@ -594,7 +594,7 @@ kcuPage(htPage,junk) == conname := INTERN name constring := STRCONC(name,args) conform := - kind ^= '"default package" => ncParseFromString constring + kind ~= '"default package" => ncParseFromString constring [INTERN name,:rest ncParseFromString STRCONC(char 'd,args)] --because of & pakname := kind = '"category" => INTERN STRCONC(name,char '_&) @@ -686,7 +686,7 @@ kisValidType typeForm == kCheckArgumentNumbers t == [conname,:args] := t cosig := KDR getDualSignatureFromDB conname - #cosig ^= #args => false + #cosig ~= #args => false and/[foo for domain? in cosig for x in args] where foo() == domain? => kCheckArgumentNumbers x true @@ -700,7 +700,7 @@ parseNoMacroFromString(s) == mkConform(kind,name,argString) == - kind ^= '"default package" => + kind ~= '"default package" => form := STRCONC(name,argString) parse := parseNoMacroFromString form null parse => @@ -1047,7 +1047,7 @@ dbShowConsDoc(htPage,conlist) == for x in REMDUP conlist repeat -- for x in conlist repeat dbShowConsDoc1(htPage,getConstructorForm x,i) where i() == - while CAAAR cAlist ^= x repeat + while CAAAR cAlist ~= x repeat index := index + 1 cAlist := rest cAlist null cAlist => systemError () @@ -1126,7 +1126,7 @@ dbConsHeading(htPage,conlist,view,kind) == connective := member(view,'(abbrs files kinds)) => '" as " '" with " - if count ^= 0 and member(view,'(abbrs files parameters conditions)) then heading:= [:heading,'" viewed",connective,'"{\em ",STRINGIMAGE view,'"}"] + if count ~= 0 and member(view,'(abbrs files parameters conditions)) then heading:= [:heading,'" viewed",connective,'"{\em ",STRINGIMAGE view,'"}"] heading dbShowConstructorLines lines == @@ -1297,7 +1297,7 @@ PUT('Enumeration, 'documentation, substitute(MESSAGE, 'MESSAGE, '( (_= (((Boolean) _$ _$) "\spad{e = f} tests for equality of two enumerations \spad{e} and \spad{f}")) (_~_= (((Boolean) _$ _$) - "\spad{e ^= f} tests that two enumerations \spad{e} and \spad{f} are nont equal")) + "\spad{e ~= f} tests that two enumerations \spad{e} and \spad{f} are nont equal")) (coerce (((OutputForm) _$) "\spad{coerce(e)} returns a representation of enumeration \spad{r} as an output form") ((_$ (Symbol)) diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 6f1cd1fc..4e16780f 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -134,7 +134,7 @@ libConstructorSig [conname,:argl] == sig := SUBLISLIS(formals,$TriangleVariableList,sig) keys := [g(f,sig,i) for f in formals for i in 1..] where g(x,u,i) == --does x appear in any but i-th element of u? - or/[CONTAINED(x,y) for y in u for j in 1.. | j ^= i] + or/[CONTAINED(x,y) for y in u for j in 1.. | j ~= i] sig := fn SUBLISLIS(argl,$FormalMapVariableList,sig) where fn x == atom x => x @@ -208,7 +208,7 @@ checkCommentsForBraces(kind,sop,sigpart,comments) == sayBrightly ['"(",$conname,'" documentation) missing left brace--> ",:tail] if count > 0 then sayBrightly ['"(",$conname,'" documentation) missing right brace--> ",:tail] - if count ^= 0 or missingLeft then pp comments + if count ~= 0 or missingLeft then pp comments buildLibAttrs attrlist == for [name,argl,:pred] in attrlist repeat buildLibAttr(name,argl,pred) @@ -313,7 +313,7 @@ dbSpreadComments(line,n) == line = '"" => nil k := charPosition(char '_-,line,n + 2) k >= MAXINDEX line => [SUBSTRING(line,n,nil)] - line.(k + 1) ^= char '_- => + line.(k + 1) ~= char '_- => u := dbSpreadComments(line,k) [STRCONC(SUBSTRING(line,n,k - n),first u),:rest u] [SUBSTRING(line,n,k - n),:dbSpreadComments(SUBSTRING(line,k,nil),0)] @@ -403,7 +403,7 @@ getGlossLines instream == #last = 0 => lastLineHadTick => '"" '"\blankline " - #last > 0 and last.(MAXINDEX last) ^= $charBlank => $charBlank + #last > 0 and last.(MAXINDEX last) ~= $charBlank => $charBlank '"" lastLineHadTick := false text := [STRCONC(last,fill,line),:rest text] @@ -635,7 +635,7 @@ ancestorsRecur(conform,domform,pred,firstTime?) == --called by ancestorsOf originalConform := firstTime? and ($insideCategoryIfTrue or $insideFunctorIfTrue) => $form getConstructorForm op - if conform ^= originalConform then + if conform ~= originalConform then parents := SUBLISLIS(IFCDR conform,IFCDR originalConform,parents) for [newform,:p] in parents repeat if domform and rest domform then @@ -708,7 +708,7 @@ transKCatAlist(conform,domname,s) == main where for pair in s repeat --pair has form [con,[conargs,:pred],...]] leftForm := getConstructorForm CAR pair for (ap := [args,:pred]) in CDR pair repeat - hasArgsForm? := args ^= farglist + hasArgsForm? := args ~= farglist npred := sublisFormal(KDR leftForm,pred) if hasArgsForm? then subargs := sublisFormal(KDR leftForm,args) diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 38f83e2f..c5d51419 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -47,7 +47,7 @@ dbFromConstructor?(htPage) == htpProperty(htPage,'conform) dbDoesOneOpHaveParameters? opAlist == or/[(or/[fn for x in items]) for [op,:items] in opAlist] where fn() == - STRINGP x => dbPart(x,2,1) ^= '"0" + STRINGP x => dbPart(x,2,1) ~= '"0" KAR x --============================================================================ -- Master Switch Functions for Operation Views @@ -333,7 +333,7 @@ dbGatherData(htPage,opAlist,which,key) == htpProperty(htPage,'attrAlist) acc := nil initialExposure := - htPage and htpProperty(htPage,'conform) and which ^= '"package operation" + htPage and htpProperty(htPage,'conform) and which ~= '"package operation" => true --never star ops from a constructor nil @@ -655,13 +655,13 @@ dbShowOpDocumentation(htPage,opAlist,which,data) == for item in alist for j in 0.. repeat [sig,predicate,origin,exposeFlag,comments] := item exposeFlag or not $exposedOnlyIfTrue => - if comments ^= '"" and STRINGP comments and (k := string2Integer comments) then + if comments ~= '"" and STRINGP comments and (k := string2Integer comments) then comments := MEMQ(k,'(0 1)) => '"" dbReadComments k tail := CDDDDR item RPLACA(tail,comments) - doc := (STRINGP comments and comments ^= '"" => comments; nil) + doc := (STRINGP comments and comments ~= '"" => comments; nil) pred := predicate or true index := (exactlyOneOpSig => nil; base + j) if which = '"package operation" then @@ -935,7 +935,7 @@ getDomainOpTable(dom,fromIfTrue,:options) == abb := getConstructorAbbreviation conname opAlist := getOperationAlistFromLisplib conname "append"/[REMDUP [[op1,:fn] for [sig,slot,pred,key,:.] in u - | key ^= 'Subsumed and ((null ops and (op1 := op)) or (op1 := memq(op,ops)))] + | key ~= 'Subsumed and ((null ops and (op1 := op)) or (op1 := memq(op,ops)))] for [op,:u] in opAlist] where memq(op,ops) == --dirty trick to get 0 and 1 instead of Zero and One MEMQ(op,ops) => op diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index c1f8ac28..2171a7ae 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -177,7 +177,7 @@ dbChooseOperandName(typ) == name = "$" => 'domain getConstructorKindFromDB name s := PNAME opOf typ - kind ^= 'category => + kind ~= 'category => anySubstring?('"Integer",s,0) or anySubstring?('"Number",s,0) => x := first $NumberList $NumberList := rest $NumberList @@ -238,7 +238,7 @@ getSubstSignature sig == newsig getSubstQualify(x,i,sig) == - or/[CONTAINED(x,y) for y in sig for j in 1.. | j ^= i] => x + or/[CONTAINED(x,y) for y in sig for j in 1.. | j ~= i] => x false getSubstInsert(x,candidates) == @@ -352,7 +352,7 @@ koAttrs(conform,domname) == $predvec: local := $domain => $domain . 3 getConstructorPredicatesFromDB conname - u := [[a,:pred] for [a,:i] in $infovec . 2 | a ^= 'nil and (pred := sublisFormal(args,kTestPred i))] + u := [[a,:pred] for [a,:i] in $infovec . 2 | a ~= 'nil and (pred := sublisFormal(args,kTestPred i))] --------- CHECK for a = nil listSort(function GLESSEQP,fn u) where fn u == alist := nil @@ -403,7 +403,7 @@ koOps(conform,domname,:options) == main where op1 := zeroOneConvert op acc := [[op1,:[[sig,npred,:exposureTail] for [sig,slot,pred,key,:.] in sublisFormal(subargs,u) | - (key ^= 'Subsumed) and (npred := simpHasPred pred)]],:acc] + (key ~= 'Subsumed) and (npred := simpHasPred pred)]],:acc] acc merge(alist,alist1) == --alist1 takes precedence for [op,:al] in alist1 repeat @@ -586,7 +586,7 @@ modemap2SigConds conds == [conds] hasPatternVar x == - IDENTP x and (x ^= "**") => isPatternVar x + IDENTP x and (x ~= "**") => isPatternVar x atom x => false or/[hasPatternVar y for y in x] diff --git a/src/interp/br-prof.boot b/src/interp/br-prof.boot index d2f8111c..63bef4d7 100644 --- a/src/interp/br-prof.boot +++ b/src/interp/br-prof.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -126,7 +126,7 @@ dbShowInfoOp(htPage,op,sig,alist) == htSay '"\item" if IDENTP con then htSay '"\menuitemstyle{} {\em calls to} " - if con ^= 'Rep then htSay '"{\em argument} " + if con ~= 'Rep then htSay '"{\em argument} " htSay con if "and"/[fn is ['origin,orig,.] and (null origin and (origin := orig) or origin = orig) for fn in fns] then @@ -233,7 +233,7 @@ dbInfoSig sig == --============================================================================ dbGetExpandedOpAlist htPage == expand := htpProperty(htPage,'expandOperations) - if expand ^= 'fullyExpanded then + if expand ~= 'fullyExpanded then if null expand then htpSetProperty(htPage,'expandOperations,'lists) opAlist := koOps(htpProperty(htPage,'conform),nil) htpSetProperty(htPage,'opAlist,opAlist) diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index 272fb6e6..b096c6f8 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -236,7 +236,7 @@ htMakeErrorPage htPage == writeSaturnLines lines == for line in lines repeat - if line ^= '"" and line.0 = char '_\ then saturnTERPRI() + if line ~= '"" and line.0 = char '_\ then saturnTERPRI() saturnPRINTEXP line writeSaturn(line) == @@ -244,7 +244,7 @@ writeSaturn(line) == n := MAXINDEX line while --advance k if true k > n => false - line.k ^= char '_\ => true + line.k ~= char '_\ => true code := isBreakSegment?(line, k + 1,n) => false true repeat (k := k + 1) @@ -479,7 +479,7 @@ htSayHrule() == bcHt htDoneButton(func, htPage, :optionalArgs) == ------> Handle argument values passed from page if present - if optionalArgs ^= nil then + if optionalArgs ~= nil then htpSetInputAreaAlist(htPage,CAR optionalArgs) typeCheckInputAreas htPage => htMakeErrorPage htPage @@ -650,7 +650,7 @@ kPage(line,:options) == --any cat, dom, package, default package ---what follows is stuff from kiPage with domain = nil $conformsAreDomains := nil dbShowConsDoc1(page,conform,nil) - if kind ^= 'category and nargs > 0 then addParameterTemplates(page,conform) + if kind ~= 'category and nargs > 0 then addParameterTemplates(page,conform) if $atLeastOneUnexposed then htSay '"\newline{}{\em *} = unexposed" htSayStandard("\endscroll ") kPageContextMenu page @@ -681,7 +681,7 @@ kPageContextMenu page == htMakePage [['bcLinks,['Domains,'"",'kcdoPage,nil]]] else htSay '"{\em Domains}" htSay '"}{" - if kind ^= '"category" and (pathname := dbHasExamplePage conname) + if kind ~= '"category" and (pathname := dbHasExamplePage conname) then htMakePage [['bcLinks,['Examples,'"",'kxPage,pathname]]] else htSay '"{\em Examples}" htSay '"}{" @@ -690,12 +690,12 @@ kPageContextMenu page == htMakePage [['bcLinks,['Operations,'"",'koPage,'"operation"]]] htSay '"}{" htMakePage [['bcLinks,['Parents,'"",'kcpPage,'"operation"]]] - if kind ^= '"category" then + if kind ~= '"category" then htSay '"}{" if not asharpConstructorName? conname then htMakePage [['bcLinks,["Search Path",'"",'ksPage,nil]]] else htSay '"{\em Search Path}" - if kind ^= '"category" then + if kind ~= '"category" then htSay '"}{" htMakePage [['bcLinks,['Users,'"",'kcuPage,nil]]] htSay '"}{" @@ -721,7 +721,7 @@ kPageContextMenuSaturn page == if not asharpConstructorName? conname then htMakePage [['bcLinks,['"Do\&mains",'"",'kcdoPage,nil]]] else htSayCold '"Do\&mains" - if kind ^= '"category" and (name := saturnHasExamplePage conname) + if kind ~= '"category" and (name := saturnHasExamplePage conname) then saturnExampleLink name else htSayCold '"E\&xamples" htMakePage [['bcLinks,['"\&Exports",'"",'kePage,nil]]] @@ -730,7 +730,7 @@ kPageContextMenuSaturn page == if not asharpConstructorName? conname then htMakePage [['bcLinks,['"Search O\&rder",'"",'ksPage,nil]]] else htSayCold '"Search Order" - if kind ^= '"category" or dbpHasDefaultCategory? xpart + if kind ~= '"category" or dbpHasDefaultCategory? xpart then htMakePage [['bcLinks,['"\&Users",'"",'kcuPage,nil]]] htMakePage [['bcLinks,['"U\&ses",'"",'kcnPage,nil]]] @@ -786,7 +786,7 @@ dbPresentCons(htPage,kind,:exclusions) == else htMakePage [['bcLinks,['"Filter",'"",'htFilterPage,['dbShowCons,'filter]]]] htSay '"}{" - if one? or member('kinds,exclusions) or kind ^= 'constructor + if one? or member('kinds,exclusions) or kind ~= 'constructor then htSay '"{\em Kinds}" else htMakePage [['bcLispLinks,['"Kinds",'"",'dbShowCons,'kinds]]] htSay '"}{" @@ -833,7 +833,7 @@ dbPresentConsSaturn(htPage,kind,exclusions) == if one? or null CDR cAlist then htSayCold '"\&Filter" else htMakeSaturnFilterPage ['dbShowCons, 'filter] - if one? or member('kinds,exclusions) or kind ^= 'constructor + if one? or member('kinds,exclusions) or kind ~= 'constructor then htSayCold '"\&Kinds" else htMakePage [['bcLispLinks,['"\&Kinds",'"",'dbShowCons,'kinds]]] if one? or member('names,exclusions) @@ -1074,7 +1074,7 @@ dbPresentOps(htPage,which,:exclusions) == then htSay '"{\em Parameters}" else htMakePage [['bcLispLinks,['"Parameters",'"",'dbShowOps,which,'parameters]]] htSay '"}{" - if which ^= '"attribute" then + if which ~= '"attribute" then if one? or member('signatures,exclusions) then htSay '"{\em Signatures}" else htMakePage [['bcLispLinks,['"Signatures",'"",'dbShowOps,which,'signatures]]] @@ -1135,7 +1135,7 @@ dbPresentOpsSaturn(htPage,which,exclusions) == or not dbDoesOneOpHaveParameters? opAlist then htSayCold '"\&Parameters" else htMakePage [['bcLispLinks,['"\&Parameters",'"",'dbShowOps,which,'parameters]]] - if which ^= '"attribute" then + if which ~= '"attribute" then if one? or member('signatures,exclusions) then htSayCold '"\&Signatures" else htMakePage [['bcLispLinks,['"\&Signatures",'"",'dbShowOps,which,'signatures]]] @@ -1254,7 +1254,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, $signature := SUBLISLIS($FormalMapVariableList,tvarlist,$signature) $sig := which = '"attribute" or which = '"constructor" => sig - $conkind ^= '"package" => sig + $conkind ~= '"package" => sig symbolsUsed := [x for x in rest conform | IDENTP x] $DomainList := SETDIFFERENCE($DomainList,symbolsUsed) getSubstSigIfPossible sig @@ -1277,7 +1277,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, htSayIndentRel(15, true) position := KAR relatives relatives := KDR relatives - if KAR coSig and t ^= '(Type) + if KAR coSig and t ~= '(Type) then htMakePage [['bcLinks,[a,'"",'kArgPage,a]]] else htSay('"{\em ",form2HtString(a),'"}") htSay ", " @@ -1296,7 +1296,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, htSayIndentRel(-15, true) htSaySaturn '"\\" ----------------------------------------------------------- - if origin and ($generalSearch? or origin ^= conform) and op^=opOf origin then + if origin and ($generalSearch? or origin ~= conform) and op~=opOf origin then htSaySaturn '"{\em Origin:}" htSaySaturnAmpersand() htSayStandard('"\newline\tab{2}{\em Origin:}") @@ -1339,7 +1339,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, bcConform(conform,true,true) firstTime := false htSayIndentRel(-15,true) - for [d,key,:t] in $whereList | d ^= "$" repeat + for [d,key,:t] in $whereList | d ~= "$" repeat htSayIndentRel(15,count > 1) if not firstTime then htSaySaturn '"\\ " htSaySaturnAmpersand() @@ -1349,7 +1349,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, htSayIndentRel(-15,count > 1) htSaySaturn '"\\" ----------------------------------------------------------- - if doc and (doc ^= '"" and (doc isnt [d] or d ^= '"")) then + if doc and (doc ~= '"" and (doc isnt [d] or d ~= '"")) then htSaySaturn '"{\em Description:}" htSaySaturnAmpersand() htSayStandard('"\newline\tab{2}{\em Description:}") @@ -1585,7 +1585,7 @@ mkButtonBox n == STRCONC('"\buttonbox{", STRINGIMAGE n, '"}") -- while not EOFP instream repeat -- line := READLINE instream -- comP := FILE_-POSITION comstream --- if key ^= line.0 then +-- if key ~= line.0 then -- if outstream then SHUT outstream -- key := line . 0 -- outstream := MAKE_-OUTSTREAM STRCONC(STRINGIMAGE key,'"libdb.text") diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 4890e4ba..ef589edf 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -143,7 +143,7 @@ pmTransFilter s == => (parse := pmParseFromString s) and checkPmParse parse or ['error,'"Illegal search string",'"\vspace{3}\center{{\em Your search string} ",escapeSpecialChars s,'" {\em has incorrect syntax}}"] or/[s . i = char '_* and s.(i + 1) = char '_* - and (i=0 or s . (i - 1) ^= char $charUnderscore) for i in 0..(MAXINDEX s - 1)] + and (i=0 or s . (i - 1) ~= char $charUnderscore) for i in 0..(MAXINDEX s - 1)] => ['error,'"Illegal search string",'"\vspace{3}\center{Consecutive {\em *}'s are not allowed in search patterns}"] s @@ -266,7 +266,7 @@ mkGrepPattern1(x,:options) == --called by mkGrepPattern (and grepConstructName?) sl is [s,:r] => h(r,[$wild1,s,:res]) res := rest res if not MEMQ('w,$options) then - if first res ^= '"" then res := ['"`",:res] + if first res ~= '"" then res := ['"`",:res] else if res is [.,p,:r] and p = $wild1 then res := r "STRCONC"/NREVERSE res remUnderscores s == @@ -283,7 +283,7 @@ mkGrepPattern1(x,:options) == --called by mkGrepPattern (and grepConstructName?) n := SIZE t if startpos < 0 or startpos > n then error "index out of range" k:= startpos - for i in startpos .. n-1 while c ^= ELT(t,i) + for i in startpos .. n-1 while c ~= ELT(t,i) or i > startpos and ELT(t,i-1) = '__ repeat (k := k+1) k addOptions s == --add front anchor @@ -361,7 +361,7 @@ looksLikeDomainForm x == coSig := LASSOC('coSig,CDDR entry) k := #coSig atom x => k = 1 - k ^= #x => false + k ~= #x => false and/[p for key in rest coSig for arg in rest x] where p() == key => looksLikeDomainForm arg @@ -392,7 +392,7 @@ genSearch(filter,:options) == --"Complete" from HD (see man0.ht) and aokSearch if includeDoc? then docSearchAlist := grepConstruct(key,'w,true) docSearchAlist is ['error,:.] => bcErrorPage docSearchAlist - docSearchAlist := [x for x in docSearchAlist | x.0 ^= char 'x]--drop defaults + docSearchAlist := [x for x in docSearchAlist | x.0 ~= char 'x]--drop defaults genSearch1(filter,genSearchTran regSearchAlist,genSearchTran docSearchAlist) genSearchTran alist == [[x,y,:y] for [x,:y] in alist] @@ -486,7 +486,7 @@ genSearchSay(pair,summarize,kind,who,fn) == else htSay('"{\em ",count,'" ",pluralize kind,'"} ") short => 'done - if uniqueCount ^= 1 then + if uniqueCount ~= 1 then htSayStandard '"\indent{4}" htSay '"\newline " htBeginTable() @@ -504,7 +504,7 @@ genSearchSay(pair,summarize,kind,who,fn) == htMakePage [['bcLinks, [id,'"",fn,who + 8*i]]] i := i + #group bcHt '"}" - if uniqueCount ^= 1 then + if uniqueCount ~= 1 then htEndTable() htSayStandard '"\indent{0}" @@ -522,7 +522,7 @@ genSearchUniqueCount(u) == lastid := nil for item in u while count < $browseCountThreshold repeat id := dbGetName item - if id ^= lastid then + if id ~= lastid then count := count + 1 lastid := id count @@ -546,7 +546,7 @@ docSearch filter == --"Documentation" from HD (see man0.ht) key := removeSurroundingStars filter docSearchAlist := grepConstruct(filter,'w,true) docSearchAlist is ['error,:.] => bcErrorPage docSearchAlist - docSearchAlist := [x for x in docSearchAlist | x.0 ^= char 'x] --drop defaults + docSearchAlist := [x for x in docSearchAlist | x.0 ~= char 'x] --drop defaults docSearch1(filter,genSearchTran docSearchAlist) docSearch1(filter,doc) == @@ -581,9 +581,9 @@ sayDocMessage message == htSay('"{\em ") if message is [leftEnd,left,middle,right,rightEnd] then htSay(leftEnd,left,'"}") - if left ^= '"" and left.(MAXINDEX left) = $blank then htBlank() + if left ~= '"" and left.(MAXINDEX left) = $blank then htBlank() htSay middle - if right ^= '"" and right.0 = $blank then htBlank() + if right ~= '"" and right.0 = $blank then htBlank() htSay('"{\em ",right,rightEnd) else htSay message @@ -749,7 +749,7 @@ dbSearch(lines,kind,filter) == --called by attribute, operation, constructor sea dbSearchAbbrev([.,:conlist],kind,filter) == null conlist => emptySearchPage('"abbreviation",filter) kind := intern kind - if kind ^= 'constructor then + if kind ~= 'constructor then conlist := [x for x in conlist | LASSOC('kind,IFCDR IFCDR x) = kind] conlist is [[nam,:.]] => conPage DOWNCASE nam cAlist := [[con,:true] for con in conlist] diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index cfa063f1..6bd3b14a 100644 --- a/src/interp/br-util.boot +++ b/src/interp/br-util.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -387,7 +387,7 @@ bcOpTable(u,fn) == htEndTable() bcNameConTable u == - $bcMultipleNames: local := (#u ^= 1) + $bcMultipleNames: local := (#u ~= 1) bcConTable REMDUP u -- bcConTable u @@ -432,7 +432,7 @@ bcConPredTable(u,conname,:options) == if extractHasArgs pred is [arglist,:pred] then htSay('" {\em of} ") bcConform([conname,:arglist],italicList,true) - if pred ^= 'etc then bcPred(pred,italicList) + if pred ~= 'etc then bcPred(pred,italicList) htSay '"}" htEndTable() @@ -503,7 +503,7 @@ dbSayItems(countOrPrefix,singular,plural,:options) == else if count = 1 then htSay('"1 ",singular) else htSay(count,'" ",plural) for x in options repeat bcHt x - if count ^= 0 then bcHt '":" + if count ~= 0 then bcHt '":" dbBasicConstructor? conname == member(dbSourceFile conname,'("catdef" "coerce")) diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 9afdd7b0..3bf1365f 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -233,7 +233,7 @@ transDoc(conname,doclist) == -- null expectedNumOfArgs => -- checkDocError ['"Unknown constructor name?: ",opOf x] -- x --- expectedNumOfArgs ^= (n := #(IFCDR x)) => +-- expectedNumOfArgs ~= (n := #(IFCDR x)) => -- n = 0 => checkDocError1 -- ['"You must give arguments to the _"Related Domain_": ",x] -- checkDocError @@ -331,16 +331,16 @@ checkTexht u == if not (IFCAR u = $charLbrace) then checkDocError '"First left brace after \texht missing" count := 1 -- drop first argument including braces of \texht - while ((y := IFCAR (u := rest u))^= $charRbrace or count > 1) repeat + while ((y := IFCAR (u := rest u))~= $charRbrace or count > 1) repeat if y = $charLbrace then count := count + 1 if y = $charRbrace then count := count - 1 x := IFCAR (u := rest u) -- drop first right brace of 1st arg if x = '"\httex" and (u := IFCDR u) and (IFCAR u = $charLbrace) then acc := [IFCAR u,:acc] --left brace: add it - while (y := IFCAR (u := rest u)) ^= $charRbrace repeat (acc := [y,:acc]) + while (y := IFCAR (u := rest u)) ~= $charRbrace repeat (acc := [y,:acc]) acc := [IFCAR u,:acc] --right brace: add it x := IFCAR (u := rest u) --left brace: forget it - while IFCAR (u := rest u) ^= $charRbrace repeat 'skip + while IFCAR (u := rest u) ~= $charRbrace repeat 'skip x := IFCAR (u := rest u) --forget right brace: move to next char acc := [x,:acc] u := rest u @@ -432,7 +432,7 @@ checkIsValidType form == main where null conname => nil fn(form,getDualSignatureFromDB conname) fn(form,coSig) == - #form ^= #coSig => form + #form ~= #coSig => form or/[null checkIsValidType x for x in rest form for flag in rest coSig | flag] => nil 'ok @@ -470,7 +470,7 @@ checkGetStringBeforeRightBrace u == -- (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) ~= '"\end" repeat -- middle := [z,:middle] -- w := rest w -- if (y := IFCAR (w := IFCDR w)) = $charLbrace and @@ -491,7 +491,7 @@ checkGetStringBeforeRightBrace u == -- (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) ~= '"\end" repeat -- middle := [z,:middle] -- w := rest w -- if (y := IFCAR (w := IFCDR w)) = $charLbrace and @@ -529,7 +529,7 @@ checkTrimCommented line == --line beginning with % is a comment k = 0 => '"" --remarks beginning with %% are comments - k >= n - 1 or line.(k + 1) ^= char '_% => line + k >= n - 1 or line.(k + 1) ~= char '_% => line k < #line => SUBSTRING(line,0,k) line @@ -538,7 +538,7 @@ htcharPosition(char,line,i) == k := charPosition(char,line,i) k = m => k k > 0 => - line.(k - 1) ^= $charBack => k + line.(k - 1) ~= $charBack => k htcharPosition(char,line,k + 1) 0 @@ -564,7 +564,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 ~= 'constructor then lines := [checkTransformFirsts(first nameSig,first lines,margin),:rest lines] u := checkIndentedLines(lines, margin) @@ -655,7 +655,7 @@ checkGetArgs u == k := getMatchingRightPren(u,6,char '_{,char '_}) or m checkGetArgs SUBSTRING(u,6,k-6) (i := charPosition(char '_(,u,0)) > m => nil - (u . m) ^= char '_) => nil + (u . m) ~= char '_) => nil while (k := charPosition($charComma,u,i + 1)) < m repeat acc := [trimString SUBSTRING(u,i + 1,k - i - 1),:acc] i := k @@ -675,7 +675,7 @@ firstNonBlankPosition(x,:options) == start := IFCAR options or 0 k := -1 for i in start..MAXINDEX x repeat - if x.i ^= $charBlank then return (k := i) + if x.i ~= $charBlank then return (k := i) k checkAddIndented(x,margin) == @@ -706,7 +706,7 @@ checkTrim($x,lines) == main where [trim y for y in lines] wherePP(u) == k := charPosition($charPlus,u,0) - k = #u or charPosition($charPlus,u,k + 1) ^= k + 1 => + k = #u or charPosition($charPlus,u,k + 1) ~= k + 1 => systemError '" Improper comment found" k trim(s) == @@ -728,7 +728,7 @@ checkExtract(header,lines) == j := charPosition(char '_:,u,k) margin := k firstLines := - (k := firstNonBlankPosition(u,j + 1)) ^= -1 => + (k := firstNonBlankPosition(u,j + 1)) ~= -1 => [SUBSTRING(u,j + 1,nil),:rest lines] rest lines --now look for another header; if found skip all rest of these lines @@ -750,7 +750,7 @@ checkFixCommonProblem u == while u repeat x := first u x = $charLbrace and member(next := IFCAR rest u,$HTspadmacros) and - (IFCAR IFCDR rest u ^= $charLbrace) => + (IFCAR IFCDR rest u ~= $charLbrace) => checkDocError ['"Reversing ",next,'" and left brace"] acc := [$charLbrace,next,:acc] --reverse order of brace and command u := rest rest u @@ -1008,7 +1008,7 @@ checkBalance u == => stack := [CAR openClose,:stack] --yes, push the open bracket open := rassoc(x,$checkPrenAlist) => --it is a close bracket! stack is [top,:restStack] => --does corresponding open bracket match? - if open ^= top then --yes: just pop the stack + if open ~= top then --yes: just pop the stack checkDocError ['"Mismatch: left ",checkSayBracket top,'" matches right ",checkSayBracket open] stack := restStack @@ -1088,7 +1088,7 @@ checkLookForLeftBrace(u) == --return line beginning with left brace while u repeat x := first u if x = $charLbrace then return u - x ^= $charBlank => return nil + x ~= $charBlank => return nil u := rest u u @@ -1131,7 +1131,7 @@ checkTransformFirsts(opname,u,margin) == open = char '_[ and (close := char '_]) or open = char '_( and (close := char '_)) => k := getMatchingRightPren(u,j + 1,open,close) - namestring ^= (firstWord := SUBSTRING(u,0,i)) => + namestring ~= (firstWord := SUBSTRING(u,0,i)) => checkDocError ['"Improper first word in comments: ",firstWord] u null k => @@ -1143,7 +1143,7 @@ checkTransformFirsts(opname,u,margin) == k := checkSkipToken(u,j,m) or return u infixOp := INTERN SUBSTRING(u,j,k - j) not GETL(infixOp,'Led) => --case 3 - namestring ^= (firstWord := SUBSTRING(u,0,i)) => + namestring ~= (firstWord := SUBSTRING(u,0,i)) => checkDocError ['"Improper first word in comments: ",firstWord] u #(p := PNAME infixOp) = 1 and (open := p.0) and @@ -1154,13 +1154,13 @@ checkTransformFirsts(opname,u,margin) == STRCONC('"\spad{",SUBSTRING(u,0,k),'"}",SUBSTRING(u,k,nil)) l := checkSkipBlanks(u,k,m) or return u n := checkSkipToken(u,l,m) or return u - namestring ^= PNAME infixOp => + namestring ~= PNAME infixOp => checkDocError ['"Improper initial operator in comments: ",infixOp] u STRCONC('"\spad{",SUBSTRING(u,0,n),'"}",SUBSTRING(u,n,nil)) --case 5 true => -- not ALPHA_-CHAR_-P u.0 => i := checkSkipToken(u,0,m) or return u - namestring ^= (firstWord := SUBSTRING(u,0,i)) => + namestring ~= (firstWord := SUBSTRING(u,0,i)) => checkDocError ['"Improper first word in comments: ",firstWord] u prefixOp := INTERN SUBSTRING(u,0,i) @@ -1172,7 +1172,7 @@ checkTransformFirsts(opname,u,margin) == j > m => u STRCONC('"\spad{",SUBSTRING(u,0,j + 1),'"}",SUBSTRING(u,j + 1,nil)) k := checkSkipToken(u,j,m) or return u - namestring ^= (firstWord := SUBSTRING(u,0,i)) => + namestring ~= (firstWord := SUBSTRING(u,0,i)) => checkDocError ['"Improper first word in comments: ",firstWord] u STRCONC('"\spad{",SUBSTRING(u,0,k),'"}",SUBSTRING(u,k,nil)) diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 34c1ce25..4f5cf5ae 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -133,7 +133,7 @@ enoughArguments(args,sig) == ++ wants its arguments as a Tuple object. wantArgumentsAsTuple: (%List,%Signature) -> %Boolean wantArgumentsAsTuple(args,sig) == - isHomoegenousVarargSignature sig and #args ^= #sig + isHomoegenousVarargSignature sig and #args ~= #sig ++ We are about to seal the (Lisp) definition of a function. ++ Augment the `body' with a declaration for those `parms' @@ -274,7 +274,7 @@ intersectionEnvironment(e,e') == deltaContour([[c,:cl],:el],[[c',:cl'],:el']) == ^el=el' => systemError '"deltaContour" --a cop out for now eliminateDuplicatePropertyLists contourDifference(c,c') where - contourDifference(c,c') == [first x for x in tails c while (x^=c')] + contourDifference(c,c') == [first x for x in tails c while (x~=c')] eliminateDuplicatePropertyLists contour == contour is [[x,:.],:contour'] => LASSOC(x,contour') => @@ -354,7 +354,7 @@ addContour(c,E is [cur,:tail]) == RPLACA(pv,"mode") --check for conflicts with earlier mode if vv:=LASSOC("mode",e) then - if v ^=vv then + if v ~=vv then stackWarning('"The conditional modes %1p and %2p conflict", [v,vv]) LIST c @@ -708,7 +708,7 @@ unStackWarning(msg,args) == nil stackMessage(msg,args == nil) == - if args ^= nil then + if args ~= nil then msg := buildMessage(msg,args) $compErrorMessageStack:= [msg,:$compErrorMessageStack] nil @@ -720,7 +720,7 @@ stackMessageIfNone msg == nil stackAndThrow(msg, args == nil) == - if args ^= nil then + if args ~= nil then msg := buildMessage(msg,args) $compErrorMessageStack:= [msg,:$compErrorMessageStack] THROW("compOrCroak",nil) @@ -964,7 +964,7 @@ getCapsuleDirectoryEntry slot == ++ Update the current capsule directory with entry controlled by ++ predicate `pred'. updateCapsuleDirectory(item,pred) == - pred ^= true => nil + pred ~= true => nil entry := item is ["$",slot,["CONS",["dispatchFunction",fun],:.],:.] => [slot,:fun] item is ["$",slot,["CONS","IDENTITY", @@ -1107,7 +1107,7 @@ foldSpadcall form == mutateCONDFormWithUnaryFunction(form,"foldSpadcall") for args in tails rest form repeat foldSpadcall first args - first form ^= "SPADCALL" => form + first form ~= "SPADCALL" => form fun := lastNode form fun isnt [["getShellEntry","$",slot]] => form null (op := getCapsuleDirectoryEntry slot) => form @@ -1219,10 +1219,10 @@ backendCompileSLAM(name,args,body) == arg := first u app := second u codePart1 := -- look up the value if it is already there - args ^= nil => [["SETQ", g2, ["assoc",g1,al]], ["CDR",g2]] + args ~= nil => [["SETQ", g2, ["assoc",g1,al]], ["CDR",g2]] [al] codePart2 := -- otherwise, compute it. - args ^= nil => [true,["SETQ",g2,app],["SETQ",al,[[g1,:g2],:al]],g2] + args ~= nil => [true,["SETQ",g2,app],["SETQ",al,[[g1,:g2],:al]],g2] [true,["SETQ",al,app]] lamex := ["LAM",arg,["PROG",[g2], ["RETURN",["COND",codePart1,codePart2]]]] @@ -1275,7 +1275,7 @@ backendCompileSPADSLAM(name,args,body) == backendCompile2: %Code -> %Symbol backendCompile2 code == - code isnt [name,[type,args,:body],:junk] or junk ^= nil => + code isnt [name,[type,args,:body],:junk] or junk ~= nil => systemError ['"parenthesis error in: ", code] type = "SLAM" => backendCompileSLAM(name,args,body) LASSQ(name,$clamList) => compClam(name,args,body,$clamList) @@ -1290,7 +1290,7 @@ backendCompile2 code == ++ returns all fuild variables contained in `x'. Fuild variables are ++ identifiers starting with '$', except domain variable names. backendFluidize x == - IDENTP x and x ^= "$" and x ^= "$$" and + IDENTP x and x ~= "$" and x ~= "$$" and (PNAME x).0 = char "$" and not DIGITP((PNAME x).1) => x isAtomicForm x => nil first x = "FLUID" => second x @@ -1308,8 +1308,8 @@ $SpecialVars := [] ++ push `x' into the list of local variables. pushLocalVariable: %Symbol -> %List pushLocalVariable x == - x ^= "$" and (p := PNAME x).0 = char "$" and - p.1 ^= char "," and not DIGITP p.1 => nil + x ~= "$" and (p := PNAME x).0 = char "$" and + p.1 ~= char "," and not DIGITP p.1 => nil PUSH(x,$LocalVars) @@ -1390,7 +1390,7 @@ mutateToBackendCode x == if (u := first x) = "MAKEPROP" and $TRACELETFLAG then RPLACA(x,"MAKEPROP-SAY") u in '(DCQ RELET PRELET SPADLET SETQ %LET) => - if u ^= "DCQ" then + if u ~= "DCQ" then $NEWSPAD or $FUNAME in $traceletFunctions => nconc(x,$FUNNAME__TAIL) RPLACA(x,"LETT") @@ -1403,7 +1403,7 @@ mutateToBackendCode x == PUSH(CADADR x, $FluidVars) rplac(second x, CADADR x) MAPC(function pushLocalVariable, LISTOFATOMS second x) - IDENTP u and GET(u,"ILAM") ^= nil => + IDENTP u and GET(u,"ILAM") ~= nil => RPLACA(x, eval u) mutateToBackendCode x u in '(PROG LAMBDA) => @@ -1469,9 +1469,9 @@ transformToBackendCode x == lvars := [:$FluidVars,:$LocalVars] fluids := S_+($FluidVars,$SpecialVars) body := - fluids ^= nil => + fluids ~= nil => [["PROG",lvars,declareGlobalVariables fluids, ["RETURN",:body]]] - lvars ^= nil or CONTAINED("RETURN",body) => + lvars ~= nil or CONTAINED("RETURN",body) => [["PROG",lvars,["RETURN",:body]]] body -- add reference parameters to the list of special variables. diff --git a/src/interp/category.boot b/src/interp/category.boot index 77b45dfe..190aa792 100644 --- a/src/interp/category.boot +++ b/src/interp/category.boot @@ -138,7 +138,7 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) == v.1 := sigList v.2 := attList v.3 := $Category - if PrincipalAncestor ^= nil then + if PrincipalAncestor ~= nil then for x in 6..#PrincipalAncestor-1 repeat v.x := PrincipalAncestor.x v.4 := [first PrincipalAncestor.4,second PrincipalAncestor.4,OldLocals] @@ -185,8 +185,8 @@ SigListUnion(extra,original) == return nil -- this exits from the innermost for loop original:= delete(x,original) [xsig,xpred,:ximplem]:= x --- if xsig ^= esig then -- not quite strong enough - if CAR xsig ^= CAR esig or CADR xsig ^= CADR esig then +-- if xsig ~= esig then -- not quite strong enough + if CAR xsig ~= CAR esig or CADR xsig ~= CADR esig then -- the new version won't get confused by "constant"markers if ximplem is [["Subsumed",:.],:.] then original := [x,:original] @@ -316,7 +316,7 @@ MachineLevelSubset(a,b) == --true if a is a machine-level subset of b a=b => true b is ["Union",:blist] and member(a,blist) and - (and/[STRINGP x for x in blist | x^=a]) => true + (and/[STRINGP x for x in blist | x~=a]) => true --all other branches must be distinct objects not null isSubDomain(a,b) --we assume all subsets are true at the machine level diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index 1a3312c6..25c909b7 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -1,6 +1,6 @@ -- Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -218,7 +218,7 @@ encodeCategoryAlist(id,alist) == b u:= assoc(key,newAl) => argl => RPLACD(u,encodeUnion(id,first newEntry,rest u)) - if newEntry ^= rest u then + if newEntry ~= rest u then p:= moreGeneralCategoryPredicate(id,newEntry,rest u) => RPLACD(u,p) sayMSG '"Duplicate entries:" PRINT [newEntry,rest u] diff --git a/src/interp/clam.boot b/src/interp/clam.boot index a0414464..58e056fb 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -168,7 +168,7 @@ compClam(op,argl,body,$clamList) == op compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == - --Note: when cacheNameOrNil^=nil, it names a global hashtable + --Note: when cacheNameOrNil~=nil, it names a global hashtable -- cacheNameOrNil => compHashGlobal(op,argl,body,cacheNameOrNil,eqEtc,countFl) -- This branch to compHashGlobal is now omitted; as a result, @@ -176,7 +176,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == -- (<argument list>, <reference count>,:<value>) -- where the reference count is optional - if cacheNameOrNil and cacheNameOrNil^='_$ConstructorCache then + if cacheNameOrNil and cacheNameOrNil~='_$ConstructorCache then keyedSystemError("S2GE0010",[op]) --restriction due to omission of call to hputNewValue (see *** lines below) @@ -225,7 +225,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == getCode:= null argl => ['HGET,cacheName,MKQ op] cacheNameOrNil => - eqEtc^='EQUAL => + eqEtc ~= 'EQUAL => ['lassocShiftWithFunction,cacheArgKey, ['HGET,cacheNameOrNil,MKQ op],MKQ eqEtc] ['lassocShift,cacheArgKey,['HGET,cacheNameOrNil,MKQ op]] @@ -279,7 +279,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == op compHashGlobal(op,argl,body,cacheName,eqEtc,countFl) == - --Note: when cacheNameOrNil^=nil, it names a global hashtable + --Note: when cacheNameOrNil~=nil, it names a global hashtable if (not MEMQ(eqEtc,'(UEQUAL))) then sayBrightly "for hash option, only EQ, CVEC, and UEQUAL are allowed" @@ -394,7 +394,7 @@ displayCacheFrequency al == TERPRI() mkCircularCountAlist(cl,len) == - for [x,count,:.] in cl for i in 1..len while x ^= '_$failed repeat + for [x,count,:.] in cl for i in 1..len while x ~= '_$failed repeat u:= assoc(count,al) => RPLACD(u,1 + CDR u) if INTEGERP $reportFavoritesIfNumber and count >= $reportFavoritesIfNumber then sayBrightlyNT [" ",count," "] @@ -490,7 +490,7 @@ clamStats() == for [op,kind,:.] in $clamList repeat cacheVec:= GETL(op,'cacheInfo) or systemErrorHere ["clamStats",op] prefix:= - $reportCounts^= true => nil + $reportCounts ~= true => nil hitCounter:= INTERNL(op,'";hit") callCounter:= INTERNL(op,'";calls") res:= ["%b",eval hitCounter,"/",eval callCounter,"%d","calls to "] @@ -611,7 +611,7 @@ hputNewProp(ht,op,argList,val) == listTruncate(l,n) == u:= l n:= QSSUB1 n - while n ^= 0 and null atom u repeat + while n ~= 0 and null atom u repeat n:= QSSUB1 n u:= QCDR u if null atom u then diff --git a/src/interp/clammed.boot b/src/interp/clammed.boot index f89c9b14..b4927b8f 100644 --- a/src/interp/clammed.boot +++ b/src/interp/clammed.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -114,8 +114,8 @@ isValidType form == null (sig := getConstructorSignature op) => nil [.,:cl] := sig -- following line is needed to deal with mutable domains - if # cl ^= # argl and GENSYMP last argl then argl:= DROP(-1,argl) - # cl ^= # argl => nil + if # cl ~= # argl and GENSYMP last argl then argl:= DROP(-1,argl) + # cl ~= # argl => nil cl:= replaceSharps(cl,form) and/[isValid for x in argl for c in cl] where isValid() == categoryForm?(c) => @@ -124,7 +124,7 @@ isValidType form == -- domain constructors are not considered valid arguments (yet). x' := opOf x not atom x' or not IDENTP x' => true -- surely not constructors - getConstructorKindFromDB x' ^= "domain" + getConstructorKindFromDB x' ~= "domain" selectMms1(op,tar,args1,args2,$Coerce) == -- for new compiler/old world compatibility, sometimes have to look @@ -175,7 +175,7 @@ isLegitimateMode(t,hasPolyMode,polyVarList) == t := equiType t vl := isPolynomialMode t => - if vl^='all then + if vl~='all then var:= or/[(x in polyVarList => x;nil) for x in vl] => return false listOfDuplicates vl => return false polyVarList:= union(vl,polyVarList) diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 13cb5951..344463ad 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -131,7 +131,7 @@ compOrCroak1(x,m,e,compFn) == [first al,:compactify rest al] $level: local := #$s errorMessage:= - $compErrorMessageStack ^= nil => first $compErrorMessageStack + $compErrorMessageStack ~= nil => first $compErrorMessageStack "unspecified error" $scanIfTrue => stackSemanticError(errorMessage,mkErrorExpr $level) @@ -174,7 +174,7 @@ comp2(x,m,e) == [y,m',e]:= comp3(x,m,e) or return nil --if null atom y and isDomainForm(y,e) then e := addDomain(x,e) --line commented out to prevent adding derived domain forms - m^=m' and ($bootStrapMode or isDomainForm(m',e))=>[y,m',addDomain(m',e)] + m~=m' and ($bootStrapMode or isDomainForm(m',e))=>[y,m',addDomain(m',e)] --isDomainForm test needed to prevent error while compiling Ring --$bootStrapMode-test necessary for compiling Ring in $bootStrapMode [y,m',e] @@ -219,7 +219,7 @@ emitLocalCallInsn(op,args,e) == [op',:args,"$"] applyMapping([op,:argl],m,e,ml) == - #argl^=#ml-1 => nil + #argl~=#ml-1 => nil isCategoryForm(first ml,e) => --is op a functor? pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList] @@ -238,14 +238,14 @@ applyMapping([op,:argl],m,e,ml) == atom op and not(op in $formalArgList) and null (u := get(op,"value",e)) => emitLocalCallInsn(op,argl',e) -- Compiler synthetized operators are inline. - u ^= nil and u.expr is ["XLAM",:.] => ["call",u.expr,:argl'] + u ~= nil and u.expr is ["XLAM",:.] => ["call",u.expr,:argl'] ['call,['applyFun,op],:argl'] pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList] convert([form,SUBLIS(pairlis,first ml),e],m) -- This version tends to give problems with #1 and categories -- applyMapping([op,:argl],m,e,ml) == --- #argl^=#ml-1 => nil +-- #argl~=#ml-1 => nil -- mappingHasCategoryTarget := -- isCategoryForm(first ml,e) => --is op a functor? -- form:= [op,:argl'] @@ -282,7 +282,7 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) == if STRINGP x then x:= INTERN x for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat [.,.,e]:= compMakeDeclaration(v,m,e) - (vl ^= nil) and not hasFormalMapVariable(x, vl) => return + (vl ~= nil) and not hasFormalMapVariable(x, vl) => return [u,.,.] := comp([x,:vl],m',e) or return nil extractCodeAndConstructTriple(u, m, oldE) null vl and (t := comp([x], m', e)) => return @@ -647,7 +647,7 @@ getFormModemaps(form is [op,:argl],e) == -- Within default implementations, modemaps cannot mention the -- current domain. if $insideCategoryPackageIfTrue then - modemapList := [x for x in modemapList | x is [[dom,:.],:.] and dom ^= '$] + modemapList := [x for x in modemapList | x is [[dom,:.],:.] and dom ~= '$] if op="elt" then modemapList:= eltModemapFilter(LAST argl,modemapList,e) or return nil else @@ -701,7 +701,7 @@ seteltModemapFilter(name,mmList,e) == compApplication(op,argl,m,T) == e := T.env T.mode is ['Mapping, retm, :argml] => - #argl ^= #argml => nil + #argl ~= #argml => nil retm := resolve(m, retm) retm = $Category or isCategoryForm(retm,e) => nil -- not handled argTl := [[.,.,e] := comp(x,m,e) or return "failed" @@ -732,7 +732,7 @@ reshapeArgumentList(form,sig) == form substituteIntoFunctorModemap(argl,modemap is [[dc,:sig],:.],e) == - #dc^=#sig => + #dc~=#sig => keyedSystemError("S2GE0016",['"substituteIntoFunctorModemap", '"Incompatible maps"]) #argl=#rest sig => @@ -826,7 +826,7 @@ setqSingle(id,val,m,E) == eval or return nil where eval() == T:= comp(val,m'',E) => T - not get(id,"mode",E) and m'' ^= (maxm'':=maximalSuperType m'') and + not get(id,"mode",E) and m'' ~= (maxm'':=maximalSuperType m'') and (T:=comp(val,maxm'',E)) => T (T:= comp(val,$EmptyMode,E)) and getmode(T.mode,E) => assignError(val,T.mode,id,m'') @@ -887,7 +887,7 @@ setqMultiple(nameList,val,m,e) == comp(t,$EmptyMode,e) is [.,["RecordCategory",:l],.] => [[name,:mode] for [":",name,mode] in l] stackMessage('"no multiple assigns to mode: %1p",[t]) - #nameList^=#selectorModePairs => + #nameList~=#selectorModePairs => stackMessage('"%1b must decompose into %2 components",[val,#nameList]) 3 --generate code; return assignList:= @@ -897,7 +897,7 @@ setqMultiple(nameList,val,m,e) == else [MKPROGN [x,:assignList,g],m',e] setqMultipleExplicit(nameList,valList,m,e) == - #nameList^=#valList => + #nameList~=#valList => stackMessage('"Multiple assignment error; # of items in: %1b must = # in: %2",[nameList,valList]) gensymList:= [genVariable() for name in nameList] assignList:= @@ -1088,14 +1088,14 @@ compLeave(["leave",level,x],m,e) == [["TAGGEDexit",index,u],m,e] jumpFromLoop(kind,key) == - null $exitModeStack or kind ^= $loopKind => + null $exitModeStack or kind ~= $loopKind => stackAndThrow('"You can use %1b only in %2b loop",[key,kind]) false true compBreak: (%Symbol,%Mode,%Env) -> %Maybe %Triple compBreak(x,m,e) == - x ^= "break" or not jumpFromLoop("REPEAT",x) => nil + x ~= "break" or not jumpFromLoop("REPEAT",x) => nil index:= #$exitModeStack-1-$leaveLevelStack.0 $breakCount := $breakCount + 1 u := coerce(["$NoValue",$Void,e],$exitModeStack.index) or return nil @@ -1105,7 +1105,7 @@ compBreak(x,m,e) == compIterate: (%Symbol,%Mode,%Env) -> %Maybe %Triple compIterate(x,m,e) == - x ^= "iterate" or not jumpFromLoop("REPEAT",x) => nil + x ~= "iterate" or not jumpFromLoop("REPEAT",x) => nil $iterateCount := $iterateCount + 1 -- We don't really produce a value; but we cannot adequately convey -- that to the current 'EXIT' structure. So, pretend we have an @@ -1134,9 +1134,9 @@ compReturn(["return",x],m,e) == ++ `lang'. Return the mode of its local declaration (import). getExternalSymbolMode(op,lang,e) == lang = "Builtin" => "%Thing" -- for the time being - lang ^= "C" => + lang ~= "C" => stackAndThrow('"Sorry: %b Foreign %1b %d is invalid at the moment",[lang]) - get(op,"%Lang",e) ^= lang => + get(op,"%Lang",e) ~= lang => stackAndThrow('"%1bp is not known to have language linkage %2bp",[op,lang]) getmode(op,e) or stackAndThrow('"Operator %1bp is not in scope",[op]) @@ -1145,7 +1145,7 @@ compElt(form,m,E) == form isnt ["elt",aDomain,anOp] => compForm(form,m,E) aDomain="Lisp" or (aDomain is ["Foreign",lang] and lang="Builtin") => [anOp',m,E] where anOp'() == (anOp = $Zero => 0; anOp = $One => 1; anOp) - lang ^= nil => + lang ~= nil => opMode := getExternalSymbolMode(anOp,lang,E) op := get(anOp,"%Link",E) or anOp convert([op,opMode,E],m) @@ -1164,7 +1164,7 @@ compElt(form,m,E) == [anOp,aDomain,mmList]) mmList.(0) [sig,[pred,val]]:= modemap - #sig^=2 and ^val is ["elt",:.] => nil --what does the second clause do ???? + #sig~=2 and ^val is ["elt",:.] => nil --what does the second clause do ???? val := genDeltaEntry [opOf anOp,:modemap] convert([["call",val],first rest sig,E], m) --implies fn calls used to access constants compForm(form,m,E) @@ -1647,7 +1647,7 @@ coerceEasy(T,m) == satisfies(val,pred) == pred=false or pred=true => pred vars := findVMFreeVars pred - vars ^= nil and vars isnt ["#1"] => false + vars ~= nil and vars isnt ["#1"] => false eval ["LET",[["#1",val]],pred] @@ -1656,10 +1656,10 @@ satisfies(val,pred) == ++ in terms of sub-domain relationship). Otherwise, return nil. commonSuperType(m,m') == lineage := [m'] - while (t := superType m') ^= nil repeat + while (t := superType m') ~= nil repeat lineage := [t,:lineage] m' := t - while m ^= nil repeat + while m ~= nil repeat member(m,lineage) => return m m := superType m @@ -1845,7 +1845,7 @@ compComma(form,m,e) == resolve(din,dout) == din=$NoValueMode or dout=$NoValueMode => $NoValueMode dout=$EmptyMode => din - din^=dout and (STRINGP din or STRINGP dout) => + din~=dout and (STRINGP din or STRINGP dout) => modeEqual(dout,$String) => dout modeEqual(din,$String) => nil mkUnion(din,dout) @@ -1855,7 +1855,7 @@ modeEqual(x,y) == -- this is the late modeEqual -- orders Unions atom x or atom y => x=y - #x ^=#y => nil + #x ~= #y => nil x is ['Union,:xl] and y is ['Union,:yl] => for x1 in xl repeat for y1 in yl repeat @@ -1885,7 +1885,7 @@ compCat(form is [functorName,:argl],m,e) == [funList,e]:= FUNCALL(fn,form,form,e) catForm:= ["Join",'(SetCategory),["CATEGORY","domain",: - [["SIGNATURE",op,sig] for [op,sig,.] in funList | op^="="]]] + [["SIGNATURE",op,sig] for [op,sig,.] in funList | op~="="]]] --RDJ: for coercion purposes, it necessary to know it's a Set; I'm not --sure if it uses any of the other signatures(see extendsCategoryForm) [form,catForm,e] @@ -1920,7 +1920,7 @@ compApplyModemap(form,modemap,$e) == -- $e is the current environment -- 0. fail immediately if #argl=#margl - if #argl^=#margl then return nil + if #argl~=#margl then return nil -- 1. use modemap to evaluate arguments, returning failed if -- not possible @@ -1964,7 +1964,7 @@ compResolveCall(op,argTs,m,$e) == not coerceable(mm.mmTarget,m,$e) =>nil compViableModemap(op,argTs,mm) isnt [f,Ts] => nil coerce([["call",f,:[T.expr for T in Ts]],mm.mmTarget,$e],m) - #outcomes ^= 1 => nil + #outcomes ~= 1 => nil first outcomes --% %Match @@ -2057,7 +2057,7 @@ compRecoverGuard(x,t,sn,sm,e) == -- underlying type is t. -- -- 0. Type recovery is for expressions of type 'Any'. - (sm = "$" => $functorForm; sm) ^= $Any => + (sm = "$" => $functorForm; sm) ~= $Any => stackAndThrow('"Scrutinee must be of type %b Any %d in type recovery alternative of case pattern",nil) -- 1. Do some preprocessing if this is existential type recovery. t is ["%Exist",var,t'] => @@ -2066,7 +2066,7 @@ compRecoverGuard(x,t,sn,sm,e) == -- We have a univariate type scheme. At the moment we insist -- that the body of the type scheme be identical to the type -- variable. This restriction should be lifted in future work. - not IDENTP t' or t' ^= var' => + not IDENTP t' or t' ~= var' => stackAndThrow('"Sorry: type %1b too complex",[t']) not isCategoryForm(cat',e) => stackAndThrow('"Expression %1b does not designate a category",[cat']) @@ -2148,7 +2148,7 @@ compAlternativeGuard(sn,sm,pat,e) == CONSP sn => pat isnt ["%Comma",:.] => stackAndThrow('"Pattern must be a tuple for a tuple scrutinee",nil) - #sn ^= #rest pat => + #sn ~= #rest pat => stackAndThrow('"Tuple pattern must match tuple scrutinee in length",nil) inits := nil guards := nil @@ -2243,7 +2243,7 @@ compReduce(form,m,e) == compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) == [collectOp,:itl,body]:= collectForm if STRINGP op then op:= INTERN op - collectOp ^= "COLLECT" => systemError ['"illegal reduction form:",form] + collectOp ~= "COLLECT" => systemError ['"illegal reduction form:",form] $sideEffectsList: local := nil $until: local := nil $initList: local := nil diff --git a/src/interp/database.boot b/src/interp/database.boot index 8b3b9e1c..874db5ae 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -406,7 +406,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 ~= 'isFreeFunction and atom c => [a,b,[c]] x --pp pred [mmpat, patternAlist, partial, patvars] := @@ -466,7 +466,7 @@ fixUpPredicate(predClause, domainPreds, partial, sig) == [predicate, fn, :skip] := predClause if first predicate = "AND" then predicates := APPEND(domainPreds,rest predicate) - else if predicate ^= MKQ "T" + else if predicate ~= MKQ "T" --was->then predicates:= REVERSE [predicate, :domainPreds] then predicates:= [predicate, :domainPreds] else predicates := domainPreds or [predicate] @@ -577,7 +577,7 @@ getSystemModemaps(op,nargs) == mml:= getOperationFromDB op => mms := NIL for (x := [[.,:sig],.]) in mml repeat - (NUMBERP nargs) and (nargs ^= #QCDR sig) => 'iterate + (NUMBERP nargs) and (nargs ~= #QCDR sig) => 'iterate $getUnexposedOperations or isFreeFunctionFromMm(x) or isExposedConstructor(getDomainFromMm(x)) => mms := [x,:mms] 'iterate @@ -718,7 +718,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 ~= '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 f0d9cb16..d0164940 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -207,11 +207,11 @@ checkRepresentation(addForm,body,env) == -- Locate possible Rep definition for [stmt,:.] in tails body repeat stmt is ["%LET","Rep",val] => - domainRep ^= nil => + domainRep ~= nil => stackAndThrow('"You cannot assign to constant domain %1b",["Rep"]) if addForm = val then stackWarning('"OpenAxiom suggests removing assignment to %1b",["Rep"]) - else if addForm ^= nil then + else if addForm ~= nil then stackWarning('"%1b differs from the base domain",["Rep"]) return hasAssignRep := true stmt is ["MDEF",["Rep",:.],:.] => @@ -221,12 +221,12 @@ checkRepresentation(addForm,body,env) == checkRepresentation(nil,l,env) stmt isnt ["DEF",[op,:args],sig,.,val] => nil -- skip for now. op in '(rep per) => - domainRep ^= nil => + domainRep ~= nil => stackAndThrow('"You cannot define implicitly generated %1b",[op]) viewFuns := [op,:viewFuns] - op ^= "Rep" => nil -- we are only interested in Rep definition + op ~= "Rep" => nil -- we are only interested in Rep definition domainRep := val - viewFuns ^= nil => + viewFuns ~= nil => stackAndThrow('"You cannot define both %1b and %2b",["Rep",:viewFuns]) -- A package has no "%". $functorKind = "package" => @@ -234,9 +234,9 @@ checkRepresentation(addForm,body,env) == -- It is a mistake to define Rep in category defaults $insideCategoryPackageIfTrue => stackAndThrow('"You cannot define %1b in category defaults",["Rep"]) - if args ^= nil then + if args ~= nil then stackAndThrow('"%1b does take arguments",["Rep"]) - if first sig ^= nil then + if first sig ~= nil then stackAndThrow('"You cannot specify type for %1b",["Rep"]) -- Now, trick the rest of the compiler into believing that -- `Rep' was defined the Old Way, for lookup purpose. @@ -249,7 +249,7 @@ checkRepresentation(addForm,body,env) == $useRepresentationHack := true -- Domain extensions with no explicit Rep definition have the -- the base domain as representation (at least operationally). - else if null domainRep and addForm ^= nil then + else if null domainRep and addForm ~= nil then if $functorKind = "domain" and addForm isnt ["%Comma",:.] then domainRep := addForm is ["SubDomain",dom,.] => @@ -286,7 +286,7 @@ compDefine1(form,m,e) == -- 2. if signature list for arguments is not empty, replace ('DEF,..) by -- ('where,('DEF,..),..) with an empty signature list; -- otherwise, fill in all NILs in the signature - or/[x ^= nil for x in rest signature] => compDefWhereClause(form,m,e) + or/[x ~= nil for x in rest signature] => compDefWhereClause(form,m,e) signature.target=$Category => compDefineCategory(form,m,e,nil,$formalArgList) isDomainForm(rhs,e) and not $insideFunctorIfTrue => @@ -314,7 +314,7 @@ compDefineAddSignature([op,:argl],signature,e) == hasFullSignature(argl,[target,:ml],e) == target => u:= [m or get(x,"mode",e) or return 'failed for x in argl for m in ml] - u^='failed => [target,:u] + u~='failed => [target,:u] addEmptyCapsuleIfNecessary: (%Form,%Form) -> %Form addEmptyCapsuleIfNecessary(target,rhs) == @@ -493,7 +493,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, -- 4. compile body in environment of %type declarations for arguments op':= $op -- following line causes cats with no with or Join to be fresh copies - if opOf(formalBody)^='Join and opOf(formalBody)^='mkCategory then + if opOf(formalBody)~='Join and opOf(formalBody)~='mkCategory then formalBody := ['Join, formalBody] body:= optFunctorBody (compOrCroak(formalBody,signature'.target,e)).expr if $extraParms then @@ -557,7 +557,7 @@ compDefineCategory(df,m,e,prefix,fal) == -- make sure we do have some minimal internal coherence. ctor := opOf second df kind := getConstructorKindFromDB ctor - kind ^= "category" => throwKeyedMsg("S2IC0016",[ctor,"category",kind]) + kind ~= "category" => throwKeyedMsg("S2IC0016",[ctor,"category",kind]) $insideFunctorIfTrue or not $LISPLIB or $compileDefaultsOnly => compDefineCategory1(df,m,e,prefix,fal) compDefineLisplib(df,m,e,prefix,fal,'compDefineCategory1) @@ -698,7 +698,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], $insideFunctorIfTrue:= false if $LISPLIB then $lisplibKind:= - $functorTarget is ["CATEGORY",key,:.] and key^="domain" => 'package + $functorTarget is ["CATEGORY",key,:.] and key~="domain" => 'package 'domain $lisplibForm:= form if null $bootStrapMode then @@ -1052,7 +1052,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], getSignatureFromMode(form,e) == getmode(opOf form,e) is ['Mapping,:signature] => - #form^=#signature => stackAndThrow ["Wrong number of arguments: ",form] + #form~=#signature => stackAndThrow ["Wrong number of arguments: ",form] EQSUBSTLIST(rest form,take(#rest form,$FormalMapVariableList),signature) candidateSignatures(op,nmodes,slot1) == @@ -1526,11 +1526,11 @@ doItIf(item is [.,p,x,y],$predl,$e) == olde:= $e [p',.,$e]:= compCompilerPredicate(p,$e) or userError ['"not a Boolean:",p] oldFLP:=$functorLocalParameters - if x^="%noBranch" then + if x~="%noBranch" then compSingleCapsuleItem(x,[p,:$predl],getSuccessEnvironment(p,$e)) x':=localExtras(oldFLP) oldFLP:=$functorLocalParameters - if y^="%noBranch" then + if y~="%noBranch" then compSingleCapsuleItem(y,[["not",p],:$predl],getInverseEnvironment(p,olde)) y':=localExtras(oldFLP) RPLACA(item,"COND") @@ -1627,7 +1627,7 @@ mkExplicitCategoryFunction(domainOrPackage,sigList,atList) == parameters:= REMDUP ("append"/ - [[x for x in sig | IDENTP x and x^='_$] + [[x for x in sig | IDENTP x and x~='_$] for ["QUOTE",[[.,sig,:.],:.]] in sigList]) wrapDomainSub(parameters,body) @@ -1649,7 +1649,7 @@ DomainSubstitutionFunction(parameters,body) == first body="QUOTE" => body PAIRP $definition and isFunctor first body and - first body ^= first $definition + first body ~= first $definition => ['QUOTE,optimize body] [Subst(parameters,u) for u in body] not (body is ["Join",:.]) => body @@ -1691,7 +1691,7 @@ compCategoryItem(x,predl,env) == a is ["or",p,q] => compCategoryItem(["IF",p,b,["IF",q,COPY b,c]],predl,env) predl':= [a,:predl] - if b^="%noBranch" then + if b~="%noBranch" then b is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl',env) compCategoryItem(b,predl',env) diff --git a/src/interp/format.boot b/src/interp/format.boot index 3d72f266..cda5f73d 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -619,7 +619,7 @@ formTuple2String argl == isInternalFunctionName(op) == (not IDENTP(op)) or (op = "*") or (op = "**") => NIL - (1 = SIZE(op':= PNAME op)) or (char("*") ^= op'.0) => NIL + (1 = SIZE(op':= PNAME op)) or (char("*") ~= op'.0) => NIL -- if there is a semicolon in the name then it is the name of -- a compiled spad function null (e := STRPOS('"_;",op',1,NIL)) => NIL diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot index 78918e52..d568e729 100644 --- a/src/interp/fortcall.boot +++ b/src/interp/fortcall.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -749,7 +749,7 @@ inFirstNotSecond(f,s)== multiToUnivariate f == -- Take an AnonymousFunction, replace the bound variables by references to -- elements of a vector, and compile it. - (first f) ^= "+->" => error "in multiToUnivariate: not an AnonymousFunction" + (first f) ~= "+->" => error "in multiToUnivariate: not an AnonymousFunction" if PAIRP CADR f then vars := CDADR f -- throw away '%Comma at start of variable list else @@ -766,12 +766,12 @@ multiToUnivariate f == functionAndJacobian f == -- Take a mapping into n functions of n variables, produce code which will -- evaluate function and jacobian values. - (first f) ^= "+->" => error "in functionAndJacobian: not an AnonymousFunction" + (first f) ~= "+->" => error "in functionAndJacobian: not an AnonymousFunction" if PAIRP CADR f then vars := CDADR f -- throw away '%Comma at start of variable list else vars := [CADR f] - #(vars) ^= #(CDADDR f) => + #(vars) ~= #(CDADDR f) => error "number of variables should equal number of functions" funBodies := COPY_-TREE CDADDR f jacBodies := [:[DF(f,v) for v in vars] for f in funBodies] where @@ -794,7 +794,7 @@ functionAndJacobian f == vectorOfFunctions f == -- Take a mapping into n functions of m variables, produce code which will -- evaluate function values. - (first f) ^= "+->" => error "in vectorOfFunctions: not an AnonymousFunction" + (first f) ~= "+->" => error "in vectorOfFunctions: not an AnonymousFunction" if PAIRP CADR f then vars := CDADR f -- throw away '%Comma at start of variable list else diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 0a1a700c..18d412ec 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -543,7 +543,7 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) == and (u:= SetFunctionSlots(SUBLIS(slist,sig),['ELT,instantiatedBase,i],flag, - 'adding))^=nil] + 'adding))~=nil] --The code from here to the end is designed to replace repeated LOAD/STORE --combinations (SETELT ...(ELT ..)) by MVCs where this is practicable copyvec := newShell (1+n) @@ -585,14 +585,14 @@ DescendCode(code,flag,viewAssoc,EnvToPass) == isMacro(code,$e) => nil --RDJ: added 3/16/83 code is ['add,base,:codelist] => codelist:= - [v for u in codelist | (v:= DescendCode(u,flag,viewAssoc,EnvToPass))^=nil] + [v for u in codelist | (v:= DescendCode(u,flag,viewAssoc,EnvToPass))~=nil] -- must do this first, to get this overriding Add code ['PROGN,:DescendCodeAdd(base,flag),:codelist] code is ['PROGN,:codelist] => ['PROGN,: --Two REVERSEs leave original order, but ensure last guy wins NREVERSE [v for u in REVERSE codelist | - (v:= DescendCode(u,flag,viewAssoc,EnvToPass))^=nil]] + (v:= DescendCode(u,flag,viewAssoc,EnvToPass))~=nil]] code is ['COND,:condlist] => c:= [[u2:= ProcessCond first u,:q] for u in condlist] where q() == null u2 => nil diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot index b822d73a..96c2f298 100644 --- a/src/interp/g-cndata.boot +++ b/src/interp/g-cndata.boot @@ -134,13 +134,13 @@ constructorAbbreviationErrorCheck(c,a,typ,errmess) == if typ = "category" and siz > 7 then throwKeyedErrorMsg('precompilation,"S2IL0021",NIL) if siz > 8 then throwKeyedErrorMsg('precompilation,"S2IL0006",NIL) - if s ^= UPCASE s then throwKeyedMsg("S2IL0006",NIL) + if s ~= UPCASE s then throwKeyedMsg("S2IL0006",NIL) abb := getConstructorAbbreviationFromDB c name:= getConstructorFullNameFromDB a type := getConstructorKindFromDB c - a=abb and c^=name => lisplibError(c,a,typ,abb,name,type,'duplicateAbb) - a=name and c^=name => lisplibError(c,a,typ,abb,name,type,'abbIsName) - c=name and typ^=type => lisplibError(c,a,typ,abb,name,type,'wrongType) + a=abb and c~=name => lisplibError(c,a,typ,abb,name,type,'duplicateAbb) + a=name and c~=name => lisplibError(c,a,typ,abb,name,type,'abbIsName) + c=name and typ~=type => lisplibError(c,a,typ,abb,name,type,'wrongType) abbreviationError(c,a,typ,abb,name,type,error) == sayKeyedMsg("S2IL0009",[a,typ,c]) @@ -225,11 +225,11 @@ condAbbrev(arglist,argtypes) == res condUnabbrev(op,arglist,argtypes,modeIfTrue) == - #arglist ^= #argtypes and argtypes isnt [["Tuple",t]] => + #arglist ~= #argtypes and argtypes isnt [["Tuple",t]] => throwKeyedMsg("S2IL0014",[op,plural(#argtypes,'"argument"), bright(#arglist)]) -- fix up argument list for unary constructor taking tuples. - t ^= nil => + t ~= nil => categoryForm? t => [["tuple",:[unabbrev1(arg,modeIfTrue) for arg in arglist]]] [["tuple",:arglist]] diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 9e08d9a8..12cdc4c7 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -398,7 +398,7 @@ isSimpleVMForm form == ++ on the program point where it is evaluated. isFloatableVMForm: %Code -> %Boolean isFloatableVMForm form == - atom form => form ^= "$" + atom form => form ~= "$" form is ["QUOTE",:.] => true MEMQ(first form, $simpleVMoperators) and "and"/[isFloatableVMForm arg for arg in rest form] diff --git a/src/interp/g-timer.boot b/src/interp/g-timer.boot index 09a272e7..6d09f945 100644 --- a/src/interp/g-timer.boot +++ b/src/interp/g-timer.boot @@ -81,7 +81,7 @@ makeLongStatStringByProperty _ cl := CAR LASSOC('other,listofnames) cl := CAR LASSOC(cl,listofclasses) PUT(cl,classproperty, otherStatTotal + GETL(cl,classproperty)) - if flag ^= 'long then + if flag ~= 'long then total := 0 str := '"" for [class,name,:ab] in listofclasses repeat @@ -140,7 +140,7 @@ startTimingProcess name == if EQ(name, 'load) then statRecordLoadEvent() stopTimingProcess name == - (name ^= peekTimedName()) and null $InteractiveMode => + (name ~= peekTimedName()) and null $InteractiveMode => keyedSystemError("S2GL0015",[name,peekTimedName()]) updateTimedName peekTimedName() popTimedName() diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 18e08c65..b01fbcf5 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -418,7 +418,7 @@ centerString(text,width,fillchar) == for i in 1..(f.0) repeat fill1 := STRCONC(fillchar,fill1) fill2:= fill1 - if f.1 ^= 0 then fill1 := STRCONC(fillchar,fill1) + if f.1 ~= 0 then fill1 := STRCONC(fillchar,fill1) [fill1,text,fill2] stringPrefix?(pref,str) == @@ -450,7 +450,7 @@ dropLeadingBlanks str == nb := NIL i := 0 while (i < l) and not nb repeat - if SCHAR(str,i) ^= char " " then nb := i + if SCHAR(str,i) ~= char " " then nb := i else i := i + 1 nb = 0 => str nb => SUBSTRING(str,nb,NIL) diff --git a/src/interp/guess.boot b/src/interp/guess.boot index ccf9d9d2..db70c37c 100644 --- a/src/interp/guess.boot +++ b/src/interp/guess.boot @@ -275,7 +275,7 @@ rotateWordList u == deltaWordEntry(word,entry) == word = entry => 0 - word.0 ^= entry.0 => 1000 + word.0 ~= entry.0 => 1000 #word > 2 and stringPrefix?(word,entry) => 1 ABS(diff := SIZE word - SIZE entry) > 4 => 1000 canForgeWord(word,entry) diff --git a/src/interp/ht-root.boot b/src/interp/ht-root.boot index 49277330..b8340902 100644 --- a/src/interp/ht-root.boot +++ b/src/interp/ht-root.boot @@ -66,7 +66,7 @@ htSystemVariables() == main where classlevel := $UserLevel $levels : local := '(compiler development interpreter) $heading : local := nil - while classlevel ^= first $levels repeat $levels := rest $levels + while classlevel ~= first $levels repeat $levels := rest $levels table := NREVERSE fn($setOptions,nil,true) htInitPage('"System Variables",nil) htSay '"\beginmenu" @@ -283,9 +283,9 @@ mkUnixPattern s == starPositions := REVERSE [i for i in 1..(-1 + MAXINDEX u) | u.i = $wild] for i in starPositions repeat u := STRCONC(SUBSTRING(u,0,i),'".*",SUBSTRING(u,i + 1,nil)) - if u.0 ^= $wild then u := STRCONC('"[^a-zA-Z]",u) + if u.0 ~= $wild then u := STRCONC('"[^a-zA-Z]",u) else u := SUBSTRING(u,1,nil) - if u.(k := MAXINDEX u) ^= $wild then u := STRCONC(u,'"[^a-zA-Z]") + if u.(k := MAXINDEX u) ~= $wild then u := STRCONC(u,'"[^a-zA-Z]") else u := SUBSTRING(u,0,k) u diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot index 9c63e996..77e2424a 100644 --- a/src/interp/ht-util.boot +++ b/src/interp/ht-util.boot @@ -292,7 +292,7 @@ htLispLinks(links,:option) == htLispMemoLinks(links) == htLispLinks(links,true) -beforeAfter(x,u) == [[y for [y,:r] in tails u while x ^= y],r] +beforeAfter(x,u) == [[y for [y,:r] in tails u while x ~= y],r] mkCurryFun(fun, val) == name := GENTEMP() @@ -550,7 +550,7 @@ makeSpadCommand(:l) == lastArg := last l l := rest l argList := nil - for arg in l while arg ^= lastArg repeat + for arg in l while arg ~= lastArg repeat argList := [CONCAT(arg, '", "), :argList] argList := nreverse [lastArg, :argList] CONCAT(opForm, APPLY(function CONCAT, argList), '")") @@ -559,7 +559,7 @@ htMakeInputList stringList == -- makes an input form for constructing a list lastArg := last stringList argList := nil - for arg in stringList while arg ^= lastArg repeat + for arg in stringList while arg ~= lastArg repeat argList := [CONCAT(arg, '", "), :argList] argList := nreverse [lastArg, :argList] bracketString APPLY(function CONCAT, argList) diff --git a/src/interp/htsetvar.boot b/src/interp/htsetvar.boot index 6f4901da..5b20b0da 100644 --- a/src/interp/htsetvar.boot +++ b/src/interp/htsetvar.boot @@ -42,7 +42,7 @@ htsv() == htSetVars() == $path := nil $lastTree := nil - if 0 ^= LASTATOM $setOptions then htMarkTree($setOptions,0) + if 0 ~= LASTATOM $setOptions then htMarkTree($setOptions,0) htShowSetTree($setOptions) htShowSetTree(setTree) == @@ -443,7 +443,7 @@ htCacheSet htPage == bcHt '"\vspace{1}\newline " if $cacheAlist then -- bcHt '" However, \indent{3}" - for [name,:val] in $cacheAlist | val ^= $cacheCount repeat + for [name,:val] in $cacheAlist | val ~= $cacheCount repeat bcHt '"\newline function {\em " bcHt stringize name bcHt '"} will cache " diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index 22dd4389..bcf01ce8 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -139,7 +139,7 @@ pushDownTargetInfo(op,target,arglist) == op = "*" => -- only push down on 1st arg if not immed if not getTarget CADR arglist then putTarget(CADR arglist,target) getTarget(x := CAR arglist) => NIL - if getUnname(x) ^= $immediateDataSymbol then putTarget(x,target) + if getUnname(x) ~= $immediateDataSymbol then putTarget(x,target) op = "**" or op = "^" => -- push down on base if not getTarget CAR arglist then putTarget(CAR arglist,target) (op = 'equation) and (target is ['Equation,S]) => @@ -218,7 +218,7 @@ bottomUp t == -- As a side-effect it also evaluates the tree. t is [op,:argl] => tar := getTarget op - getUnname(op) ^= $immediateDataSymbol and (v := getValue op) => + getUnname(op) ~= $immediateDataSymbol and (v := getValue op) => om := objMode(v) null tar => [om] (r := resolveTM(om,tar)) => [r] @@ -236,7 +236,7 @@ bottomUp t == opVal := getValue op -- call a special handler if we are not being package called - dol := getAtree(op,'dollar) and (opName ^= 'construct) + dol := getAtree(op,'dollar) and (opName ~= 'construct) (null dol) and (fn:= GETL(opName,"up")) and (u:= FUNCALL(fn, t)) => u nargs := #argl @@ -302,7 +302,7 @@ bottomUpCompile t == bottomUpUseSubdomain t == $useIntegerSubdomain : local := true ms := bottomUp t - ($immediateDataSymbol ^= getUnname(t)) or ($Integer ^= CAR(ms)) => ms + ($immediateDataSymbol ~= getUnname(t)) or ($Integer ~= CAR(ms)) => ms null INTEGERP(num := objValUnwrap getValue t) => ms o := getBasicObject(num) putValue(t,o) @@ -313,7 +313,7 @@ bottomUpUseSubdomain t == bottomUpPredicate(pred, name) == putTarget(pred,$Boolean) ms := bottomUp pred - $Boolean ^= first ms => throwKeyedMsg('"S2IB0001",[name]) + $Boolean ~= first ms => throwKeyedMsg('"S2IB0001",[name]) ms bottomUpCompilePredicate(pred, name) == @@ -363,7 +363,7 @@ bottomUpIdentifier(t,id) == tar := getTarget t expr:= objVal u om := objMode(u) - (om ^= $EmptyMode) and (om isnt ['RuleCalled,.]) => + (om ~= $EmptyMode) and (om isnt ['RuleCalled,.]) => $genValue or GENSYMP(id) => null tar => [om] (r := resolveTM(om,tar)) => [r] @@ -384,7 +384,7 @@ getConstantObject(id,dc,sig) == namedConstant(id,t) == -- for the time being, ignore the case where the target type is imposed. - getTarget(t) ^= nil => nil + getTarget(t) ~= nil => nil sysmms := getModemapsFromDatabase(id,0) or return nil -- ignore polymorphic constants are not supported yet. doms := [getDCFromSystemModemap sysmm for sysmm in sysmms] @@ -619,7 +619,7 @@ bottomUpForm0(t,op,opName,argl,argModeSetList) == (u := bottomUpElt t) => u bottomUpForm0(t,op,opName,argl,argModeSetList) - (opName ^= "elt") and (opName ^= "apply") and + (opName ~= "elt") and (opName ~= "apply") and #argl = 1 and first first argModeSetList is ['Variable, var] and var in '(first last rest) and isEltable(op, argl, #argl) and (u := bottomUpElt t) => u @@ -627,7 +627,7 @@ bottomUpForm0(t,op,opName,argl,argModeSetList) == $genValue and ( u:= bottomUpFormRetract(t,op,opName,argl,argModeSetList) ) => u - (opName ^= "elt") and (opName ^= "apply") and + (opName ~= "elt") and (opName ~= "apply") and isEltable(op, argl, #argl) and (u := bottomUpElt t) => u if FIXP $HTCompanionWindowID then @@ -803,7 +803,7 @@ bottomUpFormAnyUnionRetract(t,op,opName,argl,amsl) == for x in argl for m in amsl for i in 0.. repeat m0 := first m if ( (m0 = $Any) or (first m0 = 'Union) ) and - ('failed^=(object:=retract getValue x)) then + ('failed ~= (object:=retract getValue x)) then b := true RPLACA(m,objMode(object)) putModeSet(x,[objMode(object)]) @@ -826,7 +826,7 @@ bottomUpFormUntaggedUnionRetract(t,op,opName,argl,amsl) == for x in argl for m in amsl for i in 0.. repeat m0 := first m if (m0 is ['Union, :.] and null getUnionOrRecordTags m0) and - ('failed ^= (object:=retract getValue x)) then + ('failed ~= (object:=retract getValue x)) then b := true RPLACA(m,objMode(object)) putModeSet(x,[objMode(object)]) @@ -878,11 +878,11 @@ isEltable(op,argl,numArgs) == ZEROP numArgs => true m is ['Mapping, :.] => nil true - numArgs ^= 1 => nil + numArgs ~= 1 => nil name := getUnname op name = 'SEQ => nil --not (name in '(a e h s)) and getAllModemapsFromDatabase(name, nil) => nil arg := first argl - (getUnname arg) ^= 'construct => nil + (getUnname arg) ~= 'construct => nil true diff --git a/src/interp/i-code.boot b/src/interp/i-code.boot index f229578e..4e27a17a 100644 --- a/src/interp/i-code.boot +++ b/src/interp/i-code.boot @@ -62,7 +62,7 @@ intCodeGenCOERCE(triple,t2) == val is ['THROW,label,code] => if label is ['QUOTE, l] then label := l - null($compilingMap) or (label ^= mapCatchName($mapName)) => + null($compilingMap) or (label ~= mapCatchName($mapName)) => objNew(['THROW,label,getValueNormalForm intCodeGenCOERCE(objNew(code,t1),t2)],t2) -- we have a return statement. just send it back as is diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index a46711e0..663b1178 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -119,7 +119,7 @@ retract1 object == -- try to retract the "coefficients" -- think of P RN -> P I or M RN -> M I object' := retractUnderDomain(object,type,underDomain) - object' ^= 'failed => object' + object' ~= 'failed => object' -- see if we can use the retract functions (object' := coerceRetract(object,underDomain)) => object' -- see if we have a special case here @@ -129,8 +129,8 @@ retract1 object == retractUnderDomain(object,type,underDomain) == null (ud := underDomainOf underDomain) => 'failed [c,:args] := deconstructT type - 1 ^= #args => 'failed - 1 ^= #c => 'failed + 1 ~= #args => 'failed + 1 ~= #c => 'failed type'' := constructT(c,[ud]) (object' := coerceInt(object,type'')) => object' 'failed @@ -224,8 +224,8 @@ retract2Specialization object == -- try to retract as an element of rep and see if we can get an -- element of k val' := retract objNew(val,rep) - while (val' ^= 'failed) and - (equiType(objMode val') ^= k) repeat + while (val' ~= 'failed) and + (equiType(objMode val') ~= k) repeat val' := retract val' val' = 'failed => NIL val' @@ -443,11 +443,11 @@ canCoerce1(t1,t2) == t1 is ['Segment, s1] and t2 is ['UniversalSegment, s2] and (isEqualOrSubDomain(s1, s2) or canCoerce(s1, s2)) => true - t1 is ['Tuple,S] and t2 ^= '(OutputForm) => canCoerce(['List, S], t2) + t1 is ['Tuple,S] and t2 ~= '(OutputForm) => canCoerce(['List, S], t2) isRingT2 := ofCategory(t2,'(Ring)) isRingT2 and isEqualOrSubDomain(t1,$Integer) => true - (ans := canCoerceTopMatching(t1,t2,nt1,nt2)) ^= 'maybe => ans + (ans := canCoerceTopMatching(t1,t2,nt1,nt2)) ~= 'maybe => ans t2 = $Integer => canCoerceLocal(t1,t2) -- is true ans := canCoerceTower(t1,t2) or [.,:arg]:= deconstructT t2 @@ -498,7 +498,7 @@ canCoerceTopMatching(t1,t2,tt1,tt2) == 1 = #u2 => NIL u1 := deconstructT t1 1 = #u1 => NIL -- no under domain - first(u1) ^= first(u2) => 'maybe + first(u1) ~= first(u2) => 'maybe canCoerce(underDomainOf t1, underDomainOf t2) canCoerceExplicit2Mapping(t1,t is ['Mapping,target,:argl]) == @@ -561,7 +561,7 @@ canCoerceByMap(t1,t2) == 1 = #u2 => NIL u1 := deconstructT t1 1 = #u1 => NIL -- no under domain - CAR(u1) ^= CAR(u2) => NIL + CAR(u1) ~= CAR(u2) => NIL top := CAAR u1 u1 := underDomainOf t1 u2 := underDomainOf t2 @@ -610,7 +610,7 @@ canCoerceLocal(t1,t2) == tag='total => true (functionp(fun) and (v:=CATCH('coerceFailure,FUNCALL(fun,'_$fromCoerceable_$,t1,t2))) - and v ^= $coerceFailure) or canCoerceByFunction(t1,t2) + and v ~= $coerceFailure) or canCoerceByFunction(t1,t2) canCoerceByFunction(t1,t2) canCoerceCommute(t1,t2) == @@ -675,10 +675,10 @@ absolutelyCanCoerceByCheating(t1,t2) == [tl1,:u1] := deconstructT t1 [tl2,:u2] := deconstructT t2 tl1 = '(Stream) and tl2 = '(InfiniteTuple) => - #u1 ^= #u2 => false + #u1 ~= #u2 => false "and"/[absolutelyCanCoerceByCheating(x1,x2) for x1 in u1 for x2 in u2] - tl1 ^= tl2 => false - #u1 ^= #u2 => false + tl1 ~= tl2 => false + #u1 ~= #u2 => false "and"/[absolutelyCanCoerceByCheating(x1,x2) for x1 in u1 for x2 in u2] absolutelyCannotCoerce(t1,t2) == @@ -727,7 +727,7 @@ absolutelyCannotCoerce(t1,t2) == 1 = #v2 => NIL v1 := deconstructT t1 1 = #v1 => NIL - CAR(v1) ^= CAR(v2) => NIL + CAR(v1) ~= CAR(v2) => NIL absolutelyCannotCoerce(u1,u2) typeIsASmallInteger x == (x = $SingleInteger) @@ -782,14 +782,14 @@ coerceInt0(triple,t2) == s1 := equiType(t1) s2 := equiType(t2) s1 = s2 => return objNew(val,t2) - -- t1 is ['Mapping,:.] and t2 ^= '(Any) => NIL + -- t1 is ['Mapping,:.] and t2 ~= '(Any) => NIL -- note: may be able to coerce TO mapping -- treat Exit like Any -- handle case where we must generate code null(isWrapped val) and (t1 isnt ['FunctionCalled,:.] or not $genValue)=> intCodeGenCOERCE(triple,t2) - t1 = $Any and t2 ^= $OutputForm and ([t1',:val'] := unwrap val) and + t1 = $Any and t2 ~= $OutputForm and ([t1',:val'] := unwrap val) and (ans := coerceInt0(objNewWrap(val',t1'),t2)) => ans if not EQ(s1,t1) then triple := objNew(val,s1) x := coerceInt(triple,s2) => @@ -831,7 +831,7 @@ coerceInt1(triple,t2) == t2 = $Void => objNew(voidValue(),$Void) t2 = $Any => objNewWrap([t1,:unwrap val],$Any) - t1 = $Any and t2 ^= $OutputForm and ([t1',:val'] := unwrap val) and + t1 = $Any and t2 ~= $OutputForm and ([t1',:val'] := unwrap val) and (ans := coerceInt(objNewWrap(val',t1'),t2)) => ans -- next is for tagged union selectors for the time being @@ -860,7 +860,7 @@ coerceInt1(triple,t2) == atom vars => [vars] vars is ["tuple",:.] => rest vars vars - #margl ^= #vars => 'continue + #margl ~= #vars => 'continue tree := mkAtree ['ADEF,vars,[target,:margl],[NIL for x in rest t2],:body] CATCH('coerceOrCroaker, bottomUp tree) = 'croaked => nil return getValue tree @@ -868,7 +868,7 @@ coerceInt1(triple,t2) == (t1 = $Symbol) and (t2 is ['Mapping,target,:margl]) => null (mms := selectMms1(unwrap val,nil,margl,margl,target)) => NIL [dc,targ,:argl] := CAAR mms - targ ^= target => NIL + targ ~= target => NIL $genValue => fun := getFunctionFromDomain(unwrap val,dc,argl) objNewWrap(fun,t2) @@ -878,7 +878,7 @@ coerceInt1(triple,t2) == null (mms := selectMms1(sym,target,margl,margl,NIL)) => null (mms := selectMms1(sym,target,margl,margl,true)) => NIL [dc,targ,:argl] := CAAR mms - targ ^= target => NIL + targ ~= target => NIL dc is ["__FreeFunction__",:freeFun] => objNew( freeFun, t2 ) $genValue => objNewWrap( getFunctionFromDomain(sym,dc,argl), t2 ) val := NRTcompileEvalForm(sym, CDR CAAR mms, evalDomain dc) @@ -888,7 +888,7 @@ coerceInt1(triple,t2) == transferPropsToNode(sym,symNode) null (mms := selectLocalMms(symNode,sym,margl,target)) => NIL [dc,targ,:argl] := CAAR mms - targ ^= target => NIL + targ ~= target => NIL ml := [target,:margl] intName := or/[mm for mm in mms | (mm is [[., :ml1],oldName,:.] @@ -1026,9 +1026,9 @@ coerceIntByMap(triple,t2) == 1 = #u2 => NIL -- no under domain u1 := deconstructT t1 1 = #u1 => NIL - CAAR u1 ^= CAAR u2 => nil -- constructors not equal + CAAR u1 ~= CAAR u2 => nil -- constructors not equal ^valueArgsEqual?(t1, t2) => NIL --- CAR u1 ^= CAR u2 => NIL +-- CAR u1 ~= CAR u2 => NIL top := CAAR u1 u1 := underDomainOf t1 u2 := underDomainOf t2 @@ -1208,7 +1208,7 @@ computeTTTranspositions(t1,t2) == p2' := MSORT p2 p2 = p2' => NIL -- if anything is repeated twice, leave - p2' ^= MSORT REMDUP p2' => NIL + p2' ~= MSORT REMDUP p2' => NIL -- create a list of permutations that transform the tower parts -- of t1 into the order they are in in t2 n1 := #tl1 @@ -1229,7 +1229,7 @@ computeTTTranspositions(t1,t2) == tower.(CDR perm) := t towers := CONS(VEC2LIST tower,towers) towers := [reassembleTowerIntoType tower for tower in towers] - if CAR(towers) ^= t2 then towers := cons(t2,towers) + if CAR(towers) ~= t2 then towers := cons(t2,towers) NREVERSE towers decomposeTypeIntoTower t == @@ -1260,7 +1260,7 @@ permuteToOrder(p,n,start) == for i in start+1..n while not stpos repeat if p.i = start then stpos := i perms := NIL - while stpos ^= start repeat + while stpos ~= start repeat x := stpos - 1 perms := [[x,:stpos],:perms] t := p.stpos @@ -1348,7 +1348,7 @@ coerceByFunction(T,m2) == -- try going back to types like RN instead of QF I m1' := eqType m1 m2' := eqType m2 - (m1 ^= m1') or (m2 ^= m2') => coerceByFunction(objNew(x,m1'),m2') + (m1 ~= m1') or (m2 ~= m2') => coerceByFunction(objNew(x,m1'),m2') NIL hasCorrectTarget(m,sig is [dc,tar,:.]) == diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot index 1dd78d14..73ff0bad 100644 --- a/src/interp/i-coerfn.boot +++ b/src/interp/i-coerfn.boot @@ -44,7 +44,7 @@ position1(x,y) == --% Direct Product, New and Old DP2DP(u,source is [.,n,S],target is [.,m,T]) == - n ^= m => nil + n ~= m => nil u = '_$fromCoerceable_$ => canCoerce(S,T) null (u' := coerceInt(objNewWrap(u,['Vector,S]),['Vector,T])) => coercionFailure() @@ -140,7 +140,7 @@ Dmp2Mp(u, source is [dmp, x, S], target is [mp, y, T]) == x = y => canCoerce(S,T) canCoerce(source',target) null u => domainZero(target) -- 0 dmp is = nil - x ^= y => + x ~= y => (u' := coerceInt(objNewWrap(u,source),source')) or coercionFailure() (u' := coerceInt(u',target)) or coercionFailure() objValUnwrap(u') @@ -507,10 +507,10 @@ Complex2underDomain(u,[.,S],target) == Complex2FR(u,S is [.,R],target is [.,T]) == u = '_$fromCoerceable_$ => - S ^= T => nil + S ~= T => nil R = $Integer => true nil - S ^= T => coercionFailure() + S ~= T => coercionFailure() package := R = $Integer => ['GaussianFactorizationPackage] coercionFailure() @@ -571,7 +571,7 @@ L2Tuple(val, source is [.,S], target is [.,T]) == L2DP(l, source is [.,S], target is [.,n,T]) == -- need to know size of the list l = '_$fromCoerceable_$ => nil - n ^= SIZE l => coercionFailure() + n ~= SIZE l => coercionFailure() (v := coerceInt(objNewWrap(LIST2VEC l,['Vector,S]),['Vector,T])) or coercionFailure() V2DP(objValUnwrap v, ['Vector, T], target) @@ -579,7 +579,7 @@ L2DP(l, source is [.,S], target is [.,n,T]) == V2DP(v, source is [.,S], target is [.,n,T]) == -- need to know size of the vector v = '_$fromCoerceable_$ => nil - n ^= SIZE v => coercionFailure() + n ~= SIZE v => coercionFailure() (v1 := coerceInt(objNewWrap(v,source),['Vector,T])) or coercionFailure() dpFun := getFunctionFromDomain('directProduct, target, [['Vector,T]]) @@ -761,10 +761,10 @@ Mp2Expr(u,source is [mp,vars,S], target is [Expr,T]) == Mp2FR(u,S is [.,vl,R],[.,T]) == u = '_$fromCoerceable_$ => - S ^= T => nil + S ~= T => nil member(R,'((Integer) (Fraction (Integer)))) => true nil - S ^= T => coercionFailure() + S ~= T => coercionFailure() package := R = $Integer => ovl := ['OrderedVariableList, vl] @@ -972,7 +972,7 @@ OV2poly(u,source is [.,svl], target is [p,vl,T]) == v := svl.(unwrap(u)-1) val' := [1,:domainOne(T)] p = 'UnivariatePolynomial => - v ^= vl => coercionFailure() + v ~= vl => coercionFailure() [[1,:domainOne(T)]] null member(v,vl) => coercionFailure() val' := [[1,:domainOne(T)]] @@ -998,10 +998,10 @@ varsInPoly(u) == P2FR(u,S is [.,R],[.,T]) == u = '_$fromCoerceable_$ => - S ^= T => nil + S ~= T => nil member(R,'((Integer) (Fraction (Integer)))) => true nil - S ^= T => coercionFailure() + S ~= T => coercionFailure() package := R = $Integer => ['MultivariateFactorize,$Symbol,['IndexedExponents, $Symbol],R,S] @@ -1103,7 +1103,7 @@ P2MpAux(u,source,S,target,varlist,vars,T,univariate) == varIsOnlyVarInPoly(u, var) == u is [ =1, v, :termlist] => - v ^= var => nil + v ~= var => nil and/[varIsOnlyVarInPoly(c,var) for [e,:c] in termlist] true @@ -1319,7 +1319,7 @@ Sy2OV(u,source,target is [.,vl]) == Sy2Dmp(u,source,target is [dmp,vl,S]) == u = '_$fromCoerceable_$ => canCoerce(source,S) len:= #vl - -1^=(n:= position(u,vl)) => + -1 ~= (n:= position(u,vl)) => u:= wrap LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1],:1] objValUnwrap(coerceInt(objNew(u,[dmp,vl,$Integer]),target)) (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() @@ -1327,7 +1327,7 @@ Sy2Dmp(u,source,target is [dmp,vl,S]) == Sy2Mp(u,source,target is [mp,vl,S]) == u = '_$fromCoerceable_$ => canCoerce(source,S) - (n:= position1(u,vl)) ^= 0 => + (n:= position1(u,vl)) ~= 0 => [1,n,[1,0,:domainOne(S)]] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [0,:objValUnwrap(u)] @@ -1335,7 +1335,7 @@ Sy2Mp(u,source,target is [mp,vl,S]) == Sy2NDmp(u,source,target is [ndmp,vl,S]) == u = '_$fromCoerceable_$ => canCoerce(source,S) len:= #vl - -1^=(n:= position(u,vl)) => + -1 ~= (n:= position(u,vl)) => u:= wrap LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1],:1] objValUnwrap(coerceInt(objNew(u,[ndmp,vl,$Integer]),target)) (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() @@ -1344,7 +1344,7 @@ Sy2NDmp(u,source,target is [ndmp,vl,S]) == Sy2P(u,source,target is [poly,S]) == u = '_$fromCoerceable_$ => true -- first try to get it into an underdomain - if (S ^= $Integer) then + if (S ~= $Integer) then u' := coerceInt(objNewWrap(u,source),S) if u' then return [0,:objValUnwrap(u')] -- if that failed, return it as a polynomial variable @@ -1428,10 +1428,10 @@ Up2Expr(u,source is [up,var,S], target is [Expr,T]) == Up2FR(u,S is [.,x,R],target is [.,T]) == u = '_$fromCoerceable_$ => - S ^= T => nil + S ~= T => nil member(R,'((Integer) (Fraction (Integer)))) => true nil - S ^= T => coercionFailure() + S ~= T => coercionFailure() package := R = $Integer => ['UnivariateFactorize,S] R = $RationalNumber => package := ['RationalFactorize,S] @@ -1543,7 +1543,7 @@ Var2Dmp(u,source,target is [dmp,vl,S]) == u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) len := #vl - -1 ^= (n:= position(sym,vl)) => + -1 ~= (n:= position(sym,vl)) => LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1], :getConstantFromDomain('(One),S)] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() @@ -1554,7 +1554,7 @@ Var2Gdmp(u,source,target is [dmp,vl,S]) == u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) len := #vl - -1 ^= (n:= position(sym,vl)) => + -1 ~= (n:= position(sym,vl)) => LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1], :getConstantFromDomain('(One),S)] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() @@ -1563,7 +1563,7 @@ Var2Gdmp(u,source,target is [dmp,vl,S]) == Var2Mp(u,source,target is [mp,vl,S]) == sym := CADR source u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) - (n:= position1(u,vl)) ^= 0 => + (n:= position1(u,vl)) ~= 0 => [1,n,[1,0,:getConstantFromDomain('(One),S)]] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [0,:objValUnwrap u] @@ -1573,7 +1573,7 @@ Var2NDmp(u,source,target is [ndmp,vl,S]) == u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) len:= #vl - -1^=(n:= position(u,vl)) => + -1 ~= (n:= position(u,vl)) => LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1], :getConstantFromDomain('(One),S)] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() @@ -1584,7 +1584,7 @@ Var2P(u,source,target is [poly,S]) == u = '_$fromCoerceable_$ => true -- first try to get it into an underdomain - if (S ^= $Integer) then + if (S ~= $Integer) then u' := coerceInt(objNewWrap(u,source),S) if u' then return [0,:objValUnwrap(u')] -- if that failed, return it as a polynomial variable @@ -1696,7 +1696,7 @@ P2Us(u, source is [.,S], target is [.,T,var,cen], type) == -- might be able to say yes canCoerce(S,T) T isnt ['Expression, :.] => coercionFailure() - if S ^= $Float then S := $Integer + if S ~= $Float then S := $Integer obj := objNewWrap(u, source) E := ['Expression, S] newU := coerceInt(obj, E) diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index 527a36c3..9e0d2743 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -190,7 +190,7 @@ evaluateType1 (form is [op,:argl]) == throwEvalTypeMsg("S2IE0005",[form]) [.,:ml] := sig ml := replaceSharps(ml,form) - # argl ^= #ml => throwEvalTypeMsg("S2IE0003",[form,form]) + # argl ~= #ml => throwEvalTypeMsg("S2IE0003",[form,form]) for x in argl for m in ml for argnum in 1.. repeat typeList := [v,:typeList] where v() == categoryForm?(m) => @@ -236,7 +236,7 @@ evalForm(op,opName,argl,mmS) == for mm in mmS until form repeat [sig,fun,cond]:= mm (CAR sig) = 'interpOnly => form := CAR sig - #argl ^= #CDDR sig => 'skip ---> RDJ 6/95 + #argl ~= #CDDR sig => 'skip ---> RDJ 6/95 form:= $genValue or null cond => [getArgValue2(x,t,sideEffectedArg?(t,sig,opName),opName) or return NIL @@ -287,7 +287,7 @@ evalForm(op,opName,argl,mmS) == sideEffectedArg?(t,sig,opName) == opString := SYMBOL_-NAME opName - (opName ^= 'setelt) and (ELT(opString, #opString-1) ^= char '_!) => nil + (opName ~= 'setelt) and (ELT(opString, #opString-1) ~= char '_!) => nil dc := first sig t = dc @@ -313,7 +313,7 @@ getArgValue1(a,t) == systemErrorHere '"getArgValue1" getArgValue2(a,t,se?,opName) == - se? and (objMode(getValue a) ^= t) => + se? and (objMode(getValue a) ~= t) => throwKeyedMsg("S2IE0013", [opName, objMode(getValue a), t]) getArgValue(a,t) @@ -336,7 +336,7 @@ getMappingArgValue(a,t,m is ['Mapping,:ml]) == NIL getArgValueComp2(arg, type, cond, se?, opName) == - se? and (objMode(getValue arg) ^= type) => + se? and (objMode(getValue arg) ~= type) => throwKeyedMsg("S2IE0013", [opName, objMode(getValue arg), type]) getArgValueComp(arg, type, cond) diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 89942903..719142de 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -192,7 +192,7 @@ selectMms2(op,tar,args1,args2,$Coerce) == -- for typically homogeneous functions, throw in resolve too if op in '(_= _+ _* _- ) then r := resolveTypeList a - if r ^= nil then a := cons(r,a) + if r ~= nil then a := cons(r,a) if tar and not isPartialMode tar then if xx := underDomainOf(tar) then a := cons(xx,a) @@ -476,7 +476,7 @@ getOpArgTypes(opname, args) == l := getOpArgTypes1(opname, args) [f(a,opname) for a in l] where f(x,op) == - x is ['FunctionCalled,g] and op ^= 'name => + x is ['FunctionCalled,g] and op ~= 'name => m := get(g,'mode,$e) => m is ['Mapping,:.] => m x @@ -575,7 +575,7 @@ getLocalMms(name,types,tar) == -- check format and destructure dcSig isnt [dc,result,:args] => NIL -- make number of args is correct - #types ^= #args => NIL + #types ~= #args => NIL -- check for equal or subsumed arguments subsume := (not $useIntegerSubdomain) or (tar = result) or get(name,'recursive,$e) @@ -609,7 +609,7 @@ mmCost0(name, sig,cond,tar,args1,args2) == -- try to favor homogeneous multiplication ---if name = "*" and 2 = #sigArgs and first sigArgs ^= first rest sigArgs then n := n + 1 +--if name = "*" and 2 = #sigArgs and first sigArgs ~= first rest sigArgs then n := n + 1 -- because of obscure problem in evalMm, sometimes we will have extra -- modemaps with the wrong number of arguments if we want to the one @@ -718,7 +718,7 @@ findCommonSigInDomain(opName,dom,nargs) == nargs = #CAR mm => null vec => vec := LIST2VEC CAR mm for i in 0.. for x in CAR mm repeat - if vec.i and vec.i ^= x then vec.i := NIL + if vec.i and vec.i ~= x then vec.i := NIL VEC2LIST vec findUniqueOpInDomain(op,opName,dom) == @@ -781,15 +781,15 @@ findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) == -- When domains no longer have to have Set, the hard coded 6 and 7 -- should go. op = '_= => - #args1 ^= 2 or args1.0 ^= dc or args1.1 ^= dc => NIL - tar and tar ^= $Boolean => NIL + #args1 ~= 2 or args1.0 ~= dc or args1.1 ~= dc => NIL + tar and tar ~= $Boolean => NIL [[[dc, $Boolean, dc, dc], [$Boolean,'$,'$], [NIL, NIL]]] op = 'coerce => - #args1 ^= 1 + #args1 ~= 1 dcName='Enumeration and (args1.0=$Symbol or tar=dc)=> [[[dc, dc, $Symbol], ['$,$Symbol], [NIL, NIL]]] - args1.0 ^= dc => NIL - tar and tar ^= $Expression => NIL + args1.0 ~= dc => NIL + tar and tar ~= $Expression => NIL [[[dc, $Expression, dc], [$Expression,'$], [NIL, NIL]]] member(dcName,'(Record Union)) => findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) @@ -829,7 +829,7 @@ allOrMatchingMms(mms,args1,tar,dc) == for mm in mms repeat [sig,:.] := mm [res,:args] := MSUBSTQ(dc,"$",sig) - args ^= args1 => nil + args ~= args1 => nil x := CONS(mm,x) if x then x else mms @@ -892,7 +892,7 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == impls := cons([b,nil,true,d],impls) impls := cons([b,d,true,d],impls) impls := NREVERSE impls - if maxargs ^= -1 then + if maxargs ~= -1 then SL:= NIL for i in 1..maxargs repeat impls := SUBSTQ(GENSYM(),INTERNL('"#",STRINGIMAGE i),impls) @@ -916,7 +916,7 @@ matchMmCond(cond) == cond is ['OR,:conds] or cond is ['or,:conds] => or/[matchMmCond c for c in conds] cond is ['has,dom,x] => - hasCaty(dom,x,NIL) ^= 'failed + hasCaty(dom,x,NIL) ~= 'failed cond is ['not,cond1] => not matchMmCond cond1 keyedSystemError("S2GE0016", ['"matchMmCond",'"unknown form of condition"]) @@ -1006,7 +1006,7 @@ filterModemapsFromPackages(mms, names, op) == isTowerWithSubdomain(towerType,elem) == not PAIRP towerType => NIL dt := deconstructT towerType - 2 ^= #dt => NIL + 2 ~= #dt => NIL s := underDomainOf(towerType) isEqualOrSubDomain(s,elem) and constructM(first dt,[elem]) @@ -1112,7 +1112,7 @@ selectMmsGen(op,tar,args1,args2) == NIL [c,t,:a] := sig if a then matchTypes(a,args1,args2) - $Subst ^= 'failed => + $Subst ~= 'failed => mmS := nconc(evalMm(op,tar,sig,mmC),mmS) mmS @@ -1145,7 +1145,7 @@ evalMm(op,tar,sig,mmC) == mS:= NIL for st in evalMmStack mmC repeat SL:= evalMmCond(op,sig,st) - SL ^= 'failed => + SL ~= 'failed => SL := fixUpTypeArgs SL sig:= [subCopy(deepSubCopy(x,SL),$Subst) for x in sig] not containsVars sig => @@ -1251,7 +1251,7 @@ coerceTypeArgs(t1, t2, SL) == -- if the type t has type-valued arguments, coerce them to the new types, -- if needed. t1 isnt [con1, :args1] or t2 isnt [con2, :args2] => t2 - con1 ^= con2 => t2 + con1 ~= con2 => t2 coSig := rest getDualSignatureFromDB first t1 and/coSig => t2 csub1 := constructSubst t1 @@ -1362,15 +1362,15 @@ evalMmCat1(mmC is ['ofCategory,d,c],op, SL) == -- If c is not Set, Ring or Field then the more general mechanism dom := defaultTypeForCategory(c, SL) null dom => - op ^= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) + op ~= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) null (p := ASSQ(d,$Subst)) => dom => NSL := [CONS(d,dom)] - op ^= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) + op ~= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) if containsVars dom then dom := resolveTM(CDR p, dom) $Coerce and canCoerce(CDR p, dom) => NSL := [CONS(d,dom)] - op ^= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) + op ~= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) NSL hasCate(dom,cat,SL) == @@ -1378,14 +1378,14 @@ hasCate(dom,cat,SL) == -- augments substitution SL or returns 'failed dom = $EmptyMode => NIL isPatternVar dom => - (p:= ASSQ(dom,SL)) and ((NSL := hasCate(CDR p,cat,SL)) ^= 'failed) => + (p:= ASSQ(dom,SL)) and ((NSL := hasCate(CDR p,cat,SL)) ~= 'failed) => NSL (p:= ASSQ(dom,$Subst)) or (p := ASSQ(dom, SL)) => -- S:= hasCate(CDR p,cat,augmentSub(CAR p,CDR p,copy SL)) S:= hasCate1(CDR p,cat,SL, dom) not (S='failed) => S hasCateSpecial(dom,CDR p,cat,SL) - if SL ^= 'failed then $hope:= 'T + if SL ~= 'failed then $hope:= 'T 'failed SL1 := [[v,:d] for [v,:d] in SL | not containsVariables d] if SL1 then cat := subCopy(cat, SL1) @@ -1478,7 +1478,7 @@ hasCaty(d,cat,SL) == hasSig(d,foo,subCopy(sig,constructSubst d),SL) cat is ['ATTRIBUTE,a] => hasAtt(d,subCopy(a,constructSubst d),SL) cat is ["Join",:.] => - for c in rest cat while SL ^= "failed" repeat + for c in rest cat while SL ~= "failed" repeat SL := hasCaty(d,c,SL) SL x:= hasCat(opOf d,opOf cat) => @@ -1578,7 +1578,7 @@ hasSigOr(orCls, S0, SL) == hasSigAnd(andCls, S0, SL) keyedSystemError("S2GE0016", ['"hasSigOr",'"unexpected condition for signature"]) - if SA ^= 'failed then found := true + if SA ~= 'failed then found := true SA hasSig(dom,foo,sig,SL) == @@ -1625,9 +1625,9 @@ hasAtt(dom,att,SL) == hasCatExpression(cond,SL) == cond is ["OR",:l] => - or/[(y:=hasCatExpression(x,SL)) ^= 'failed for x in l] => y + or/[(y:=hasCatExpression(x,SL)) ~= 'failed for x in l] => y cond is ["AND",:l] => - and/[(SL:= hasCatExpression(x,SL)) ^= 'failed for x in l] => SL + and/[(SL:= hasCatExpression(x,SL)) ~= 'failed for x in l] => SL cond is ["has",a,b] => hasCate(a,b,SL) keyedSystemError("S2GE0016", ['"hasSig",'"unexpected condition for attribute"]) @@ -1671,15 +1671,15 @@ unifyStructVar(v,s,SL) == else if canCoerce(ns1, ns0) then s3 := s0 else s3 := nil s3 => - if (s3 ^= s0) then SL := augmentSub(v,s3,SL) - if (s3 ^= s1) and isPatternVar(s) then SL := augmentSub(s,s3,SL) + if (s3 ~= s0) then SL := augmentSub(v,s3,SL) + if (s3 ~= s1) and isPatternVar(s) then SL := augmentSub(s,s3,SL) SL 'failed $domPvar => s3 := resolveTT(s0,s1) s3 => - if (s3 ^= s0) then SL := augmentSub(v,s3,SL) - if (s3 ^= s1) and isPatternVar(s) then SL := augmentSub(s,s3,SL) + if (s3 ~= s0) then SL := augmentSub(v,s3,SL) + if (s3 ~= s1) and isPatternVar(s) then SL := augmentSub(s,s3,SL) SL 'failed -- isSubDomain(s,s0) => augmentSub(v,s0,SL) @@ -1696,7 +1696,7 @@ ofCategory(dom,cat) == $hope:local := NIL IDENTP dom => NIL cat is ['Join,:cats] => and/[ofCategory(dom,c) for c in cats] - (hasCaty(dom,cat,NIL) ^= 'failed) + (hasCaty(dom,cat,NIL) ~= 'failed) printMms(mmS) == -- mmS a list of modemap signatures diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index 0796d693..739bde15 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -223,7 +223,7 @@ mkAtree3(x,op,argl) == r := mkAtreeValueOf r v := null arg => VECTOR(NIL,NIL,NIL) - PAIRP arg and rest arg and first arg^= "|" => + PAIRP arg and rest arg and first arg ~= "|" => collectDefTypesAndPreds ["tuple",:arg] null rest arg => collectDefTypesAndPreds first arg collectDefTypesAndPreds arg @@ -240,7 +240,7 @@ mkAtree3(x,op,argl) == a is [op,:arg] => v := null arg => VECTOR(NIL,NIL,NIL) - PAIRP arg and rest arg and first arg^= "|" => + PAIRP arg and rest arg and first arg ~= "|" => collectDefTypesAndPreds ["tuple",:arg] null rest arg => collectDefTypesAndPreds first arg collectDefTypesAndPreds arg @@ -374,7 +374,7 @@ mkLessOrEqual(lhs,rhs) == ["not",["<",rhs,lhs]] atree2EvaluatedTree x == atree2Tree1(x,true) atree2Tree1(x,evalIfTrue) == - (triple := getValue x) and objMode(triple) ^= $EmptyMode => + (triple := getValue x) and objMode(triple) ~= $EmptyMode => coerceOrCroak(triple,$OutputForm,$mapName) isLeaf x => VECP x => x.0 @@ -384,12 +384,12 @@ atree2Tree1(x,evalIfTrue) == --% Environment Utilities -- getValueFromEnvironment(x,mode) == --- $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$env)) => v --- $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$e)) => v +-- $failure ~= (v := getValueFromSpecificEnvironment(x,mode,$env)) => v +-- $failure ~= (v := getValueFromSpecificEnvironment(x,mode,$e)) => v -- throwKeyedMsg("S2IE0001",[x]) getValueFromEnvironment(x,mode) == - $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$env)) => v - $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$e)) => v + $failure ~= (v := getValueFromSpecificEnvironment(x,mode,$env)) => v + $failure ~= (v := getValueFromSpecificEnvironment(x,mode,$e)) => v null(v := coerceInt(objNew(x, ['Variable, x]), mode)) => throwKeyedMsg("S2IE0001",[x]) objValUnwrap v diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index d0969c48..74829990 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -59,7 +59,7 @@ isInternalMapName name == -- this only returns true or false as a "best guess" (not IDENTP(name)) or (name = "*") or (name = "**") => false sz := SIZE (name' := PNAME name) - (sz < 7) or (char("*") ^= name'.0) => false + (sz < 7) or (char("*") ~= name'.0) => false null DIGITP name'.1 => false null STRPOS('"_;",name',1,NIL) => false -- good enough @@ -106,7 +106,7 @@ addDefMap(['DEF,lhs,mapsig,.,rhs],pred) == throwKeyedMsg("S2IM0002",[lhs]) -- verify a constructor abbreviation is not used on the lhs - op ^= (op' := unabbrev op) => throwKeyedMsg("S2IM0003",[op,op']) + op ~= (op' := unabbrev op) => throwKeyedMsg("S2IM0003",[op,op']) -- get the formal parameters. These should only be atomic symbols -- that are not numbers. @@ -139,9 +139,9 @@ addDefMap(['DEF,lhs,mapsig,.,rhs],pred) == -- same as what is given. if get(op,'mode,$e) is ['Mapping,.,:mapargs] then EQCAR(rhs,'rules) => - 0 ^= (numargs := # rest lhs) => + 0 ~= (numargs := # rest lhs) => throwKeyedMsg("S2IM0027",[numargs,op]) - # rest lhs ^= # mapargs => throwKeyedMsg("S2IM0008",[op]) + # rest lhs ~= # mapargs => throwKeyedMsg("S2IM0008",[op]) --get all the user variables in the map definition. This is a multi --step process as this should not include recursive calls to the map --itself, or the formal parameters @@ -173,7 +173,7 @@ addMap(lhs,rhs,pred) == argPredList:= NREVERSE predList finalPred := -- handle g(a,T)==a+T confusion between pred=T and T variable - MKPF((pred and (pred ^= 'T) => [:argPredList,SUBLISNQ($sl,pred)]; argPredList),"and") + MKPF((pred and (pred = 'T) => [:argPredList,SUBLISNQ($sl,pred)]; argPredList),"and") body:= SUBLISNQ($sl,rhs) oldMap := (obj := get(op,'value,$InteractiveFrame)) => objVal obj @@ -516,7 +516,7 @@ analyzeMap0(op,argTypes,mapDef) == -- Type analyze and compile a map. Returns the target type of the map. -- only called if there is no applicable compiled map $MapArgumentTypeList:local:= argTypes - numMapArgs mapDef ^= #argTypes => nil + numMapArgs mapDef ~= #argTypes => nil ((m:=getMode op) is ['Mapping,:sig]) or (m and (sig:=[m])) => -- op has mapping property only if user has declared the signature analyzeDeclaredMap(op,argTypes,sig,mapDef,$mapList) @@ -648,9 +648,9 @@ interpMap(opName,tar) == savedTimerStack := COPY $timedNameStack catchName := mapCatchName $mapName c := CATCH(catchName, interpret1(body,tar,nil)) --- $interpMapTag and $interpMapTag ^= mapCatchName $mapName => +-- $interpMapTag and $interpMapTag ~= mapCatchName $mapName => -- THROW($interpMapTag,c) - while savedTimerStack ^= $timedNameStack repeat + while savedTimerStack ~= $timedNameStack repeat stopTimingProcess peekTimedName() c -- better be a triple @@ -666,7 +666,7 @@ analyzeDeclaredMap(op,argTypes,sig,mapDef,$mapList) == compileCoerceMap(opName,argTypes,mm) -- The declared map needs to be compiled compileDeclaredMap(opName,sig,mapDef) - argTypes ^= CDR sig => + argTypes ~= CDR sig => analyzeDeclaredMap(op,argTypes,sig,mapDef,$mapList) CAR sig @@ -829,7 +829,7 @@ analyzeRecursiveMap(op,argTypes,body,parms,n) == sigChanged:= false name := makeLocalModemap(op,sig:=[tar,:argTypes]) code := compileBody(body,$mapTarget) - objMode(code) ^= tar => + objMode(code) ~= tar => sigChanged:= true tar := objMode(code) restoreDependentMapInfo(op, CDR $mapList, localMapInfo) @@ -876,7 +876,7 @@ nonRecursivePart(opName, funBody) == -- a function, and returns a list of the parts -- of the function which are not recursive in the name opName body:= expandRecursiveBody([opName], funBody) - ((nrp:=nonRecursivePart1(opName, body)) ^= '%noMapVal) => nrp + ((nrp:=nonRecursivePart1(opName, body)) ~= '%noMapVal) => nrp throwKeyedMsg("S2IM0012",[opName]) expandRecursiveBody(alreadyExpanded, body) == diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index 2723e7d6..0a57b1f2 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -775,7 +775,7 @@ timesApp(u,x,y,d) == d needBlankForRoot(lastOp,op,arg) == - lastOp ^= "^" and lastOp ^= "**" and not(subspan(arg)>0) => false + lastOp ~= "^" and lastOp ~= "**" and not(subspan(arg)>0) => false op = "**" and keyp CADR arg = 'ROOT => true op = "^" and keyp CADR arg = 'ROOT => true op = 'ROOT and CDDR arg => true @@ -984,7 +984,7 @@ getOpBindingPower(op,LedOrNud,leftOrRight) == bp:= leftOrRight="left" => leftBindingPowerOf(op,LedOrNud) rightBindingPowerOf(op,LedOrNud) - bp^=exception => bp + bp ~= exception => bp 1000 --% Brackets @@ -1436,7 +1436,7 @@ indefIntegralApp(u,x,y,d) == indefIntegralWidth u == -- form is INDEFINTEGRAL(expr,dx) - # u ^= 3 => THROW('outputFailure,'outputFailure) + # u ~= 3 => THROW('outputFailure,'outputFailure) 5 + WIDTH u.1 + WIDTH u.2 intSub u == @@ -2577,7 +2577,7 @@ maPrin u == $mkTestOutputStack := [COPY u, :$mkTestOutputStack] $highlightDelta := 0 c := CATCH('outputFailure,charybdis(u, $MARGIN, $LINELENGTH)) - c ^= 'outputFailure => c + c ~= 'outputFailure => c sayKeyedMsg("S2IX0009",NIL) u is ['EQUATNUM,num,form] or u is [['EQUATNUM,:.],num,form] => charybdis(['EQUATNUM,num], $MARGIN, $LINELENGTH) diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot index 75aca0e1..ccbb923b 100644 --- a/src/interp/i-resolv.boot +++ b/src/interp/i-resolv.boot @@ -215,7 +215,7 @@ resolveTTSpecial(t1,t2) == t1 is ['FunctionCalled,f] and t2 is ['FunctionCalled,g] => null (mf := get(f,'mode,$e)) => NIL null (mg := get(g,'mode,$e)) => NIL - mf ^= mg => NIL + mf ~= mg => NIL mf t1 is ['UnivariatePolynomial,x,S] => EQCAR(t2,'Variable) => @@ -376,8 +376,8 @@ resolveTCat(t,c) == sd := superType t => resolveTCat(sd,c) - SIZE(td := deconstructT t) ^= 2=> NIL - SIZE(tc := deconstructT c) ^= 2 => NIL + SIZE(td := deconstructT t) ~= 2=> NIL + SIZE(tc := deconstructT c) ~= 2 => NIL ut := underDomainOf t null isValidType(uc := last tc) => NIL null canCoerceFrom(ut,uc) => NIL @@ -509,12 +509,12 @@ resolveTM1(t,m) == $Coerce and canCoerceFrom(t,m) and m resolveTMRecord(tr,mr) == - #tr ^= #mr => NIL + #tr ~= #mr => NIL ok := true tt := NIL for ta in tr for ma in mr while ok repeat -- element is [':,tag,mode] - CADR(ta) ^= CADR(ma) => ok := NIL -- match tags + CADR(ta) ~= CADR(ma) => ok := NIL -- match tags ra := resolveTM1(CADDR ta, CADDR ma) -- resolve modes null ra => ok := NIL tt := CONS([CAR ta,CADR ta,ra],tt) @@ -605,7 +605,7 @@ resolveTMSpecial(t,m) == t is ['Fraction, ['Polynomial, ['Complex, t1]]] and m is ['Complex, m1] => resolveTM1(['Complex, ['Fraction, ['Polynomial, t1]]], m) t is ['Mapping,:lt] and m is ['Mapping,:lm] => - #lt ^= #lm => NIL + #lt ~= #lm => NIL l := NIL ok := true for at in lt for am in lm while ok repeat diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index 20c43c79..2d3097f5 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -87,7 +87,7 @@ upADEF t == $compilingMap : local := true -- if there is a predicate, merge it in with the body - if pred ^= true then body := ['IF,pred,body,'%noMapVal] + if pred ~= true then body := ['IF,pred,body,'%noMapVal] tar := getTarget t null m and tar is ['Mapping,.,:argTypes] and (#vars = #argTypes) => @@ -385,7 +385,7 @@ upTARGET t == $declaredMode:= m not atom(lhs) and putTarget(lhs,m) ms := bottomUp lhs - first ms ^= m => + first ms ~= m => throwKeyedMsg("S2IC0011",[first ms,m]) putValue(op,getValue lhs) putModeSet(op,ms) @@ -635,7 +635,7 @@ interpCOLLECTbodyIter(exp,indexList,indexVals,indexTypes) == [:$collectTypeList,rm:=resolveTT(m,last $collectTypeList)] null rm => throwKeyedMsg("S2IS0010",NIL) value:= - rm ^= m => coerceInteractive(getValue exp,rm) + rm ~= m => coerceInteractive(getValue exp,rm) getValue exp objValUnwrap(value) @@ -1073,7 +1073,7 @@ upNullList(op,l,tar) == upTaggedUnionConstruct(op,l,tar) == -- special handler for tagged union constructors tar isnt [.,:types] => nil - #l ^= 1 => throwKeyedMsg("S2IS0051",[#l,tar]) + #l ~= 1 => throwKeyedMsg("S2IS0051",[#l,tar]) bottomUp first l obj := getValue first l (code := coerceInteractive(getValue first l,tar)) or @@ -1152,7 +1152,7 @@ declare(var,mode) == null margs => 0 PAIRP margs => -1 + #margs 1 - nargs ^= #args => throwKeyedMsg("S2IM0008",[var]) + nargs ~= #args => throwKeyedMsg("S2IM0008",[var]) if $compilingMap then mkLocalVar($mapName,var) else clearDependencies(var,true) isLocalVar(var) => put(var,'mode,mode,$env) diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot index 175cab07..fc9ce28b 100644 --- a/src/interp/i-spec2.boot +++ b/src/interp/i-spec2.boot @@ -119,9 +119,9 @@ upDollar t == if f = $immediateDataSymbol then f := objValUnwrap coerceInteractive(getValue form,$OutputForm) if f = '(construct) then f := "nil" - atom form and (f ^= $immediateDataSymbol) => + atom form and (f ~= $immediateDataSymbol) => type := constantInDomain?([f],t) => - type ^= true => findConstantInDomain(op,f,type,t) + type ~= true => findConstantInDomain(op,f,type,t) -- Ambiguous constant. FIXME: try to narrow before giving up. throwKeyedMsg("S2IB0008h",[f,t]) findUniqueOpInDomain(op,f,t) @@ -130,7 +130,7 @@ upDollar t == (ms := upDollarTuple(op, f, t, t2, rest form, nargs)) => ms - f ^= "construct" and null isOpInDomain(f,t,nargs) => + f ~= "construct" and null isOpInDomain(f,t,nargs) => throwKeyedMsg("S2IS0023",[f,t]) if (sig := findCommonSigInDomain(f,t,nargs)) then for x in sig for y in form repeat @@ -156,7 +156,7 @@ upDollarTuple(op, f, t, t2, args, nargs) == newArg := [mkAtreeNode "tuple",:args] putTarget(newArg, tuple) ms := bottomUp newArg - first ms ^= tuple => NIL + first ms ~= tuple => NIL form := [first form, newArg] putAtree(first form,"dollar",t) ms := bottomUp form @@ -185,7 +185,7 @@ upequation tree == -- only handle this if there is a target of Boolean -- this should speed things up a bit tree isnt [op,lhs,rhs] => NIL - $Boolean ^= getTarget(op) => NIL + $Boolean ~= getTarget(op) => NIL null VECP op => NIL -- change equation into '=' op.0 := "=" @@ -513,7 +513,7 @@ up%LET t == var in '(% %%) => -- for history throwKeyedMsg("S2IS0027",[var]) (IDENTP var) and not (var in '(true false elt QUOTE)) => - var ^= (var' := unabbrev(var)) => -- constructor abbreviation + var ~= (var' := unabbrev(var)) => -- constructor abbreviation throwKeyedMsg("S2IS0028",[var,var']) if get(var,'isInterpreterFunction,$e) then putHist(var,'isInterpreterFunction,false,$e) @@ -623,7 +623,7 @@ evalLETchangeValue(name,value) == val:= (localEnv and get(name,'value,$env)) or get(name,'value,$e) null val => not ((localEnv and get(name,'mode,$env)) or get(name,'mode,$e)) - objMode val ^= objMode(value) + objMode val ~= objMode(value) if clearCompilationsFlag then clearDependencies(name,true) if localEnv and isLocalVar(name) @@ -636,8 +636,8 @@ upLETWithFormOnLhs(op,lhs,rhs) == lhs' := getUnnameIfCan lhs rhs' := getUnnameIfCan rhs lhs' = "tuple" => - rhs' ^= "tuple" => throwKeyedMsg("S2IS0039",NIL) - #(lhs) ^= #(rhs) => throwKeyedMsg("S2IS0038",NIL) + rhs' ~= "tuple" => throwKeyedMsg("S2IS0039",NIL) + #(lhs) ~= #(rhs) => throwKeyedMsg("S2IS0038",NIL) -- generate a sequence of assignments, using local variables -- to first hold the assignments so that things like -- (t1,t2) := (t2,t1) will work. @@ -706,9 +706,9 @@ upSetelt(op,lhs,tree) == upTableSetelt(op,lhs is [htOp,:args],rhs) == -- called only for undeclared, uninitialized table setelts - ("*" = (PNAME getUnname htOp).0) and (1 ^= # args) => + ("*" = (PNAME getUnname htOp).0) and (1 ~= # args) => throwKeyedMsg("S2IS0040",NIL) - # args ^= 1 => + # args ~= 1 => throwKeyedMsg("S2IS0041",[[getUnname htOp,'".[", getUnname first args, ['",",getUnname arg for arg in rest args],'"]"]]) @@ -729,7 +729,7 @@ unVectorize body == -- transforms from an atree back into a tree VECP body => name := getUnname body - name ^= $immediateDataSymbol => name + name ~= $immediateDataSymbol => name objValUnwrap getValue body atom body => body body is [op,:argl] => @@ -1054,8 +1054,8 @@ evalSEQ(op,args,m) == $genValue => getValue last bodyCode := nil for x in args repeat - (m1 := computedMode x) and (m1 ^= '$ThrowAwayMode) => - (av := getArgValue(x,m1)) ^= voidValue() => + (m1 := computedMode x) and (m1 ~= '$ThrowAwayMode) => + (av := getArgValue(x,m1)) ~= voidValue() => bodyCode := [av,:bodyCode] code:= bodyCode is [c] => c diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index f71069f4..92db9407 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -107,7 +107,7 @@ systemCommand [[op,:argl],:options] == $options: local:= options $e:local := $CategoryFrame fun := selectOptionLC(op,$SYSCOMMANDS,'commandError) - argl and (argl.0 = '_?) and fun ^= 'synonym => + argl and (argl.0 = '_?) and fun ~= 'synonym => helpSpad2Cmd [fun] fun := selectOption(fun,commandsForUserLevel $systemCommands, 'commandUserLevelError) @@ -206,7 +206,7 @@ getSystemCommandLine() == p := STRPOS('")",$currentLine,0,NIL) line := if p then SUBSTRING($currentLine,p,NIL) else $currentLine maxIndex:= MAXINDEX line - for i in 0..maxIndex while (line.i^=" ") repeat index:= i + for i in 0..maxIndex while (line.i ~= " ") repeat index:= i if index=maxIndex then line := '"" else line := SUBSTRING(line,index+2,nil) line @@ -510,12 +510,12 @@ compileAsharpCmd args == terminateSystemCommand() compileAsharpCmd1 args == - -- Assume we entered from the "compiler" function, so args ^= nil + -- Assume we entered from the "compiler" function, so args ~= nil -- and is a file with file extension .as or .ao path := pathname args pathType := pathnameType path - (pathType ^= '"as") and (pathType ^= '"ao") => throwKeyedMsg("S2IZ0083", nil) + (pathType ~= '"as") and (pathType ~= '"ao") => throwKeyedMsg("S2IZ0083", nil) ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) SETQ(_/EDITFILE, path) @@ -611,7 +611,7 @@ compileAsharpCmd1 args == extendLocalLibdb $newConlist compileAsharpArchiveCmd args == - -- Assume we entered from the "compiler" function, so args ^= nil + -- Assume we entered from the "compiler" function, so args ~= nil -- and is a file with file extension .al. We also assume that -- the name is fully qualified. @@ -630,12 +630,12 @@ compileAsharpArchiveCmd args == dir := fnameMake('".", pathnameName path, '"axldir") exists := PROBE_-FILE dir isDir := directoryp namestring dir - exists and isDir ^= 1=> + exists and isDir ~= 1=> throwKeyedMsg("S2IL0027",[namestring dir, namestring args]) - if isDir ^= 1 then + if isDir ~= 1 then rc := mkdir namestring dir - rc ^= 0 => throwKeyedMsg("S2IL0027",[namestring dir, namestring args]) + rc ~= 0 => throwKeyedMsg("S2IL0027",[namestring dir, namestring args]) curDir := GET_-CURRENT_-DIRECTORY() @@ -645,7 +645,7 @@ compileAsharpArchiveCmd args == cmd := STRCONC( '"ar x ", namestring path ) rc := runCommand cmd - rc ^= 0 => + rc ~= 0 => cd [ object2Identifier namestring curDir ] throwKeyedMsg("S2IL0028",[namestring dir, namestring args]) @@ -668,7 +668,7 @@ compileAsharpArchiveCmd args == terminateSystemCommand() compileAsharpLispCmd args == - -- Assume we entered from the "compiler" function, so args ^= nil + -- Assume we entered from the "compiler" function, so args ~= nil -- and is a file with file extension .lsp path := pathname args @@ -712,7 +712,7 @@ compileAsharpLispCmd args == terminateSystemCommand() compileSpadLispCmd args == - -- Assume we entered from the "compiler" function, so args ^= nil + -- Assume we entered from the "compiler" function, so args ~= nil -- and is a file with file extension .NRLIB path := pathname fnameMake(first args, '"code", '"lsp") @@ -758,11 +758,11 @@ compileSpadLispCmd args == compileSpad2Cmd args == -- This is the old compiler - -- Assume we entered from the "compiler" function, so args ^= nil + -- Assume we entered from the "compiler" function, so args ~= nil -- and is a file with file extension .spad. path := pathname args - pathnameType path ^= '"spad" => throwKeyedMsg("S2IZ0082", nil) + pathnameType path ~= '"spad" => throwKeyedMsg("S2IZ0082", nil) ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) SETQ(_/EDITFILE, path) @@ -813,8 +813,8 @@ compileSpad2Cmd args == fullopt = 'nolibrary => fun.1 := 'nolib -- Ignore quiet/nonquiet if "constructor" is given. - fullopt = 'quiet => if fun.0 ^= 'c then fun.0 := 'rq - fullopt = 'noquiet => if fun.0 ^= 'c then fun.0 := 'rf + fullopt = 'quiet => if fun.0 ~= 'c then fun.0 := 'rq + fullopt = 'noquiet => if fun.0 ~= 'c then fun.0 := 'rf fullopt = 'nobreak => $scanIfTrue := true fullopt = 'break => $scanIfTrue := nil fullopt = 'vartrace => @@ -1008,7 +1008,7 @@ display l == displaySpad2Cmd l displaySpad2Cmd l == $e: local := $EmptyEnvironment - l is [opt,:vl] and opt ^= "?" => + l is [opt,:vl] and opt ~= "?" => option := selectOptionLC(opt,$displayOptions,'optionError) => -- the option may be given in the plural but the property in @@ -1116,7 +1116,7 @@ displayWorkspaceNames() == getWorkspaceNames() == NMSORT [n for [n,:.] in CAAR $InteractiveFrame | - (n ^= "--macros--" and n^= "--flags--")] + (n ~= "--macros--" and n ~= "--flags--")] displayOperations l == null l => @@ -1417,7 +1417,7 @@ emptyInterpreterFrame(name) == closeInterpreterFrame(name) == -- if name = NIL then it means the current frame null rest $interpreterFrameRing => - name and (name ^= $interpreterFrameName) => + name and (name ~= $interpreterFrameName) => throwKeyedMsg("S2IZ0020",[$interpreterFrameName]) throwKeyedMsg("S2IZ0021",NIL) if null name then $interpreterFrameRing := rest $interpreterFrameRing @@ -1425,7 +1425,7 @@ closeInterpreterFrame(name) == found := nil ifr := NIL for f in $interpreterFrameRing repeat - found or (name ^= frameName(f)) => ifr := CONS(f,ifr) + found or (name ~= frameName(f)) => ifr := CONS(f,ifr) found := true not found => throwKeyedMsg("S2IZ0022",[name]) _$ERASE makeHistFileName(name) @@ -1653,7 +1653,7 @@ setHistoryCore inCore == sayKeyedMsg("S2IH0031",NIL) inCore => $internalHistoryTable := NIL - if $IOindex ^= 0 then + if $IOindex ~= 0 then -- actually put something in there l := LENGTH RKEYIDS histFileName() for i in 1..l repeat @@ -1705,7 +1705,7 @@ writeInputLines(fn,initial) == inp:= DEFIOSTREAM(['(MODE . OUTPUT),['FILE,:file]],255,0) for x in removeUndoLines NREVERSE lineList repeat WRITE_-LINE(x,inp) -- see file "undo" for definition of removeUndoLines - if fn ^= 'redo then sayKeyedMsg("S2IH0014",[namestring file]) + if fn ~= 'redo then sayKeyedMsg("S2IH0014",[namestring file]) SHUT inp NIL @@ -2172,7 +2172,7 @@ dewritify ob == SYMBOL_-FUNCTION oname not COMPILED_-FUNCTION_-P f => error '"A required BPI does not exist." - #ob > 3 and HASHEQ f ^= ob.3 => + #ob > 3 and HASHEQ f ~= ob.3 => error '"A required BPI has been redefined." HPUT($seen, ob, f) f @@ -2319,7 +2319,7 @@ quitSpad2Cmd() == sayErrorly('"Obsolete system command", _ ['" The )quit system command is obsolete in this version of AXIOM.", '" Please select Exit from the File Menu instead."]) - $quitCommandType ^= 'protected => leaveScratchpad() + $quitCommandType ~= 'protected => leaveScratchpad() x := UPCASE queryUserKeyedMsg("S2IZ0031",NIL) MEMQ(STRING2ID_-N(x,1),'(Y YES)) => leaveScratchpad() sayKeyedMsg("S2IZ0032",NIL) @@ -2374,7 +2374,7 @@ readSpad2Cmd l == --% )savesystem savesystem l == - #l ^= 1 or not(SYMBOLP first l) => helpSpad2Cmd '(savesystem) + #l ~= 1 or not(SYMBOLP first l) => helpSpad2Cmd '(savesystem) SETQ($SpadServer,false) SETQ($openServerIfTrue,true) )if not %hasFeature KEYWORD::ECL @@ -2519,7 +2519,7 @@ reportOpsFromUnitDirectly unitForm == else sigList:= REMDUP MSORT getOplistForConstructorForm unitForm say2PerLine [formatOperation(x,unit) for x in sigList] - if $commentedOps ^= 0 then + if $commentedOps ~= 0 then sayBrightly ['"Functions that are not yet implemented are preceded by", :bright '"--"] @@ -2633,7 +2633,7 @@ processSynonymLine line == for i in 0..mx repeat line.i = " " => return (for j in (i+1)..mx repeat - line.j ^= " " => return (SUBSTRING (line, j, nil))) + line.j ~= " " => return (SUBSTRING (line, j, nil))) [key, :value] @@ -2817,7 +2817,7 @@ removeUndoLines u == --called by writeInputLines (x := first y).0 = char '_) => stringPrefix?('")undo",s := trimString x) => --parse "undo )option" s1 := trimString SUBSTRING(s,5,nil) - if s1 ^= '")redo" then + if s1 ~= '")redo" then m := charPosition(char '_),s1,0) code := m < MAXINDEX s1 => s1.(m + 1) @@ -2825,7 +2825,7 @@ removeUndoLines u == --called by writeInputLines s2 := trimString SUBSTRING(s1,0,m) n := s1 = '")redo" => 0 - s2 ^= '"" => undoCount PARSE_-INTEGER s2 + s2 ~= '"" => undoCount PARSE_-INTEGER s2 -1 RPLACA(y,CONCAT('">",code,STRINGIMAGE n)) nil @@ -2842,7 +2842,7 @@ removeUndoLines u == --called by writeInputLines n = 0 => return nil --including undos n := n - 1 y := rest y --kill command - y and code^= char 'b => acc := [c,:acc] --add last unless )before + y and code ~= char 'b => acc := [c,:acc] --add last unless )before acc := [x,:acc] $IOindex := savedIOindex acc @@ -3089,7 +3089,7 @@ processSynonyms() == null (fun := LASSOC (syn, $CommandSynonymAlist)) => NIL fun := eval fun -- fun may have been a suspension to := STRPOS('")",fun,1,NIL) - if to and to ^= SIZE(fun)-1 then + if to and to ~= SIZE(fun)-1 then opt := STRCONC('" ",SUBSTRING(fun,to,NIL)) fun := SUBSTRING(fun,0,to-1) else opt := '" " @@ -3176,7 +3176,7 @@ stripLisp str == strIndex := 0 lispStr := '"lisp" for c0 in 0..#str-1 for c1 in 0..#lispStr-1 repeat - (char str.c0) ^= (char lispStr.c1) => + (char str.c0) ~= (char lispStr.c1) => return nil strIndex := c0+1 SUBSEQ(str, strIndex) diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot index f0d2204c..c05893f4 100644 --- a/src/interp/i-toplev.boot +++ b/src/interp/i-toplev.boot @@ -98,7 +98,7 @@ start(:l) == if $OLDLINE then SAY fillerSpaces($LINELENGTH,'"=") sayKeyedMsg("S2IZ0050",[namestring ['axiom,'input]]) - if $OLDLINE ^= 'END__UNIT + if $OLDLINE ~= 'END__UNIT then centerAndHighlight($OLDLINE,$LINELENGTH,'" ") sayKeyedMsg("S2IZ0051",NIL) @@ -194,7 +194,7 @@ recordAndPrint(x,md) == md' := md $outputMode: local := md --used by DEMO BOOT mode:= (md=$EmptyMode => quadSch(); md) - if (md ^= $Void) or $printVoidIfTrue then + if (md ~= $Void) or $printVoidIfTrue then if null $collectOutput then TERPRI $algebraOutputStream if $QuietCommand = false then output(x',md') @@ -296,7 +296,7 @@ interpretTopLevel(x, posnForm) == -- for a thrown result savedTimerStack := COPY $timedNameStack c := CATCH('interpreter,interpret(x, posnForm)) - while savedTimerStack ^= $timedNameStack repeat + while savedTimerStack ~= $timedNameStack repeat stopTimingProcess peekTimedName() c = 'tryAgain => interpretTopLevel(x, posnForm) c diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot index 86060fed..2fc2ab61 100644 --- a/src/interp/i-util.boot +++ b/src/interp/i-util.boot @@ -85,7 +85,7 @@ printPrompt(flush? == false) == ++ Return the name of a text editor, if possible. textEditor() == prog := getEnv '"EDITOR" => prog - # $EditorProgram ^= 0 => $EditorProgram + # $EditorProgram ~= 0 => $EditorProgram %hasFeature KEYWORD::WIN32 => '"notepad" throwKeyedMsg("S2IZ0091",nil) diff --git a/src/interp/int-top.boot b/src/interp/int-top.boot index 949b3241..9554b7b5 100644 --- a/src/interp/int-top.boot +++ b/src/interp/int-top.boot @@ -235,7 +235,7 @@ intloopSpadProcess(stepNo,lines,ptree,interactive?)== ncConversationPhase(function phIntReportMsgs,[cc, interactive?]) ncConversationPhase(function phInterpret, [cc]) - #ncEltQ(cc, 'messages) ^= 0 => ncError() + #ncEltQ(cc, 'messages) ~= 0 => ncError() intSetNeedToSignalSessionManager() $prevCarrier := $currentCarrier @@ -272,7 +272,7 @@ mkLineList lines == nonBlank str == value := false for i in 0..MAXINDEX str repeat - str.i ^= char " " => + str.i ~= char " " => value := true return value value diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 839ab1d1..249f7b1b 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -413,17 +413,17 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) == success := nil $isDefaultingPackage: local := -- use special defaulting handler when dollar non-trivial - dollar ^= domain and isDefaultPackageForm? devaluate domain + dollar ~= domain and isDefaultPackageForm? devaluate domain while finish > start repeat PROGN i := start numTableArgs :=numvec.i predIndex := numvec.(i := QSADD1 i) - (predIndex ^= 0) and null testBitVector(predvec,predIndex) => nil + (predIndex ~= 0) and null testBitVector(predvec,predIndex) => nil exportSig := [newExpandTypeSlot(numvec.(i + j + 1), dollar,domain) for j in 0..numTableArgs] - sig ^= hashType(['Mapping,: exportSig],hashPercent) => nil --signifies no match + sig ~= hashType(['Mapping,: exportSig],hashPercent) => nil --signifies no match loc := numvec.(i + numTableArgs + 2) loc = 1 => (someMatch := true) loc = 0 => @@ -450,7 +450,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) == return (success := newLookupInAddChain(op,sig,domain,dollar)) systemError '"unexpected format" start := QSPLUS(start,QSPLUS(numTableArgs,4)) - (success ^= 'failed) and success => + (success ~= 'failed) and success => if $monitorNewWorld then sayLooking1('"<----",uu) where uu() == PAIRP success => [first success,:devaluate rest success] @@ -477,7 +477,7 @@ hashNewLookupInCategories(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 := packageVec.i) and entry ^= true repeat + (entry := packageVec.i) and entry ~= true repeat package := VECP entry => if $monitorNewWorld then @@ -501,7 +501,7 @@ hashNewLookupInCategories(op,sig,dom,dollar) == opvec.(code+2) --not nrunNumArgCheck(#(QCDR sig),byteVector,opvec.code,endPos) => nil --numOfArgs := byteVector.(opvec.code) - --numOfArgs ^= #(QCDR sig) => nil + --numOfArgs ~= #(QCDR sig) => nil packageForm := [entry,'$,:CDR cat] package := evalSlotDomain(packageForm,dom) packageVec.i := package diff --git a/src/interp/intfile.boot b/src/interp/intfile.boot index 967eb9ae..5c3790e6 100644 --- a/src/interp/intfile.boot +++ b/src/interp/intfile.boot @@ -54,7 +54,7 @@ shoeIntern (s)== shoeStrings (stream)== StreamNull stream => ['"",stream] a:=CAR stream - if a.0^=char " " + if a.0 ~= char " " then ['"",stream] else [h,t]:=shoeStrings(cdr stream) diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index d06478fe..0dd20228 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -416,7 +416,7 @@ initializeLisplib libName == ++ If compilation produces an error, issue inform user and ++ return to toplevel reader. leaveIfErrors libName == - errorCount() ^=0 => + errorCount() ~= 0 => sayMSG ['" Errors in processing ",$lisplibKind,'" ",:bright libName,'":"] sayMSG ['" not replacing ",$spadLibFT,'" for",:bright libName] spadThrow() @@ -721,7 +721,7 @@ compDefineExports(form,ops,sig,e) == fixupSigloc entry where fixupSigloc entry == [opsig,pred,funsel] := entry - if pred ^= 'T then + if pred ~= 'T then rplac(second entry, simpBool pred) funsel is [op,a,:.] and op in '(ELT CONST) => rplac(third entry,[op,a,nil]) diff --git a/src/interp/macex.boot b/src/interp/macex.boot index ff0804c7..b1c87eee 100644 --- a/src/interp/macex.boot +++ b/src/interp/macex.boot @@ -155,7 +155,7 @@ macApplication pf == mac0MLambdaApply(mlambda, args, opf, $pfMacros) == params := pf0MLambdaArgs mlambda body := pfMLambdaBody mlambda - #args ^= #params => + #args ~= #params => pos := pfSourcePosition opf ncHardError(pos,'S2CM0003, [#params,#args]) for p in params for a in args repeat diff --git a/src/interp/mark.boot b/src/interp/mark.boot index fd3bf0cd..7ef254ec 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -82,12 +82,12 @@ tcheck T == markComp(x,T) == --for comp tcheck T - x ^= CAR T => [mkWi('comp,'WI,x,CAR T),:CDR T] + x ~= CAR T => [mkWi('comp,'WI,x,CAR T),:CDR T] T markAny(key,x,T) == tcheck T - x ^= CAR T => [mkWi(key,'WI,x,CAR T),:CDR T] + x ~= CAR T => [mkWi(key,'WI,x,CAR T),:CDR T] T markConstruct(x,T) == @@ -263,7 +263,7 @@ markRepeat(form, T) == [mkWi("repeat", 'WI,form,CAR T), :CDR T] markTran(form,form',[dc,:sig],env) == --from compElt/compFormWithModemap - dc ^= 'Rep or ^MEMQ('_$,sig) => mkWi('markTran,'WI,form,['call,:form']) + dc ~= 'Rep or ^MEMQ('_$,sig) => mkWi('markTran,'WI,form,['call,:form']) argl := [u for t in rest sig for arg in rest form'] where u() == t='_$ => argSource := getSourceWI arg @@ -287,7 +287,7 @@ markImport(d,:option) == --from compFormWithModemap/genDeltaEntry/compImport STRINGP d or (IDENTP d and (PNAME d).0 = char '_#) => nil MEMQ(d,'(_$ _$NoValueMode _$EmptyMode Void)) => nil -------=======+> WHY DOESN'T THIS WORK???????????? ---if (d' := macroExpand(d,$e)) ^= d then markImport(d',declared?) +--if (d' := macroExpand(d,$e)) ~= d then markImport(d',declared?) dom := markMacroTran d --if IDENTP dom and dom = d and not getmode(dom,$e) then dom := ['MyENUM, d] categoryForm? dom => nil @@ -1336,7 +1336,7 @@ diff(x,y) == diff1(x,y) == x = y => nil ATOM x or ATOM y => [[x,y]] - #x ^= #y => [x,y] + #x ~= #y => [x,y] "APPEND"/[diff1(u,v) for u in x for v in y] markConstructorForm name == --------> same as getConstructorForm @@ -1357,7 +1357,7 @@ markGetPaths(x,y) == -- res := reverseDown mkGetPaths(x, y) res := mkGetPaths(x, y) -- oldRes := markPaths(x,y,[nil]) --- if res ^= oldRes then $badStack := [[x, :y], :$badStack] +-- if res ~= oldRes then $badStack := [[x, :y], :$badStack] -- oldRes markPaths(x,y,[nil]) diff --git a/src/interp/match.boot b/src/interp/match.boot index 658fca4c..49e3ebab 100644 --- a/src/interp/match.boot +++ b/src/interp/match.boot @@ -67,7 +67,7 @@ charPosition(c,t,startpos) == rightCharPosition(c,t,startpos) == --startpos often equals MAXINDEX t (rightmost) k := startpos - for i in startpos..0 by -1 while c ^= ELT(t,i) repeat (k := k - 1) + for i in startpos..0 by -1 while c ~= ELT(t,i) repeat (k := k - 1) k stringPosition(s,t,startpos) == @@ -149,7 +149,7 @@ basicMatch?(pattern,target) == n := #pattern p := charPosition($wildCard,pattern,0) p = n => (pattern = target) and 0 - if p ^= 0 then + if p ~= 0 then -- pattern does not begin with a wild card ans := 0 s := SUBSTRING(pattern,0,p) --[pattern.i for i in 0..p-1] @@ -158,7 +158,7 @@ basicMatch?(pattern,target) == i := p -- starting position for searching the target q := charPosition($wildCard,pattern,p+1) ltarget := #target - while q ^= n repeat + while q ~= n repeat s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)] i := stringPosition(s,target,i) if null ans then ans := stringPosition(s,target,p) @@ -168,7 +168,7 @@ basicMatch?(pattern,target) == p := q q := charPosition($wildCard,pattern,q+1) returnFlag => false - if p ^= q-1 then + if p ~= q-1 then -- pattern does not end with a wildcard s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)] if not suffix?(s,target) then return false @@ -186,10 +186,10 @@ matchAnySegment?(pattern,target,k,nc) == --k = start position; nc=#chars or NIL m = #target => nil null nc => true m <= k + nc - n - if k ^= 0 and nc then + if k ~= 0 and nc then target := SUBSTRING(target,k,nc) k := 0 - if p ^= 0 then + if p ~= 0 then -- pattern does not begin with a wild card ans := 0 s := SUBSTRING(pattern,0,p) --[pattern.i for i in 0..p-1] @@ -198,7 +198,7 @@ matchAnySegment?(pattern,target,k,nc) == --k = start position; nc=#chars or NIL i := p + k -- starting position for searching the target q := charPosition($wildCard,pattern,p+1) ltarget := #target - while q ^= n repeat + while q ~= n repeat s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)] i := stringPosition(s,target,i) if i = ltarget then return (returnFlag := true) @@ -206,7 +206,7 @@ matchAnySegment?(pattern,target,k,nc) == --k = start position; nc=#chars or NIL p := q q := charPosition($wildCard,pattern,q+1) returnFlag => false - if p ^= q-1 then + if p ~= q-1 then -- pattern does not end with a '& s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)] if not suffix?(s,target) then return false diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index 9f0b5be0..d7f7f221 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -180,7 +180,7 @@ mkNewModemapList(mc,sig,pred,fn,curModemapList,e,filenameOrNil) == (oldMap:= assoc(map,curModemapList)) and oldMap is [.,[opred, =fn],:.] => $forceAdd => mergeModemap(entry,curModemapList,e) opred=true => curModemapList - if pred^=true and pred^=opred then pred:= ["OR",pred,opred] + if pred ~= true and pred ~= opred then pred:= ["OR",pred,opred] [if x=oldMap then [map,[pred,fn],:filenameOrNil] else x --if new modemap less general, put at end; otherwise, at front diff --git a/src/interp/msg.boot b/src/interp/msg.boot index 60d2e2f6..040ba711 100644 --- a/src/interp/msg.boot +++ b/src/interp/msg.boot @@ -179,7 +179,7 @@ posPointers msgList == ftPosList := [] for msg in msgList repeat pos := poCharPosn getMsgPos msg - if pos ^= IFCAR posList then + if pos ~= IFCAR posList then posList := [pos,:posList] if getMsgFTTag? msg = 'FROMTO then ftPosList := [poCharPosn getMsgPos2 msg,:ftPosList] @@ -335,9 +335,9 @@ msgOutputter msg == st := flowSegmentedMsg(st,$LOGLENGTH,0) alreadyOpened := alreadyOpened? msg -toScreen? msg == getMsgToWhere msg ^= 'fileOnly +toScreen? msg == getMsgToWhere msg ~= 'fileOnly toFile? msg == - getMsgToWhere msg ^= 'screenOnly + getMsgToWhere msg ~= 'screenOnly alreadyOpened? msg == @@ -408,8 +408,8 @@ decideHowMuch(pos,oldPos) == ((poPosImmediate? pos) and (poPosImmediate? oldPos)) => 'NONE (poNopos? pos) or (poPosImmediate? pos) => 'ORG (poNopos? oldPos) or (poPosImmediate? oldPos) => 'ALL - poFileName oldPos ^= poFileName pos => 'ALL - poLinePosn oldPos ^= poLinePosn pos => 'LINE + poFileName oldPos ~= poFileName pos => 'ALL + poLinePosn oldPos ~= poLinePosn pos => 'LINE 'NONE listDecideHowMuch(pos,oldPos) == diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index 75c0ba89..b13ef6af 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -100,15 +100,15 @@ string2Words l == wordFrom(l,i) == maxIndex := MAXINDEX l - k := or/[j for j in i..maxIndex | l.j ^= char ('_ ) ] or return nil + k := or/[j for j in i..maxIndex | l.j ~= char ('_ ) ] or return nil buf := '"" - while k < maxIndex and (c := l.k) ^= char ('_ ) repeat + while k < maxIndex and (c := l.k) ~= char ('_ ) repeat ch := c = char '__ => l.(k := 1+k) --this may exceed bounds c buf := STRCONC(buf,ch) k := k + 1 - if k = maxIndex and (c := l.k) ^= char ('_ ) then buf := STRCONC(buf,c) + if k = maxIndex and (c := l.k) ~= char ('_ ) then buf := STRCONC(buf,c) [buf,k+1] getKeyedMsg key == fetchKeyedMsg(key,false) @@ -142,7 +142,7 @@ segmentedMsgPreprocess x == removeAttributes msg == --takes a segmented message and returns it with the attributes --separted. - first msg ^= '"%atbeg" => + first msg ~= '"%atbeg" => [msg,NIL] attList := [] until item = '"%atend" repeat @@ -585,7 +585,7 @@ sayNewLine(out == $OutputStream, margin == nil) == -- Note: this function should *always* be used by sayBrightly and -- friends rather than TERPRI -- see bindSayBrightly TERPRI(out) - if margin ^= nil then BLANKS(margin,out) + if margin ~= nil then BLANKS(margin,out) nil sayString(x,out == $OutputStream) == @@ -871,7 +871,7 @@ sayAsManyPerLineAsPossible l == [c,:l] := l str := STRCONC(str,c,fillerSpaces(w - #c,'" ")) REMAINDER(i+1,p) = 0 => (sayMSG str ; str := '"" ) - if str ^= '"" then sayMSG str + if str ~= '"" then sayMSG str NIL say2PerLine l == say2PerLineWidth(l, QUOTIENT($LINELENGTH,2)) @@ -897,7 +897,7 @@ sayLongOperation x == splitListOn(x,key) == member(key,x) => - while first x ^= key repeat + while first x ~= key repeat y:= [first x,:y] x:= rest x [nreverse y,x] diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index c115dfcf..96240a71 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -286,7 +286,7 @@ fortran2Lines f == fs := NIL lines := NIL while f repeat - while f and (ff := first(f)) ^= '"%l" repeat + while f and (ff := first(f)) ~= '"%l" repeat fs := [ff,:fs] f := rest f if f and first(f) = '"%l" then f := rest f diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index b4094c98..c0a3398c 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -193,7 +193,7 @@ genDeltaEntry opMmPair == if atom dc then dc = "$" => nsig := sig if NUMBERP nsig then nsig := MSUBST("$",dc,substitute("$$","$",sig)) - setDifference(listOfBoundVars dc,$functorLocalParameters) ^= [] => + setDifference(listOfBoundVars dc,$functorLocalParameters) ~= [] => ['applyFun,['compiledLookupCheck,MKQ op, mkList consSig(nsig,dc),consDomainForm(dc,nil)]] odc := dc @@ -668,7 +668,7 @@ 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 ~= 'T then pred := simpBool pred $NRTslot1PredicateList := insert(pred,$NRTslot1PredicateList) fnsel is [op,a,:.] and (op = 'ELT or op = 'CONST) => @@ -682,7 +682,7 @@ changeDirectoryInSlot1() == --called by buildFunctor $newEnv: local := $e $domainShell.1 := [fn entry for entry in sortedOplist] where fn [[op,sig],pred,fnsel] == - if $lastPred ^= pred then + if $lastPred ~= pred then $newEnv := deepChaseInferences(pred,$e) $lastPred := pred newfnsel := diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index ff6c517c..03429303 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -191,11 +191,11 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == success := nil $isDefaultingPackage: local := -- use special defaulting handler when dollar non-trivial - dollar ^= domain and isDefaultPackageForm? devaluate domain + dollar ~= domain and isDefaultPackageForm? devaluate domain while finish > start repeat PROGN i := start - numArgs ^= (numTableArgs :=numvec.i) => nil + numArgs ~= (numTableArgs :=numvec.i) => nil predIndex := numvec.(i := QSADD1 i) NE(predIndex,0) and null testBitVector(predvec,predIndex) => nil loc := newCompareSig(sig,numvec,(i := QSADD1 i),dollar,domain) @@ -284,7 +284,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 := packageVec.i) and entry ^= 'T repeat + (entry := packageVec.i) and entry ~= 'T repeat package := VECP entry => if $monitorNewWorld then @@ -308,7 +308,7 @@ newLookupInCategories(op,sig,dom,dollar) == opvec.(code+2) not nrunNumArgCheck(#(QCDR sig),byteVector,opvec.code,endPos) => nil --numOfArgs := byteVector.(opvec.code) - --numOfArgs ^= #(QCDR sig) => nil + --numOfArgs ~= #(QCDR sig) => nil packageForm := [entry,'$,:CDR cat] package := evalSlotDomain(packageForm,dom) packageVec.i := package @@ -382,7 +382,7 @@ newLookupInCategories1(op,sig,dom,dollar) == null code => nil byteVector := CDDR infovec.3 numOfArgs := byteVector.(opvec.code) - numOfArgs ^= #(QCDR sig) => nil + numOfArgs ~= #(QCDR sig) => nil packageForm := [entry,'$,:CDR cat] package := evalSlotDomain(packageForm,dom) packageVec.i := package @@ -484,7 +484,7 @@ lazyMatch(source,lazyt,dollar,domain) == lazyMatchArgDollarCheck(s,d,dollarName,domainName) == - #s ^= #d => nil + #s ~= #d => nil scoSig := getDualSignatureFromDB opOf s or return nil if MEMQ(opOf s, '(Union Mapping Record)) then scoSig := [true for x in s] @@ -630,7 +630,7 @@ 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) ~= 'failed HasCategory(evalDomain a,b) => true -- for asharp domains: must return Boolean op := opOf catOrAtt isAtom := atom catOrAtt diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot index cf17fc20..4f393257 100644 --- a/src/interp/nrungo.boot +++ b/src/interp/nrungo.boot @@ -158,7 +158,7 @@ lookupInTable(op,sig,dollar,[domain,table]) == someMatch:=true false predIndex := QSQUOTIENT(code,8192) - predIndex ^= 0 and null lookupPred($predVector.predIndex,dollar,domain) + predIndex ~= 0 and null lookupPred($predVector.predIndex,dollar,domain) => false loc := QSQUOTIENT(QSREMAINDER(code,8192),2) loc = 0 => @@ -298,7 +298,7 @@ compareSigEqual(s,t,dollar,domain) == EQUAL(s,u) s='$ => compareSigEqual(dollar,t,dollar,domain) ATOM s => nil - #s ^= #t => nil + #s ~= #t => nil match := true for u in s for v in t repeat not compareSigEqual(u,v,dollar,domain) => return(match:=false) @@ -385,7 +385,7 @@ NRTisRecurrenceRelation(op,body,minivectorName) == generalPred is ['NOT,['SPADCALL,=sharpArg,m,['ELT,=minivectorName, =lesspSlot]]] and EQ(lesspSlot,$minivector.slot) => m return nil - INTEGERP predOk and predOk ^= n => + INTEGERP predOk and predOk ~= n => sayKeyedMsg("S2IX0006",[n,m]) return nil diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index c0042bf8..62fb4935 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -202,7 +202,7 @@ NRTgenInitialAttributeAlist attributeList == alist := [x for x in attributeList | -- throw out constructors not MEMQ(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 ~= 'nothing] simplifyAttributeAlist al == al is [[a,:b],:r] => @@ -215,7 +215,7 @@ simplifyAttributeAlist al == nil NRTgenFinalAttributeAlist() == - [[a,:k] for [a,:b] in $NRTattributeAlist | (k := predicateBitIndex(b)) ^= -1] + [[a,:k] for [a,:b] in $NRTattributeAlist | (k := predicateBitIndex(b)) ~= -1] predicateBitIndex x == pn(x,false) where @@ -357,7 +357,7 @@ NRTmakeCategoryAlist() == opcAlist := NREVERSE SORTBY(function NRTcatCompare,pcAlist) newPairlis := [[5 + i,:b] for [.,:b] in $pairlis for i in 1..] slot1 := [[a,:k] for [a,:b] in SUBLIS($pairlis,opcAlist) - | (k := predicateBitIndex b) ^= -1] + | (k := predicateBitIndex b) ~= -1] slot0 := [hasDefaultPackage opOf a for [a,:b] in slot1] sixEtc := [5 + i for i in 1..#$pairlis] formals := ASSOCRIGHT $pairlis @@ -807,7 +807,7 @@ NRTgetLookupFunction(domform,exCategory,addForm) == [u,msg,:v] := $why SAY '"--------------non extending category----------------------" compilerMessage('"%1p of category %2p", [domform,u]) - if v ^= nil then + if v ~= nil then compilerMessage('"%1b %2p",[msg,first v]) else compilerMessage('"%1b",[msg]) diff --git a/src/interp/parse.boot b/src/interp/parse.boot index e656c023..1dc70709 100644 --- a/src/interp/parse.boot +++ b/src/interp/parse.boot @@ -251,11 +251,6 @@ parseLessEqual: %ParseForm -> %Form parseLessEqual u == parseTran ["not",[substitute(">","<=",first u),:rest u]] -parseNotEqual: %ParseForm -> %Form -parseNotEqual u == - $normalizeTree => parseTran ["not",[substitute("=","^=",first u),:rest u]] - u - parseAnd: %ParseForm -> %Form parseAnd t == t isnt ["and",:u] => systemErrorHere ["parseAnd",t] @@ -449,7 +444,6 @@ parseVCONS l == --% Register special parsers. for x in [["<=", :"parseLessEqual"],_ - ["^=", :"parseNotEqual"],_ [":", :"parseColon"],_ ["::", :"parseCoerce"],_ ["@", :"parseAtSign"],_ diff --git a/src/interp/pathname.boot b/src/interp/pathname.boot index 5df49e60..a7449f65 100644 --- a/src/interp/pathname.boot +++ b/src/interp/pathname.boot @@ -91,9 +91,9 @@ makePathname(name,type,dir) == mergePathnames(a,b) == (fn := pathnameName(a)) = '"*" => b - fn ^= pathnameName(b) => a + fn ~= pathnameName(b) => a (ft := pathnameType(a)) = '"*" => b - ft ^= pathnameType(b) => a + ft ~= pathnameType(b) => a (fm := pathnameDirectory(a)) = ['"*"] => b a diff --git a/src/interp/pf2atree.boot b/src/interp/pf2atree.boot index bc46bc76..3927d69a 100644 --- a/src/interp/pf2atree.boot +++ b/src/interp/pf2atree.boot @@ -190,7 +190,7 @@ pf2Atree1 pf == ids := [(pfTaggedTag)(x), :ids] ids := [x, :ids] idList := [pf2Atree1 x for x in reverse ids] - if #idList ^= 1 then idList := + if #idList ~= 1 then idList := [mkAtreeNodeWithSrcPos("tuple",pf), :idList] else idList := first idList x := [mkAtreeNodeWithSrcPos("%LET",pf), @@ -346,7 +346,7 @@ pfApplication2Atree pf == -- --! ["OPTARG", pf2Atree1 CAR pf0DefinitionLhsItems pf, -- --! pf2Atree1 pfDefinitionRhs pf] -- idList := [pf2Atree1 x for x in (pf0DefinitionLhsItems)(pf)] --- #idList ^= 1 => +-- #idList ~= 1 => -- systemError '"lhs of definition must be a single item in the interpreter" -- id := first idList -- rhs := (pfDefinitionRhs)(pf) @@ -401,7 +401,7 @@ pfSequence2Atree pf == pfSequence2Atree0(seqList, pf) == null seqList => "%noBranch" seqTranList := [] - while seqList ^= nil repeat + while seqList ~= nil repeat item := first seqList item is [exitVal, cond, value] and getUnname(exitVal) = "exit" => item := [mkAtreeNodeWithSrcPos("IF",pf), cond, value, diff --git a/src/interp/pf2sex.boot b/src/interp/pf2sex.boot index c675054e..ebb76bf1 100644 --- a/src/interp/pf2sex.boot +++ b/src/interp/pf2sex.boot @@ -118,7 +118,7 @@ pf2Sex1 pf == [":", pf2Sex1 pfTypedId pf, pf2Sex1 pfTypedType pf] pfAssign? pf => idList := [pf2Sex1 x for x in pf0AssignLhsItems pf] - if #idList ^= 1 then idList := ["tuple", :idList] + if #idList ~= 1 then idList := ["tuple", :idList] else idList := first idList ["%LET", idList, pf2Sex1 pfAssignRhs pf] pfDefinition? pf => @@ -303,7 +303,7 @@ pfDefinition2Sex pf == ["OPTARG", pf2Sex1 first pf0DefinitionLhsItems pf, pf2Sex1 pfDefinitionRhs pf] idList := [pf2Sex1 x for x in pf0DefinitionLhsItems pf] - #idList ^= 1 => + #idList ~= 1 => systemError '"lhs of definition must be a single item in the interpreter" id := first idList rhs := pfDefinitionRhs pf @@ -360,7 +360,7 @@ pfSequence2Sex pf == pfSequence2Sex0 seqList == null seqList => "%noBranch" seqTranList := [] - while seqList ^= nil repeat + while seqList ~= nil repeat item := first seqList item is ["exit", cond, value] => item := ["IF", cond, value, pfSequence2Sex0 rest seqList] diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index dfd5da03..704a2f48 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -70,7 +70,7 @@ displayPreCompilationErrors() == then sayBrightly ['" Semantic ",errors,'" detected: "] else heading:= - $topOp ^= '$topOp => ['" ",$topOp,'" has"] + $topOp ~= '$topOp => ['" ",$topOp,'" has"] ['" You have"] sayBrightly [:heading,'%b,n,'%d,'"precompilation ",errors,'":"] if 1<n then @@ -89,7 +89,7 @@ postTran x == [postTran op,:rest u] op is ["Scripts",:.] => postScriptsForm(op,"append"/[unComma postTran y for y in rest x]) - op^=(y:= postOp op) => [y,:postTranList rest x] + op ~= (y:= postOp op) => [y,:postTranList rest x] postForm x postTranList: %List -> %List @@ -159,7 +159,7 @@ postError: %Thing -> %Thing postError msg == BUMPERRORCOUNT 'precompilation xmsg:= - $defOp ^= nil and not $InteractiveMode => [$defOp,'": ",:msg] + $defOp ~= nil and not $InteractiveMode => [$defOp,'": ",:msg] msg $postStack:= [xmsg,:$postStack] nil @@ -220,7 +220,7 @@ postDef t == lhs is ["macro",name] => postMDef ["==>",name,rhs] recordHeaderDocumentation nil - if $maxSignatureLineNumber ^= 0 then + if $maxSignatureLineNumber ~= 0 then $docList := [["constructor",:$headerDocumentation],:$docList] $maxSignatureLineNumber := 0 --reset this for next constructor; see recordDocumentation @@ -245,7 +245,7 @@ postDefArgs: %List -> %List postDefArgs argl == null argl => argl argl is [[":",a],:b] => - b ^= nil => postError + b ~= nil => postError ['" Argument",:bright a,'"of indefinite length must be last"] atom a or a is ["QUOTE",:.] => a postError diff --git a/src/interp/profile.boot b/src/interp/profile.boot index 03da2628..94ea6fa7 100644 --- a/src/interp/profile.boot +++ b/src/interp/profile.boot @@ -74,7 +74,7 @@ profileRecord(label,name,info) == --name: info is var: type or op: sig profileDisplay() == profileDisplayOp('constructor,LASSOC('constructor,$profileAlist) ) - for [op,:alist1] in $profileAlist | op ^= 'constructor repeat + for [op,:alist1] in $profileAlist | op ~= 'constructor repeat profileDisplayOp(op,alist1) profileDisplayOp(op,alist1) == diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot index 775236e0..15b5716d 100644 --- a/src/interp/pspad1.boot +++ b/src/interp/pspad1.boot @@ -551,7 +551,7 @@ pspadOpBindingPower(op,LedOrNud,leftOrRight) == bp:= leftOrRight="left" => leftBindingPowerOf(op,LedOrNud) rightBindingPowerOf(op,LedOrNud) - bp^=exception => bp + bp ~= exception => bp 1000 formatOpBindingPower(op,key,leftOrRight) == @@ -572,7 +572,7 @@ formatOpBindingPower(op,key,leftOrRight) == formatInfixOp(op,:options) == qualification := IFCAR options qualification or - (op ^= '_$) and ^MEMQ(op,$spadTightList) => format " " and formatQual(op,qualification) and format " " + (op ~= '_$) and ^MEMQ(op,$spadTightList) => format " " and formatQual(op,qualification) and format " " format op --====================================================================== diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot index 074af02f..0010b384 100644 --- a/src/interp/pspad2.boot +++ b/src/interp/pspad2.boot @@ -579,10 +579,10 @@ isIdentifier x == IDENTP x => s:= PNAME x #s = 0 => nil - ALPHA_-CHAR_-P s.(0) => and/[s.i^=char '" " for i in 1..MAXINDEX s] + ALPHA_-CHAR_-P s.(0) => and/[s.i ~= char '" " for i in 1..MAXINDEX s] #s>1 => or/[ALPHA_-CHAR_-P s.i for i in 1..(m:= MAXINDEX s)] => - and/[s.i^=char '" " for i in 1..m] => true + and/[s.i ~= char '" " for i in 1..m] => true isGensym x == s := STRINGIMAGE x diff --git a/src/interp/record.boot b/src/interp/record.boot index 74591e14..b16dbabe 100644 --- a/src/interp/record.boot +++ b/src/interp/record.boot @@ -108,7 +108,7 @@ printRecordFile(pathname,:option) == for x in i repeat sayBrightly x sayNewLine() for x in o repeat maPrin x - if t^= '(Void) then printTypeAndTime(nil,t) + if t ~= '(Void) then printTypeAndTime(nil,t) testPrin(u,w) == --same as maPrin but lines are stored in $testOutputLineList --these lines are needed for pasting into HT files @@ -194,12 +194,12 @@ evaluateLines lines == wasIs(old,new,:typePart) == sayBrightly '"*************************************************************" - if old ^= new then + if old ~= new then sayBrightly '"Was ----------> " for x in old repeat maPrin x sayBrightly '"Is -----------> " for x in new repeat maPrin x - typePart is [oldtype,newtype] and oldtype ^= newtype => + typePart is [oldtype,newtype] and oldtype ~= newtype => sayBrightlyNT ['" Type was ---> ",oldtype] pp old sayBrightlyNT ['" Type is ---> ",newtype] diff --git a/src/interp/scan.boot b/src/interp/scan.boot index a5fc4135..184e8b40 100644 --- a/src/interp/scan.boot +++ b/src/interp/scan.boot @@ -535,11 +535,11 @@ scanW(b)== -- starts pointing to first char $n:=$n+1 -- the first character is not tested l:=$sz endid:=posend($ln,$n) - if endid=l or QENUM($ln,endid)^=ESCAPE + if endid=l or QENUM($ln,endid) ~= ESCAPE then -- not escaped $n:=endid [b,SUBSTRING($ln,n1,endid-n1)] -- l overflows - else -- escape and endid^=l + else -- escape and endid ~= l str:=SUBSTRING($ln,n1,endid-n1) $n:=endid+1 a:=scanEsc() @@ -573,7 +573,7 @@ spleI1(dig,zro) == n:=$n l:= $sz while $n<l and FUNCALL(dig,($ln.$n)) repeat $n:=$n+1 - if $n=l or QENUM($ln,$n)^=ESCAPE + if $n=l or QENUM($ln,$n) ~= ESCAPE then if n=$n and zro then '"0" else SUBSTRING($ln,n,$n-n) @@ -601,7 +601,7 @@ scanNumber() == if $n>=$sz then lfinteger a else - if QENUM($ln,$n)^=RADIX_CHAR + if QENUM($ln,$n) ~= RADIX_CHAR then if $floatok and QENUM($ln,$n)=DOT then diff --git a/src/interp/setvars.boot b/src/interp/setvars.boot index 6d79f999..51c31f6b 100644 --- a/src/interp/setvars.boot +++ b/src/interp/setvars.boot @@ -763,7 +763,7 @@ setFunctionsCache arg == TERPRI() sayAllCacheCounts() n := first arg - (n ^= 'all) and ((not FIXP n) or (n < 0)) => + (n ~= 'all) and ((not FIXP n) or (n < 0)) => sayMessage ['"Your value of",:bright n,'"is invalid because ..."] describeSetFunctionsCache() terminateSystemCommand() @@ -803,7 +803,7 @@ sayAllCacheCounts () == $cacheAlist => TERPRI() -- SAY '" However," - for [x,:n] in $cacheAlist | n ^= $cacheCount repeat sayCacheCount(x,n) + for [x,:n] in $cacheAlist | n ~= $cacheCount repeat sayCacheCount(x,n) sayCacheCount(fn,n) == @@ -1697,7 +1697,7 @@ setStreamsCalculate arg == (null arg) or (arg = "%describe%") or (first arg = '_?) => describeSetStreamsCalculate() n := first arg - (n ^= 'all) and ((not FIXP n) or (n < 0)) => + (n ~= 'all) and ((not FIXP n) or (n < 0)) => sayMessage ['"Your value of",:bright n,'"is invalid because ..."] describeSetStreamsCalculate() terminateSystemCommand() diff --git a/src/interp/simpbool.boot b/src/interp/simpbool.boot index 8154dbcd..e487d986 100644 --- a/src/interp/simpbool.boot +++ b/src/interp/simpbool.boot @@ -64,7 +64,7 @@ simpBoolGiven(x,world) == 'false = be mkpf([['NOT,x],:world],'AND) => true 'false = (y := be mkpf([x,:world],'AND)) => false (u := andReduce(dnf2pf y,world)) is ['AND,:v] and - (w := SETDIFFERENCE(v,world)) ^= v => simpBool ['AND,:w] + (w := SETDIFFERENCE(v,world)) ~= v => simpBool ['AND,:w] u 'false = (y := be x) => false 'true = y => true diff --git a/src/interp/slam.boot b/src/interp/slam.boot index 9340fe96..02556d43 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -166,7 +166,7 @@ assocCircular(x,al) == --like ASSOC except that al is circular compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == k:= #initCode extraArgumentCode := - extraArguments := [x for x in argl | x ^= sharpArg] => + extraArguments := [x for x in argl | x ~= sharpArg] => extraArguments is [x] => x ['LIST,:extraArguments] nil diff --git a/src/interp/topics.boot b/src/interp/topics.boot index afda0b98..f8d84dac 100644 --- a/src/interp/topics.boot +++ b/src/interp/topics.boot @@ -99,11 +99,11 @@ mkTopicHashTable() == --given $groupAssoc = ((extended . line.0 = char '_- => 'skip --2 constructorName or operation name line := trimString line --3-n ... m := MAXINDEX line -- (blank line) ... - line.m ^= (char '_:) => systemError('"wrong heading") + line.m ~= (char '_:) => systemError('"wrong heading") con := INTERN SUBSTRING(line,0,m) alist := [lst while not EOFP instream and not (blankLine? (line := READLINE instream)) and - line.0 ^= char '_- for i in 1.. + line.0 ~= char '_- for i in 1.. | lst := string2OpAlist line] alist => HPUT($conTopicHash,con,alist) --initialize table of topic classes @@ -198,7 +198,7 @@ tdAdd(con,hash) == v := HGET($conTopicHash,con) u := addTopic2Documentation(con,v) --u := getConstructorDocumentationFromDB con - for pair in u | FIXP (code := myLastAtom pair) and (op := CAR pair) ^= 'construct repeat + for pair in u | FIXP (code := myLastAtom pair) and (op := CAR pair) ~= 'construct repeat for x in (names := code2Classes code) repeat HPUT(hash,x,insert(op,HGET(hash,x))) tdPrint hash == @@ -221,7 +221,7 @@ topics con == code2Classes cc == cc := 2*cc - [x while cc ^= 0 for x in $topicClasses | ODDP (cc := QUOTIENT(cc,2))] + [x while cc ~= 0 for x in $topicClasses | ODDP (cc := QUOTIENT(cc,2))] myLastAtom x == while x is [.,:x] repeat nil diff --git a/src/interp/trace.boot b/src/interp/trace.boot index e98991b5..fe279b93 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -272,7 +272,7 @@ stackTraceOptionError x == nil removeOption(op,options) == - [optEntry for (optEntry:=[opt,:.]) in options | opt ^= op] + [optEntry for (optEntry:=[opt,:.]) in options | opt ~= op] domainToGenvar x == $doNotAddEmptyModeIfTrue: local:= true diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot index d7399ea5..558bd60b 100644 --- a/src/interp/wi1.boot +++ b/src/interp/wi1.boot @@ -351,7 +351,7 @@ compAtom(x,m,e) == compSymbol(x,m,e) or return nil m = $Expression and primitiveType x => [x,m,e] STRINGP x => - x ^= '"failed" and (member($Symbol, $localImportStack) or + x ~= '"failed" and (member($Symbol, $localImportStack) or member($Symbol, $globalImportStack)) => markAt [x, '(String), e] [x, x, e] [x,primitiveType x or return nil,e] @@ -564,7 +564,7 @@ setqSingle(id,val,m,E) == (trialT and coerce(trialT,m'')) or eval or return nil where eval() == T:= comp(val,m'',E) => T - not get(id,"mode",E) and m'' ^= (maxm'':=maximalSuperType m'') and + not get(id,"mode",E) and m'' ~= (maxm'':=maximalSuperType m'') and (T:=comp(val,maxm'',E)) => T (T:= comp(val,$EmptyMode,E)) and getmode(T.mode,E) => assignError(val,T.mode,id,m'') @@ -619,7 +619,7 @@ setqMultiple(nameList,val,m,e) == comp(t,$EmptyMode,e) is [.,["RecordCategory",:l],.] => [[name,:mode] for [":",name,mode] in l] stackMessage ["no multiple assigns to mode: ",t] - #nameList^=#selectorModePairs => + #nameList ~= #selectorModePairs => stackMessage [val," must decompose into ",#nameList," components"] -- 3.generate code; return assignList:= @@ -629,7 +629,7 @@ setqMultiple(nameList,val,m,e) == else [MKPROGN [x,:assignList,g],m',e] setqMultipleExplicit(nameList,valList,m,e) == - #nameList^=#valList => + #nameList ~= #valList => stackMessage ["Multiple assignment error; # of items in: ",nameList, "must = # in: ",valList] gensymList:= [genVariable() for name in nameList] @@ -796,7 +796,7 @@ resolve(min, mout) == dout=$EmptyMode => din STRINGP din and dout = $Symbol => dout ------> hack 8/14/94 STRINGP dout and din = $Symbol => din ------> hack 8/14/94 - din^=dout and (STRINGP din or STRINGP dout) => + din ~= dout and (STRINGP din or STRINGP dout) => modeEqual(dout,$String) => dout modeEqual(din,$String) => nil mkUnion(din,dout) @@ -1200,7 +1200,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, -- 4. compile body in environment of %type declarations for arguments op':= $op -- following line causes cats with no with or Join to be fresh copies - if opOf(formalBody)^='Join and opOf(formalBody)^='mkCategory then + if opOf(formalBody) ~= 'Join and opOf(formalBody) ~= 'mkCategory then formalBody := ['Join, formalBody] T := compOrCroak(formalBody,signature'.target,e) --------------------> new <------------------- diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index db91465c..ef4eda87 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -178,7 +178,7 @@ compDefineFunctor1(df, m,$e,$prefix,$formalArgList) == $insideFunctorIfTrue:= false if $LISPLIB then $lisplibKind:= - $functorTarget is ["CATEGORY",key,:.] and key^="domain" => 'package + $functorTarget is ["CATEGORY",key,:.] and key~="domain" => 'package 'domain $lisplibForm:= form modemap:= [[parForm,:parSignature],[true,op']] @@ -467,7 +467,7 @@ corrupted? u == -- From apply.boot --====================================================================== applyMapping([op,:argl],m,e,ml) == - #argl^=#ml-1 => nil + #argl~=#ml-1 => nil isCategoryForm(first ml,e) => --is op a functor? pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList] @@ -581,7 +581,7 @@ compElt(origForm,m,E) == m := SUBST('Rep,'_$,m) ----------> new: <----------- [sig,[pred,val]]:= modemap - #sig^=2 and ^val is ["elt",:.] => nil --what does the second clause do ???? + #sig~=2 and ^val is ["elt",:.] => nil --what does the second clause do ???? --+ val := genDeltaEntry [opOf anOp,:modemap] x := markTran(origForm,[val],sig,[E]) @@ -599,7 +599,7 @@ compApplyModemap(form,modemap,$e) == -- 0. fail immediately if #argl=#margl - if #argl^=#margl then return nil + if #argl~=#margl then return nil -- 1. use modemap to evaluate arguments, returning failed if -- not possible @@ -707,7 +707,7 @@ genDeltaEntry opMmPair == -- following hack needed to invert Rep to $ substitution if odc = 'Rep and cform is [.,.,osig] then sig:=osig newimp := optDeltaEntry(op,sig,dc,eltOrConst) => newimp - setDifference(listOfBoundVars dc,$functorLocalParameters) ^= [] => + setDifference(listOfBoundVars dc,$functorLocalParameters) ~= [] => ['applyFun,['compiledLookupCheck,MKQ op, mkList consSig(sig,dc),consDomainForm(dc,nil)]] --if null atom dc then @@ -885,7 +885,7 @@ smallIntegerStep(it,index,start,inc,optFinal,e) == --fail if ----> a) index has a mode that is not $SmallInteger ----> b) one of start,inc, final won't comp as a $SmallInteger - mode and mode ^= $SmallInteger => nil + mode and mode ~= $SmallInteger => nil null (start':= comp(start,$SmallInteger,e)) => nil null (inc':= comp(inc,$SmallInteger,start'.env)) => nil if optFinal is [final] and not (final':= comp(final,$SmallInteger,inc'.env)) then @@ -894,7 +894,7 @@ smallIntegerStep(it,index,start,inc,optFinal,e) == -----> assume that optFinal is $SmallInteger T := comp(final,$EmptyMode,inc'.env) or return nil final' := T - maximalSuperType T.mode ^= $Integer => return nil + maximalSuperType T.mode ~= $Integer => return nil givenRange := T.mode indexmode:= $SmallInteger [.,.,e]:= compMakeDeclaration(index,indexmode, @@ -1026,7 +1026,7 @@ doItIf(item is [.,p,x,y],$predl,$e) == olde:= $e [p',.,$e]:= qt(19,comp(p,$Boolean,$e)) or userError ['"not a Boolean:",p] oldFLP:=$functorLocalParameters - if x^="%noBranch" then + if x~="%noBranch" then --> new <----------------------- qe(20,compSingleCapsuleItem(x,[p,:$predl],getSuccessEnvironment(markKillAll p,$e))) ---> new ----------- @@ -1057,7 +1057,7 @@ doItIf(item is [.,p,x,y],$predl,$e) == $functorLocalParameters:=[:oldFLP,:REVERSE nils] REVERSE ans oldFLP:=$functorLocalParameters - if y^="%noBranch" then + if y~="%noBranch" then --> new <----------------------- qe(21,compSingleCapsuleItem(y,[['not, p],:$predl],getInverseEnvironment(markKillAll p,olde))) --> ----------- diff --git a/src/interp/word.boot b/src/interp/word.boot index dc298f5f..c13b55a0 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -164,7 +164,7 @@ pickANumber(word,list) == maxWidth:= 38 - 2*(1+xx) [short,long] := say2Split(list,nil,nil,maxWidth) extra:= - REMAINDER(length := # short,2) ^= 0 => 1 + REMAINDER(length := # short,2) ~= 0 => 1 0 halfLength:= length/2 firstList:= TAKE(halfLength,short) @@ -194,7 +194,7 @@ bootSearch word == list := hasWildCard? key => pattern := patternTran key -- converts * to & - pattern.0 ^= '_& => + pattern.0 ~= '_& => [x for [x,:.] in HGET($functionTable,UPCASE pattern.0)| match?(pattern,COPY x)] "append"/[[x for [x,:.] in HGET($functionTable,k)| match?(pattern,COPY x)] |