aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog19
-rw-r--r--src/boot/ast.boot2
-rw-r--r--src/boot/strap/ast.clisp2
-rw-r--r--src/interp/buildom.boot6
-rw-r--r--src/interp/c-util.boot2
-rw-r--r--src/interp/cattable.boot2
-rw-r--r--src/interp/compiler.boot5
-rw-r--r--src/interp/define.boot12
-rw-r--r--src/interp/format.boot8
-rw-r--r--src/interp/functor.boot2
-rw-r--r--src/interp/hashcode.boot2
-rw-r--r--src/interp/i-output.boot2
-rw-r--r--src/interp/i-syscmd.boot5
-rw-r--r--src/interp/lisplib.boot2
-rw-r--r--src/interp/modemap.boot2
-rw-r--r--src/interp/rulesets.boot8
-rw-r--r--src/interp/slam.boot2
-rw-r--r--src/interp/sys-macros.lisp57
18 files changed, 53 insertions, 87 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index e2b58e79..380679bb 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,24 @@
2011-04-30 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/buildom.boot: Replace use of EQSUBSTLIST with applySubst.
+ * interp/c-util.boot: Likewise.
+ * interp/cattable.boot: Likewise.
+ * interp/compiler.boot: Likewise.
+ * interp/define.boot: Likewise.
+ * interp/format.boot: Likewise.
+ * interp/functor.boot: Likewise.
+ * interp/hashcode.boot: Likewise.
+ * interp/i-output.boot: Likewise.
+ * interp/i-syscmd.boot: Likewise.
+ * interp/lisplib.boot: Likewise.
+ * interp/modemap.boot: Likewise.
+ * interp/rulesets.boot: Likewise.
+ * interp/slam.boot: Likewise.
+ * interp/sys-macros.lisp (APPLYR, TAILFN, TAIL, rplac): Remove as
+ unused.
+
+2011-04-30 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* boot/tokens.boot: Don't rename append.
* boot/parser.boot (bpTyping): Support universally quantified types.
* boot/ast.boot: Rewrite APPEND as append.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 561c8746..84e631e6 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -161,7 +161,7 @@ bfPile: %List %Form -> %List %Form
bfPile(part) ==
part
-bfAppend: %List %List %List %Form -> %List %Form
+bfAppend: %List %List %Form -> %List %Form
bfAppend ls ==
ls isnt [l,:ls] => nil
r := copyList l
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 3a69097f..a020a01a 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -197,7 +197,7 @@
(DEFUN |bfPile| (|part|) |part|)
-(DECLAIM (FTYPE (FUNCTION ((|%List| (|%List| (|%List| |%Form|))))
+(DECLAIM (FTYPE (FUNCTION ((|%List| (|%List| |%Form|)))
(|%List| |%Form|))
|bfAppend|))
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 89115403..13fda91a 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -229,7 +229,7 @@ lookupInCategories(op,sig,dom,dollar) ==
-- this code (the old runtime scheme) is used only for
-- builtin constructors -- their predicates are always true.
r := or/[lookupInDomainVector(op,nsig,
- eval EQSUBSTLIST(valueList,varList,catform),dollar)
+ eval applySubst(pairList(varList,valueList),catform),dollar)
for catform in catformList | not null catform] where
valueList() ==
[MKQ dom,:[MKQ dom.(5+i) for i in 1..(#rest catform)]]
@@ -264,8 +264,8 @@ lookupInTable(op,sig,dollar,[domain,table]) ==
not compareSig(sig,sig1,dollar.0,domain) => false
code is ['subsumed,a] =>
subsumptionSig :=
- EQSUBSTLIST(rest(domain.0),$FormalMapVariableList,a)
- someMatch:=true
+ applySubst(pairList($FormalMapVariableList,vectorRef(domain,0).args),a)
+ someMatch := true
false
predIndex := code quo 8192
predIndex ~= 0 and not lookupPred($predVector.predIndex,dollar,domain)
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 30d4a769..38946378 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1331,7 +1331,7 @@ proclaimCapsuleFunction(op,sig) ==
++ Lisp back end compiler for ILAM with `name', formal `args', and `body'.
backendCompileILAM: (%Symbol,%List %Symbol, %Code) -> %Symbol
backendCompileILAM(name,args,body) ==
- args' := NLIST(#args, ["GENSYM"])
+ args' := [gensym() for . in 1..#args]
body' := eqSubst(args',args,body)
property(name,'ILAM) := true
setDynamicBinding(name,["LAMBDA",args',:body'])
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 17b3c60c..5f546ebe 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -272,7 +272,7 @@ getCategoryExtensionAlist cform ==
formalSubstitute(form:=[.,:argl],u) ==
isFormalArgumentList argl => u
- EQSUBSTLIST(argl,$FormalMapVariableList,u)
+ applySubst(pairList($FormalMapVariableList,argl),u)
isFormalArgumentList argl ==
and/[x=fa for x in argl for fa in $FormalMapVariableList]
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index afe8a03d..6df3e914 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -201,7 +201,8 @@ comp3(x,m,$e) ==
compTypeOf(x:=[op,:argl],m,e) ==
$insideCompTypeOf: local := true
- newModemap:= EQSUBSTLIST(argl,$FormalMapVariableList,get(op,'modemap,e))
+ newModemap :=
+ applySubst(pairList(argl,$FormalMapVariableList),get(op,'modemap,e))
e:= put(op,'modemap,newModemap,e)
comp3(x,m,e)
@@ -1549,7 +1550,7 @@ compColon([":",f,t],m,e) ==
e:=
f is [op,:argl] =>
--for MPOLY--replace parameters by formal arguments: RDJ 3/83
- newTarget:= EQSUBSTLIST(take(#argl,$FormalMapVariableList),
+ newTarget := EQSUBSTLIST(take(#argl,$FormalMapVariableList),
[(x is [":",a,m] => a; x) for x in argl],t)
signature:=
["Mapping",newTarget,:
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 961e3d3b..02c8a269 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -241,7 +241,7 @@ NRTmakeCategoryAlist() ==
sixEtc := [5 + i for i in 1..#$pairlis]
formals := ASSOCRIGHT $pairlis
for x in slot1 repeat
- x.first := EQSUBSTLIST(["$$",:sixEtc],['$,:formals],first x)
+ x.first := applySubst(pairList(['$,:formals],["$$",:sixEtc]),first x)
-----------code to make a new style slot4 -----------------
predList := ASSOCRIGHT slot1 --is list of predicate indices
maxPredList := "MAX"/predList
@@ -293,7 +293,7 @@ getExportCategory form ==
op is 'Union => ['UnionCategory,:argl]
functorModemap := getConstructorModemapFromDB op
[[.,target,:tl],:.] := functorModemap
- EQSUBSTLIST(argl,$FormalMapVariableList,target)
+ applySubst(pairList($FormalMapVariableList,argl),target)
NRTextendsCategory1(domform,exCategory,addForm) ==
addForm is ["%Comma",:r] =>
@@ -696,8 +696,10 @@ makeCategoryPredicates(form,u) ==
fn(u,nil) where
fn(u,pl) ==
u is ['Join,:.,a] => fn(a,pl)
- u is ["IF",p,:x] => fnl(x,insert(EQSUBSTLIST($mvl,$tvl,p),pl))
- u is ["has",:.] => insert(EQSUBSTLIST($mvl,$tvl,u),pl)
+ u is ["IF",p,:x] =>
+ fnl(x,insert(applySubst(pairList($tvl,$mvl),p),pl))
+ u is ["has",:.] =>
+ insert(applySubst(pairList($tvl,$mvl),u),pl)
u is [op,:.] and op in '(SIGNATURE ATTRIBUTE) => pl
atom u => pl
fnl(u,pl)
@@ -1354,7 +1356,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]
- EQSUBSTLIST(form.args,take(# form.args,$FormalMapVariableList),signature)
+ applySubst(pairList($FormalMapVariableList,form.args),signature)
candidateSignatures(op,nmodes,slot1) ==
[sig for [[=op,sig,:.],:.] in slot1 | #sig = nmodes]
diff --git a/src/interp/format.boot b/src/interp/format.boot
index f092afc7..52beb3eb 100644
--- a/src/interp/format.boot
+++ b/src/interp/format.boot
@@ -74,10 +74,10 @@ displayTranModemap (mm is [[x,:sig],[pred,:y],:z]) ==
[b,:c]:=sig
sig:=[['Union,b,'"failed"],:c]
mm:=[[x,:sig],y,:z]
- mm' := EQSUBSTLIST('(m n p q r s t i j k l),
- MSORT listOfPredOfTypePatternIds pred,mm)
- EQSUBSTLIST('(D D1 D2 D3 D4 D5 D6 D7 D8 D9 D10 D11 D12 D13 D14),
- MSORT listOfPatternIds [sig,[pred,:y]],mm')
+ mm' := applySubst(pairList(MSORT listOfPredOfTypePatternIds pred,
+ '(m n p q r s t i j k l)), mm)
+ applySubst(pairList(MSORT listOfPatternIds [sig,[pred,:y]],
+ '(D D1 D2 D3 D4 D5 D6 D7 D8 D9 D10 D11 D12 D13 D14)),mm')
listOfPredOfTypePatternIds p ==
p is ['AND,:lp] or p is ['OR,:lp] =>
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 8525abd1..a0361b0f 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -295,7 +295,7 @@ worthlessCode x ==
cons5(p,l) ==
l and (CAAR l = first p) => [p,: rest l]
# l < 5 => [p,:l]
- RPLACD(QCDDDDR l,nil)
+ QCDDDDR(l).rest := nil
[p,:l]
setVector0(catNames,definition) ==
diff --git a/src/interp/hashcode.boot b/src/interp/hashcode.boot
index 915fdae0..cfae0d52 100644
--- a/src/interp/hashcode.boot
+++ b/src/interp/hashcode.boot
@@ -82,7 +82,7 @@ hashType(type, percentHash) ==
else
hash := hashCombine(7, hash)
-- !!! If/when asharp hashes values using their type, use instead
--- ctt := EQSUBSTLIST(args, $FormalMapVariableList, ct)
+-- ctt := applySubst(pairList($FormalMapVariableList,args),ct)
-- hash := hashCombine(hashType(ctt, percentHash), hash)
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 07059fd7..712a3005 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -2295,7 +2295,7 @@ matSub(x) ==
matWidth(x) ==
y := CDDR x -- list of rows, each of form ((ROW . w) element element ...)
numOfColumns := # CDAR y
- widthList := matLSum2 matWList(y, NLIST(numOfColumns, 0))
+ widthList := matLSum2 matWList(y, [0 for . in 1..numOfColumns])
--returns ["max width of entries in column i" for i in 1..numberOfRows]
subspanList := matLSum matSubList y
superspanList := matLSum matSuperList y
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index 7707906b..6bd05c9c 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -2484,7 +2484,7 @@ reportOpsFromLisplib(op,u) ==
nArgs:= #argml
argList:= KDR getConstructorFormFromDB op
functorForm:= [op,:argList]
- argml:= EQSUBSTLIST(argList,$FormalMapVariableList,argml)
+ argml:= applySubst(pairList($FormalMapVariableList,argList),argml)
functorFormWithDecl:= [op,:[[":",a,m] for a in argList for m in argml]]
sayBrightly concat(bright form2StringWithWhere functorFormWithDecl,
'" is a",bright typ,'"constructor")
@@ -2524,7 +2524,8 @@ displayOperationsFromLisplib form ==
opList:= getConstructorOperationsFromDB name
null opList =>
centerAndHighlight('"No exported operations",$LINELENGTH)
- opl:=removeDuplicates MSORT EQSUBSTLIST(argl,$FormalMapVariableList,opList)
+ opl := removeDuplicates MSORT
+ applySubst(pairList($FormalMapVariableList,argl),opList)
ops:= nil
for x in opl repeat
ops := [:ops,:formatOperationAlistEntry(x)]
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 3a476ea6..be1ba09b 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -786,7 +786,7 @@ isDomainForm(D,e) ==
isDomainConstructorForm(D,e) ==
D is [op,:argl] and (u:= get(op,"value",e)) and
u is [.,["Mapping",target,:.],:.] and
- isCategoryForm(EQSUBSTLIST(argl,$FormalMapVariableList,target),e)
+ isCategoryForm(applySubst(pairList($FormalMapVariableList,argl),target),e)
isFunctor x ==
op:= opOf x
diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot
index 89fe9f48..ce3b64cc 100644
--- a/src/interp/modemap.boot
+++ b/src/interp/modemap.boot
@@ -340,7 +340,7 @@ substNames(domainName,viewName,functorForm,opalist) ==
[sel, viewName,if domainName = "$" then pos else
modemapform.mmTarget]]
for [:modemapform,[sel,"$",pos]] in
- EQSUBSTLIST(KDR functorForm,$FormalMapVariableList, opalist)]
+ applySubst(pairList($FormalMapVariableList,KDR functorForm),opalist)]
addConstructorModemaps(name,form is [functorName,:.],e) ==
$InteractiveMode: local:= nil
diff --git a/src/interp/rulesets.boot b/src/interp/rulesets.boot
index d877008d..f2051516 100644
--- a/src/interp/rulesets.boot
+++ b/src/interp/rulesets.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -149,7 +149,7 @@ createResolveTTRules() ==
mps := '(MP DMP NDMP)
mpRules := "append"/[substitute(mp,'mpoly1,$mpolyTTRules) for mp in mps]
$Res := ['(t1 t2 x y),
- :EQSUBSTLIST($nameList,$abList,append($generalTTRules,mpRules))]
+ :applySubst(pairList($abList,$nameList),append($generalTTRules,mpRules))]
true
--% resolveTM Rules
@@ -286,12 +286,12 @@ createResolveTMRules() ==
mpRules0 := "append"/[substitute(mp,'mpoly1,$mpolyTMRules) for mp in mps]
mpRules := "append"/[substitute(mp,'mpoly2,mpRules0) for mp in mps]
$ResMode := ['(t1 t2 x y),
- :EQSUBSTLIST($nameList,$abList,append(mpRules,$generalTMRules))]
+ :applySubst(pairList($abList,$nameList),append(mpRules,$generalTMRules))]
true
createTypeEquivRules() ==
-- used by eqType, for example
- $TypeEQ := ['(t1), :EQSUBSTLIST($nameList,$abList,'(
+ $TypeEQ := ['(t1), :applySubst(pairList($abList,$nameList),'(
((QF (P t1)) . (RF t1))
((QF (I)) . (RN))
((RE (RN)) . (RR)) ))]
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 0fe99878..c62a03d1 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -293,7 +293,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
endTest:=
['%when, [["EQL",sharpArg,gIndex],['RETURN,returnValue]]]
newValueCode:= ["%LET",g,substitute(gIndex,sharpArg,
- EQSUBSTLIST(gsList,rest $TriangleVariableList,body))]
+ applySubst(pairList(rest $TriangleVariableList,gsList),body))]
['%bind,decomposeBindings,
['%loop,["WHILE",true],["PROGN",endTest,advanceCode,
newValueCode,:rotateCode],voidValue()]]
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 511872c3..6a21d4b3 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -208,55 +208,16 @@
#+:common-lisp (:compile-toplevel :load-toplevel :execute)
#-:common-lisp (compile load eval)
(progn
-
- (DEFUN APPLYR (L X)
- (if (not L)
- X
- (LIST (CAR L) (APPLYR (CDR L) X))))
-
- (defun PARTCODET (N)
- (COND ((OR (NULL (INTEGERP N))
- (LT N 1))
- (ERROR 'PARTCODET))
- ((EQL N 1)
- '(CDR))
- ((EQL N 2)
- '(CDDR))
- ((EQL N 3)
- '(CDDDR))
- ((EQL N 4)
- '(CDDDDR))
- ((APPEND (PARTCODET (PLUS N -4)) '(CDDDDR)))))
-
(defun NLIST (N FN)
"Returns a list of N items, each initialized to the value of an
invocation of FN"
(if (LT N 1)
NIL
(CONS (EVAL FN) (NLIST (1- N) FN))))
-
- (defun TAILFN (X N)
- (if (LT N 1)
- X
- (TAILFN (CDR X) (1- N))))
))
-(defmacro TAIL (&rest L)
- (let ((x (car L))
- (n (if (cdr L)
- (cadr L)
- 1)))
- (COND ((EQL N 0)
- X)
- ((EQL N 1)
- (LIST 'CDR X))
- ((GT N 1)
- (APPLYR (PARTCODET N) X))
- ((LIST 'TAILFN X N)))))
-
-
;;
;; -*- Cons Cell Manipulators -*-
;;
@@ -312,24 +273,6 @@
((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B))
((ERROR 'RPLAC))))))
-(defmacro |rplac| (&rest L)
- (let (a b s)
- (cond
- ((EQCAR (SETQ A (CAR L)) 'ELT)
- (COND ((AND (INTEGERP (SETQ B (CADDR A))) (>= B 0))
- (SETQ S "CA")
- (do ((i 1 (1+ i))) ((> i b)) (SETQ S (STRCONC S "D")))
- (LIST 'RPLAC (LIST (INTERN (STRCONC S "R")) (CADR A)) (CADR L)))
- ((ERROR "rplac"))))
- ((PROGN
- (SETQ A (CARCDREXPAND (CAR L) NIL))
- (SETQ B (CADR L))
- (COND
- ((CDDR L) (ERROR 'RPLAC))
- ((EQCAR A 'CAR) (LIST 'RPLACA (CADR A) B))
- ((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B))
- ((ERROR 'RPLAC))))))))
-
;;
;; -*- Association Lists -*-
;;
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 20:28:49 +0000