aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/br-data.boot2
-rw-r--r--src/interp/br-saturn.boot2
-rw-r--r--src/interp/c-util.boot6
-rw-r--r--src/interp/cattable.boot2
-rw-r--r--src/interp/compiler.boot4
-rw-r--r--src/interp/database.boot16
-rw-r--r--src/interp/define.boot6
-rw-r--r--src/interp/format.boot2
-rw-r--r--src/interp/g-opt.boot2
-rw-r--r--src/interp/g-util.boot4
-rw-r--r--src/interp/i-coerfn.boot2
-rw-r--r--src/interp/i-map.boot2
-rw-r--r--src/interp/i-syscmd.boot2
-rw-r--r--src/interp/scan.boot4
-rw-r--r--src/interp/sys-macros.lisp2
-rw-r--r--src/interp/topics.boot2
-rw-r--r--src/interp/trace.boot10
-rw-r--r--src/interp/union.lisp61
-rw-r--r--src/interp/vmlisp.lisp8
19 files changed, 35 insertions, 104 deletions
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index 5c9ba63b..33cd85a4 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -766,7 +766,7 @@ extendLocalLibdb conlist == -- called by compileSpad2Cmd
not $createLocalLibDb => nil
null conlist => nil
buildLibdb conlist --> puts datafile into temp.text
- $newConstructorList := union(conlist, $newConstructorList)
+ $newConstructorList := setUnion(conlist, $newConstructorList)
localLibdb := '"libdb.text"
not PROBE_-FILE '"libdb.text" =>
RENAME_-FILE('"temp.text",'"libdb.text")
diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot
index a06b0f8f..9fad03b0 100644
--- a/src/interp/br-saturn.boot
+++ b/src/interp/br-saturn.boot
@@ -1241,7 +1241,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate,
which = '"attribute" or which = '"constructor" => sig
$conkind ~= '"package" => sig
symbolsUsed := [x for x in rest conform | ident? x]
- $DomainList := SETDIFFERENCE($DomainList,symbolsUsed)
+ $DomainList := setDifference($DomainList,symbolsUsed)
getSubstSigIfPossible sig
-----------------------------------------------------------
htSaySaturn '"\begin{tabular}{lp{0in}}"
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 62defa25..c5131859 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -416,9 +416,9 @@ intersectionContour(c,c') ==
computeIntersection(c,c') ==
varlist:= removeDuplicates ASSOCLEFT c
varlist':= removeDuplicates ASSOCLEFT c'
- interVars:= intersection(varlist,varlist')
- unionVars:= union(varlist,varlist')
- diffVars:= setDifference(unionVars,interVars)
+ interVars := setIntersection(varlist,varlist')
+ unionVars := setUnion(varlist,varlist')
+ diffVars := setDifference(unionVars,interVars)
modeAssoc:= buildModeAssoc(diffVars,c,c')
[:modeAssoc,:
[[x,:proplist]
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 9a4e4d2d..7e225cc6 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -63,7 +63,7 @@ genCategoryTable() ==
[addDomainToTable(con,getConstrCat getConstructorCategory con)
for con in allConstructors() | getConstructorKindFromDB con is "domain"]
-- $nonLisplibDomains, $noCategoryDomains are set in BUILDOM BOOT
- specialDs := SETDIFFERENCE($nonLisplibDomains,$noCategoryDomains)
+ specialDs := setDifference($nonLisplibDomains,$noCategoryDomains)
domainTable:= [:[addDomainToTable(id, getConstrCat eval([id]).3)
for id in specialDs], :domainTable]
for [id,:entry] in domainTable repeat
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 1a4aa55a..519f31dd 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -264,12 +264,12 @@ freeVarUsage([.,vars,body],env) ==
op := u.op
op in '(QUOTE GO function) => free
op = "LAMBDA" =>
- bound := UNIONQ(bound, second u)
+ bound := setUnion(bound, second u)
for v in CDDR u repeat
free := freeList(v,bound,free,e)
free
op = "PROG" =>
- bound := UNIONQ(bound, second u)
+ bound := setUnion(bound, second u)
for v in CDDR u | cons? v repeat
free := freeList(v,bound,free,e)
free
diff --git a/src/interp/database.boot b/src/interp/database.boot
index c4a42992..bee544b0 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -307,13 +307,13 @@ orderPredTran(oldList,sig,skip) ==
--pp lastPreds
--(2a) lastDependList=list of all variables that lastPred forms depend upon
- lastDependList := "UNIONQ"/[listOfPatternIds x for x in lastPreds]
+ lastDependList := setUnion/[listOfPatternIds x for x in lastPreds]
--sayBrightlyNT "lastDependList="
--pp lastDependList
--(2b) dependList=list of all variables that isDom/ofCat forms depend upon
dependList :=
- "UNIONQ"/[listOfPatternIds y for x in oldList |
+ setUnion/[listOfPatternIds y for x in oldList |
x is ['isDomain,.,y] or x is ['ofCategory,.,y]]
--sayBrightlyNT "dependList="
--pp dependList
@@ -326,8 +326,8 @@ orderPredTran(oldList,sig,skip) ==
else
indepvl := listOfPatternIds x
depvl := nil
- (INTERSECTIONQ(indepvl,dependList) = nil)
- and INTERSECTIONQ(indepvl,lastDependList) =>
+ setIntersection(indepvl,dependList) = nil
+ and setIntersection(indepvl,lastDependList) =>
somethingDone := true
lastPreds := [:lastPreds,x]
oldList := remove(oldList,x)
@@ -346,7 +346,7 @@ orderPredTran(oldList,sig,skip) ==
else
indepvl := listOfPatternIds x
depvl := nil
- (INTERSECTIONQ(indepvl,dependList) = nil) =>
+ setIntersection(indepvl,dependList) = nil =>
dependList := setDifference(dependList,depvl)
newList := [:newList,x]
-- sayBrightlyNT "newList="
@@ -365,14 +365,14 @@ orderPredTran(oldList,sig,skip) ==
if pred is ['isDomain,x,y] or x is ['ofCategory,x,y] then
ids:= listOfPatternIds y
if "and"/[symbolMember?(id,fullDependList) for id in ids] then
- fullDependList:= insertWOC(x,fullDependList)
- fullDependList:= UNIONQ(fullDependList,ids)
+ fullDependList := insertWOC(x,fullDependList)
+ fullDependList := setUnion(fullDependList,ids)
newList:=[:newList,:lastPreds]
--substitute (isDomain ..) forms as completely as possible to avoid false paths
newList := isDomainSubst newList
- answer := [['AND,:newList],:INTERSECTIONQ(fullDependList,sig)]
+ answer := [['AND,:newList],:setIntersection(fullDependList,sig)]
--sayBrightlyNT '"answer="
--pp answer
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 96db10dc..2b3c9ab1 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -968,7 +968,7 @@ mkCategoryPackage(form is [op,:argl],cat,def) ==
abbreviationsSpad2Cmd ['package,packageAbb,packageName]
-- This is a little odd, but the parser insists on calling
-- domains, rather than packages
- nameForDollar := first SETDIFFERENCE('(S A B C D E F G H I),argl)
+ nameForDollar := first setDifference('(S A B C D E F G H I),argl)
packageArgl := [nameForDollar,:argl]
capsuleDefAlist := fn(def,nil) where fn(x,oplist) ==
x isnt [.,:.] => oplist
@@ -1654,7 +1654,7 @@ compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) ==
argDepAlist :=
[[x,:dependencies] for [x,:y] in argSigAlist] where
dependencies() ==
- union(listOfIdentifiersIn y,
+ setUnion(listOfIdentifiersIn y,
remove(listOfIdentifiersIn LASSOC(x,$predAlist),x))
argSigAlist := [:$sigAlist,:pairList(argList,sigList)]
@@ -1681,7 +1681,7 @@ orderByDependency(vl,dl) ==
fatalError => userError '"Parameter specification error"
until vl = nil repeat
newl:=
- [v for v in vl for d in dl | null intersection(d,vl)] or return nil
+ [v for v in vl for d in dl | setIntersection(d,vl) = nil] or return nil
orderedVarList:= [:newl,:orderedVarList]
vl' := setDifference(vl,newl)
dl' := [setDifference(d,newl) for x in vl for d in dl
diff --git a/src/interp/format.boot b/src/interp/format.boot
index cc3d5309..c368f164 100644
--- a/src/interp/format.boot
+++ b/src/interp/format.boot
@@ -81,7 +81,7 @@ displayTranModemap (mm is [[x,:sig],[pred,:y],:z]) ==
listOfPredOfTypePatternIds p ==
p is ['AND,:lp] or p is ['OR,:lp] =>
- UNIONQ([:listOfPredOfTypePatternIds p1 for p1 in lp],nil)
+ setUnion([:listOfPredOfTypePatternIds p1 for p1 in lp],nil)
p is [op,a,.] and op = 'ofType =>
isPatternVar a => [a]
nil
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 958a1f6a..38ad55b6 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -506,7 +506,7 @@ findVMFreeVars form ==
op is "QUOTE" => nil
vars := union/[findVMFreeVars arg for arg in args]
op isnt [.,:.] => vars
- union(findVMFreeVars op,vars)
+ setUnion(findVMFreeVars op,vars)
++ Return true is `var' is the left hand side of an assignment
++ in `form'.
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 67d2efb2..43cc0bef 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -581,13 +581,13 @@ freeOfSharpVars x ==
listOfSharpVars x ==
x isnt [.,:.] => (isSharpVarWithNum x => [x]; nil)
- union(listOfSharpVars first x,listOfSharpVars rest x)
+ setUnion(listOfSharpVars first x,listOfSharpVars rest x)
listOfPatternIds x ==
isPatternVar x => [x]
x isnt [.,:.] => nil
x is ['QUOTE,:.] => nil
- UNIONQ(listOfPatternIds first x,listOfPatternIds rest x)
+ setUnion(listOfPatternIds first x,listOfPatternIds rest x)
isPatternVar v ==
-- a pattern variable consists of a star followed by a star or digit(s)
diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot
index a8409b09..eba7c9c4 100644
--- a/src/interp/i-coerfn.boot
+++ b/src/interp/i-coerfn.boot
@@ -65,7 +65,7 @@ Dmp2Dmp(u,source is [dmp,v1,S], target is [.,v2,T]) ==
u is [[e,:c]] and e = vector [0 for v in v1] =>
z:= coerceInt(objNewWrap(c,S),target) => objValUnwrap(z)
coercionFailure()
- v:= intersection(v1,v2) =>
+ v := intersection(v1,v2) =>
w1:= SETDIFFERENCE(v1,v) =>
coerceDmp1(u,source,target,v,w1)
coerceDmp2(u,source,target)
diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot
index 75312782..45049109 100644
--- a/src/interp/i-map.boot
+++ b/src/interp/i-map.boot
@@ -386,7 +386,7 @@ clearDep1(x,toDoList,doneList,depList) ==
a:= ASSQ(x,depList)
a =>
depList := remove(depList,a)
- toDoList := union(toDoList,
+ toDoList := setUnion(toDoList,
setDifference(rest a,doneList))
toDoList is [a,:res] => clearDep1(a,res,newDone,depList)
'done
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index 9c5696af..09b1b3e1 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -824,7 +824,7 @@ displayWorkspaceNames() ==
if null names
then sayBrightly " * None *"
else sayAsManyPerLineAsPossible [object2String x for x in names]
- imacs := SETDIFFERENCE(imacs,pmacs)
+ imacs := setDifference(imacs,pmacs)
if imacs then
sayMessage '"Names of System-Defined Objects in the Workspace:"
sayAsManyPerLineAsPossible [object2String x for x in imacs]
diff --git a/src/interp/scan.boot b/src/interp/scan.boot
index 331cac7a..3f55284f 100644
--- a/src/interp/scan.boot
+++ b/src/interp/scan.boot
@@ -193,10 +193,10 @@ scanDict:=scanDictCons()
scanPunCons()==
a := makeBitVector 256
for i in 0..255 repeat
- bitmask(a,i) := 0
+ bitref(a,i) := 0
for [k,:.] in entries scanKeyTable repeat
if not startsId? stringChar(k,0) then
- bitmask(a,codePoint stringChar(k,0)) := 1
+ bitref(a,codePoint stringChar(k,0)) := 1
a
scanPun:=scanPunCons()
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 65777a4d..10357fdc 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -752,7 +752,7 @@
(APPEND NIL)
(|append| NIL)
(UNION NIL)
- (UNIONQ NIL)
+ (|setUnion| NIL)
(|gcd| (|Zero|))
(|union| NIL)
(|append!| NIL)
diff --git a/src/interp/topics.boot b/src/interp/topics.boot
index 31c4bfb2..191606aa 100644
--- a/src/interp/topics.boot
+++ b/src/interp/topics.boot
@@ -161,7 +161,7 @@ topicCode lst ==
u := [y for x in lst] where y() ==
rename := LASSOC(x,$topicSynonyms) => rename
x
- if null intersection('(basic extended hidden),u) then u := ['extended,:u]
+ if setIntersection('(basic extended hidden),u) = nil then u := ['extended,:u]
bitIndexList := nil
for x in removeDuplicates u repeat
bitIndexList := [fn x,:bitIndexList] where fn x ==
diff --git a/src/interp/trace.boot b/src/interp/trace.boot
index 9d079469..5e2e92d4 100644
--- a/src/interp/trace.boot
+++ b/src/interp/trace.boot
@@ -365,7 +365,7 @@ getMapSubNames(l) ==
for mapName in l repeat
lmm:= get(mapName,'localModemap,$InteractiveFrame) =>
subs:= append([[mapName,:second mm] for mm in lmm],subs)
- union(subs,getPreviousMapSubNames UNIONQ(_/TRACENAMES,
+ setUnion(subs,getPreviousMapSubNames setUnion(_/TRACENAMES,
$lastUntraced))
getPreviousMapSubNames(traceNames) ==
@@ -411,7 +411,7 @@ untraceMapSubNames traceNames ==
for name in (subs:= ASSOCRIGHT $mapSubNameAlist)
| symbolMember?(name,_/TRACENAMES) repeat
_/UNTRACE_,2(name,nil)
- $lastUntraced:= SETDIFFERENCE($lastUntraced,subs)
+ $lastUntraced := setDifference($lastUntraced,subs)
funfind("functor","opname") ==
ops:= isFunctor functor
@@ -528,7 +528,7 @@ untraceDomainLocalOps(dom,lops) ==
untraceAllDomainLocalOps(dom) == nil
-- abb := abbreviate dom
-- actualLops := getLocalOpsFromLisplib abb
--- null (l := intersection(actualLops,_/TRACENAMES)) => nil
+-- null (l := setIntersection(actualLops,_/TRACENAMES)) => nil
-- _/UNTRACE_,1(l,nil)
-- nil
@@ -772,7 +772,7 @@ tracelet(fn,vars) ==
fn = 'Undef => nil
vars:=
vars="all" => "all"
- l:= LASSOC(fn,$letAssoc) => union(vars,l)
+ l:= LASSOC(fn,$letAssoc) => setUnion(vars,l)
vars
$letAssoc:= [[fn,:vars],:$letAssoc]
if $letAssoc then SETLETPRINTFLAG true
@@ -792,7 +792,7 @@ breaklet(fn,vars) ==
fn = "Undef" => nil
fnEntry:= LASSOC(fn,$letAssoc)
vars:=
- pair := symbolLassoc("BREAK",fnEntry) => union(vars,rest pair)
+ pair := symbolLassoc("BREAK",fnEntry) => setUnion(vars,rest pair)
vars
$letAssoc:=
null fnEntry => [[fn,:[["BREAK",:vars]]],:$letAssoc]
diff --git a/src/interp/union.lisp b/src/interp/union.lisp
index 955cd4c4..67b99855 100644
--- a/src/interp/union.lisp
+++ b/src/interp/union.lisp
@@ -55,25 +55,6 @@
(QRPLACD V (SETQ V (CONS I NIL))) ) )
(GO LP) ) )
-(DEFUN INTERSECTIONQ (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2)
- (PROG (I H V)
- (SETQ V (SETQ H (CONS NIL NIL)))
- (COND
- ( (NOT (LISTP LIST-OF-ITEMS-1))
- (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) )
- (COND
- ( (NOT (LISTP LIST-OF-ITEMS-2))
- (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) )
- LP (COND
- ( (NOT (CONSP LIST-OF-ITEMS-1))
- (RETURN (QCDR H)) )
- ( (|symbolMember?|
- (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1))))
- (QCDR H)) )
- ( (|symbolMember?| I LIST-OF-ITEMS-2)
- (QRPLACD V (SETQ V (CONS I NIL))) ) )
- (GO LP) ) )
-
(DEFUN |union| (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2)
(PROG (I H V)
(SETQ H (SETQ V (CONS NIL NIL)))
@@ -97,29 +78,6 @@
(QRPLACD V (SETQ V (CONS I NIL))) ) )
(GO LP1) ) )
-(DEFUN UNIONQ (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2)
- (PROG (I H V)
- (SETQ H (SETQ V (CONS NIL NIL)))
- (COND
- ( (NOT (LISTP LIST-OF-ITEMS-1))
- (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) )
- (COND
- ( (NOT (LISTP LIST-OF-ITEMS-2))
- (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) )
- LP1 (COND
- ( (NOT (CONSP LIST-OF-ITEMS-1))
- (COND
- ( (CONSP LIST-OF-ITEMS-2)
- (SETQ LIST-OF-ITEMS-1 (RESETQ LIST-OF-ITEMS-2 NIL)) )
- ( 'T
- (RETURN (QCDR H)) ) ) )
- ( (NOT
- (|symbolMember?|
- (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1))))
- (QCDR H)))
- (QRPLACD V (SETQ V (CONS I NIL))) ) )
- (GO LP1) ) )
-
(DEFUN SETDIFFERENCE (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2)
(PROG (I H V)
(SETQ H (SETQ V (CONS NIL NIL)))
@@ -138,22 +96,3 @@
( (NOT (|member| I LIST-OF-ITEMS-2))
(QRPLACD V (SETQ V (CONS I NIL))) ) )
(GO LP1) ) )
-
-(DEFUN SETDIFFERENCEQ (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2)
- (PROG (I H V)
- (SETQ H (SETQ V (CONS NIL NIL)))
- (COND
- ( (NOT (LISTP LIST-OF-ITEMS-1))
- (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) )
- (COND
- ( (NOT (LISTP LIST-OF-ITEMS-2))
- (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) )
- LP1 (COND
- ( (NOT (CONSP LIST-OF-ITEMS-1))
- (RETURN (QCDR H)) )
- ( (|symbolMember?|
- (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1))))
- (QCDR H)) )
- ( (NOT (|symbolMember?| I LIST-OF-ITEMS-2))
- (QRPLACD V (SETQ V (CONS I NIL))) ) )
- (GO LP1) ) )
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 24e904c1..ab04002a 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -722,14 +722,6 @@
(defun VEC2LIST (vec) (coerce vec 'list))
-; note default test for union, intersection and set-difference is eql
-;; following are defined so as to preserve ordering in union.lisp
-;;(defun SETDIFFERENCE (l1 l2) (set-difference l1 l2 :test #'equalp))
-;;(defun SETDIFFERENCEQ (l1 l2) (set-difference l1 l2 :test #'eq))
-;;(defun |union| (l1 l2) (union l1 l2 :test #'equalp))
-;;(defun UNIONQ (l1 l2) (union l1 l2 :test #'eq))
-;;(defun |intersection| (l1 l2) (intersection l1 l2 :test #'equalp))
-;;(defun INTERSECTIONQ (l1 l2) (intersection l1 l2 :test #'eq))
(defun |member| (item sequence)
(cond ((symbolp item) (member item sequence :test #'eq))
((stringp item) (member item sequence :test #'equal))
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-09 03:03:50 +0000