aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/br-op1.boot4
-rw-r--r--src/interp/c-util.boot12
-rw-r--r--src/interp/cattable.boot2
-rw-r--r--src/interp/clam.boot8
-rw-r--r--src/interp/define.boot2
-rw-r--r--src/interp/i-coerfn.boot4
-rw-r--r--src/interp/i-output.boot2
-rw-r--r--src/interp/i-syscmd.boot2
-rw-r--r--src/interp/showimp.boot6
-rw-r--r--src/interp/sys-utility.boot3
-rw-r--r--src/interp/vmlisp.lisp10
11 files changed, 24 insertions, 31 deletions
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot
index c31af10f..db446fb5 100644
--- a/src/interp/br-op1.boot
+++ b/src/interp/br-op1.boot
@@ -405,8 +405,8 @@ dbGatherDataImplementation(htPage,opAlist) ==
key is 'nowhere => nowheres := [x,:nowheres]
key is 'constant =>constants := [x,:constants]
others := [x,:others] --add chain domains go here
- fn [nowheres,constants,domexports,SORTBY('CDDR,reverse! others),SORTBY('CDDR,
- reverse! defexports),SORTBY('CDDR,reverse! unexports)] where
+ fn [nowheres,constants,domexports,sortBy('CDDR,others),
+ sortBy('CDDR,defexports),sortBy('CDDR,unexports)] where
fn l ==
alist := nil
for u in l repeat
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index e09772c6..a032f0a8 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1825,9 +1825,9 @@ compileQuietly fn ==
++ If `x' is a formal map variable, returns its position.
++ Otherwise return nil.
-isFormal: %Symbol -> %Maybe %Short
-isFormal x ==
- POSITION(x,$FormalMapVariableList,KEYWORD::TEST, function EQ)
+formal?: %Symbol -> %Maybe %Short
+formal? x ==
+ or/[i for i in 0.. for y in $FormalMapVariableList | symbolEq?(x,y)]
++ Expand the form at position `slot' in the domain template `shell'
++ with argument list `args'.
@@ -1837,7 +1837,7 @@ expandFormTemplate(shell,args,slot) ==
slot = 2 => "$$"
expandFormTemplate(shell,args,vectorRef(shell,slot))
slot isnt [.,:.] => slot
- slot is ["local",parm] and (n := isFormal parm) =>
+ slot is ["local",parm] and (n := formal? parm) =>
args.n -- FIXME: we should probably expand with dual signature
slot is ['%eval,val] => val
slot is ['QUOTE,val] =>
@@ -1852,9 +1852,9 @@ equalFormTemplate(shell,args,slot,form) ==
slot = 0 => form = "$"
slot = 2 => form = "$$"
equalFormTemplate(shell,args,vectorRef(shell,slot),form)
- slot is ["local",parm] and (n := isFormal parm) =>
+ slot is ["local",parm] and (n := formal? parm) =>
equalFormTemplate(shell,args,args.n,form)
- slot is ["NTREVAL",val] => form = val
+ slot is ['%eval,val] => form = val
slot is ['QUOTE,val] =>
string? val or symbol? val or integer? val => val = form
slot = form
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 3ed51a32..34bd928e 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -272,7 +272,7 @@ formalSubstitute(form:=[.,:argl],u) ==
applySubst(pairList($FormalMapVariableList,argl),u)
isFormalArgumentList argl ==
- and/[x=fa for x in argl for fa in $FormalMapVariableList]
+ and/[symbolEq?(x,fa) for x in argl for fa in $FormalMapVariableList]
mkCategoryExtensionAlist cform ==
not cons? cform => nil
diff --git a/src/interp/clam.boot b/src/interp/clam.boot
index a0c57a41..f1f88374 100644
--- a/src/interp/clam.boot
+++ b/src/interp/clam.boot
@@ -364,7 +364,7 @@ clearCategoryCache catName ==
symbolValue(mkCacheName catName) := nil
displayHashtable x ==
- l:= reverse! SORTBY('CAR,[[opOf val,key] for [key,:val] in entries x])
+ l := sortBy(function first,[[opOf val,key] for [key,:val] in entries x])
for [a,b] in l repeat
sayBrightlyNT ['"%b",a,'"%d"]
pp b
@@ -387,7 +387,7 @@ reportCircularCacheStats(fn,n) ==
TERPRI()
displayCacheFrequency al ==
- al := reverse! SORTBY('CAR,al)
+ al := sortBy(function first,al)
sayBrightlyNT " #hits/#occurrences: "
for [a,:b] in al repeat sayBrightlyNT [a,"/",b," "]
TERPRI()
@@ -572,7 +572,7 @@ reportInstantiations() ==
sayBrightly ['"# instantiated/# dropped/domain name",
"%l",'"------------------------------------"]
nTotal:= mTotal:= rTotal := nForms:= 0
- for [n,m,form] in reverse! SORTBY('CADDR,conList) repeat
+ for [n,m,form] in sortBy(function third,conList) repeat
nTotal:= nTotal+n; mTotal:= mTotal+m
if n > 1 then rTotal:= rTotal + n-1
nForms:= nForms + 1
@@ -669,7 +669,7 @@ globalHashtableStats(x,sortFn) ==
argList1:= [constructor2ConstructorForm x for x in argList]
reportList:= [[n,key,argList1],:reportList]
sayBrightly ["%b"," USE NAME ARGS","%d"]
- for [n,fn,args] in reverse! SORTBY(sortFn,reportList) repeat
+ for [n,fn,args] in sortBy(sortFn,reportList) repeat
sayBrightlyNT [:rightJustifyString(n,6)," ",fn,": "]
pp args
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 8edc4da2..d2fa9601 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -465,7 +465,7 @@ NRTmakeCategoryAlist(db,e) ==
$catAncestorAlist: local := nil
pcAlist := [:[[x,:"T"] for x in $uncondAlist],:$condAlist]
$levelAlist: local := depthAssocList [CAAR x for x in pcAlist]
- opcAlist := reverse! SORTBY(function NRTcatCompare,pcAlist)
+ opcAlist := sortBy(function NRTcatCompare,pcAlist)
newPairlis := [[5 + i,:b] for [.,:b] in dbFormalSubst db for i in 1..]
slot1 := [[a,:k] for [a,:b] in dbSubstituteAllQuantified(db,opcAlist)
| (k := predicateBitIndex(b,e)) ~= -1]
diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot
index d1825ac3..bf42e2cf 100644
--- a/src/interp/i-coerfn.boot
+++ b/src/interp/i-coerfn.boot
@@ -287,7 +287,7 @@ Dmp2Up(u, source is [dmp,vl,S],target is [up,var,T]) ==
-- only one variable in DMP case
null vl' =>
- u' := reverse! SORTBY('CAR,[[e.0,:c] for [e,:c] in u])
+ u' := sortBy(function first,[[e.0,:c] for [e,:c] in u])
(u' := coerceInt(objNewWrap(u',[up,var,S]),target)) or
coercionFailure()
objValUnwrap u'
@@ -308,7 +308,7 @@ Dmp2Up(u, source is [dmp,vl,S],target is [up,var,T]) ==
p.rest := c'
zero = objValUnwrap(y) => 'iterate
x := [[exp,:objValUnwrap(y)],:x]
- y => reverse! SORTBY('CAR,x)
+ y => sortBy(function first,x)
coercionFailure()
removeVectorElt(v,pos) ==
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 421e9386..ccd535b7 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -1773,7 +1773,7 @@ charyTop(u,start,linelength) ==
-->
$testOutputLineFlag =>
$testOutputLineList :=
- [:ASSOCRIGHT SORTBY('CAR,d),:$testOutputLineList]
+ [:ASSOCRIGHT reverse! sortBy(function first,d),:$testOutputLineList]
until n < m repeat
scylla(n,d)
n := n - 1
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index d9cd3197..e15c18fb 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -2703,7 +2703,7 @@ workfilesSpad2Cmd args ==
centerAndHighlight(" User-specified work files ",$LINELENGTH,specialChar 'hbar)
SAY " "
null $sourceFiles => SAY '" no files specified"
- SETQ($sourceFiles,SORTBY('pathnameType,$sourceFiles))
+ SETQ($sourceFiles,sortBy(function pathnameType,$sourceFiles))
for fl in $sourceFiles repeat sayBrightly [" " ,namestring fl]
--% )zsystemdevelopment
diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot
index 000154f4..deb1f816 100644
--- a/src/interp/showimp.boot
+++ b/src/interp/showimp.boot
@@ -70,7 +70,7 @@ showImp(dom,:options) ==
missingOnlyFlag => 'done
--first display those exported by the domain, then add chain guys
- u := [:domexports,:constants,:SORTBY('CDDR,others)]
+ u := [:domexports,:constants,:reverse! sortBy(function CDDR,others)]
while u repeat
[.,.,:key] := first u
sayBrightly
@@ -78,14 +78,14 @@ showImp(dom,:options) ==
["Constants implemented by",:bright form2String key,'":"]
["Functions implemented by",:bright form2String key,'":"]
u := showDomainsOp1(u,key)
- u := SORTBY('CDDR,defexports)
+ u := reverse! sortBy(function CDDR,defexports)
while u repeat
[.,.,:key] := first u
defop := makeSymbol(subString((s := PNAME first key),0,maxIndex s))
domainForm := [defop,:CDDR key]
sayBrightly ["Default functions from",:bright form2String domainForm,'":"]
u := showDomainsOp1(u,key)
- u := SORTBY('CDDR,unexports)
+ u := reverse! sortBy(function CDDR,unexports)
while u repeat
[.,.,:key] := first u
sayBrightly ["Not exported: "]
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index 96bd829b..31168d54 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -388,6 +388,9 @@ remove!(l,x) ==
return l
p := rest p
+sortBy(k,l) ==
+ SORT(copyList l,function GGREATERP,key <- k)
+
++ Return the list of objects that follow x in l, including x itself.
++ Otherwise return nil.
upwardCut(x,l) ==
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index e571a161..47ccdec1 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -676,16 +676,6 @@
(SETQ Y (CDR Y))
(GO A)))))
-; 14.6 Miscellaneous
-
-(defun QSORT (l)
- (declare (special sortgreaterp))
- (|reverse!| (sort (copy-seq l) SORTGREATERP)))
-
-(defun SORTBY (keyfn l)
- (declare (special sortgreaterp))
- (|reverse!| (sort (copy-seq l) SORTGREATERP :key keyfn)))
-
; 16.0 Operations on Vectors
; 16.1 Creation
generated by cgit v1.2.3 (git 2.39.1) at 2024-08-12 01:24:19 +0000