aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/boot/ChangeLog5
-rw-r--r--src/boot/ast.boot.pamphlet2
-rw-r--r--src/interp/ChangeLog9
-rw-r--r--src/interp/Makefile.in8
-rw-r--r--src/interp/Makefile.pamphlet14
-rw-r--r--src/interp/define.boot2
-rw-r--r--src/interp/nruncomp.boot4
-rw-r--r--src/interp/nrunopt.boot.pamphlet45
-rw-r--r--src/interp/wi2.boot2
9 files changed, 49 insertions, 42 deletions
diff --git a/src/boot/ChangeLog b/src/boot/ChangeLog
index 54c0e0fc..8e2680ec 100644
--- a/src/boot/ChangeLog
+++ b/src/boot/ChangeLog
@@ -1,3 +1,8 @@
+2007-11-18 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * ast.boot.pamphlet (bfReduce): Compute left reduction, not right
+ reduction.
+
2007-11-17 Gabriel Dos Reis <gdr@cs.tamu.edu>
* ast.boot.pamphlet ($bfCamming): Define as global.
diff --git a/src/boot/ast.boot.pamphlet b/src/boot/ast.boot.pamphlet
index ab47df8a..b4f6e76d 100644
--- a/src/boot/ast.boot.pamphlet
+++ b/src/boot/ast.boot.pamphlet
@@ -320,7 +320,7 @@ bfReduce(op,y)==
init:=GET(op,"SHOETHETA")
g:=bfGenSymbol()
g1:=bfGenSymbol()
- body:=['SETQ,g,[op,g1,g]]
+ body:=['SETQ,g,[op,g,g1]]
if null init
then
g2:=bfGenSymbol()
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index 44304a2e..ccd695e3 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,3 +1,12 @@
+2007-11-18 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * Makefile.pamphlet (nrunopt.$(FASLEXT)): New rule.
+ (<<nrunopt.clisp>>): Remove.
+ * define.boot: Fix syntax.
+ * nruncomp.boot: Likewise.
+ * nrunopt.boot.pamphlet: Push into package "BOOT". Fix syntax.
+ * wi2.boot: Fix syntax.
+
2007-11-17 Gabriel Dos Reis <gdr@cs.tamu.edu>
* Makefile.pamphlet (clammed.$(FASLEXT)): New rule.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 6e13a54b..5cb194bd 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -508,6 +508,9 @@ compiler.$(FASLEXT): compiler.boot category.$(FASLEXT) c-util.$(FASLEXT) \
modemap.$(FASLEXT) pathname.$(FASLEXT)
$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
+nrunopt.$(FASLEXT): nrunopt.boot c-util.$(FASLEXT)
+ $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
+
nrunfast.$(FASLEXT): nrunfast.boot c-util.$(FASLEXT)
$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
@@ -746,11 +749,6 @@ boot-pkg.$(FASLEXT): boot-pkg.lisp
bookvol5.lisp: $(srcdir)/bookvol5.pamphlet
@ echo 298 making $@ from $<
$(axiom_build_document) --tangle=Interpreter --output=$@ $<
-
-nrunopt.clisp: nrunopt.boot
- @ echo 365 making $@ from $<
- @ echo '(old-boot::boot "nrunopt.boot")' | ${DEPSYS}
-
../algebra/warm.data: $(srcdir)/Makefile.pamphlet
@ echo 2 building warm.data
$(axiom_build_document) --tangle=warm.data --output=$@ $<
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index f3c38e4f..c8e69b2a 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -833,14 +833,6 @@ bookvol5.lisp: $(srcdir)/bookvol5.pamphlet
$(axiom_build_document) --tangle=Interpreter --output=$@ $<
@
-\subsection{nrunopt.boot}
-
-<<nrunopt.clisp>>=
-nrunopt.clisp: nrunopt.boot
- @ echo 365 making $@ from $<
- @ echo '(old-boot::boot "nrunopt.boot")' | ${DEPSYS}
-@
-
\subsection{postpar.boot}
\begin{verbatim}
@@ -1077,6 +1069,9 @@ compiler.$(FASLEXT): compiler.boot category.$(FASLEXT) c-util.$(FASLEXT) \
modemap.$(FASLEXT) pathname.$(FASLEXT)
$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
+nrunopt.$(FASLEXT): nrunopt.boot c-util.$(FASLEXT)
+ $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
+
nrunfast.$(FASLEXT): nrunfast.boot c-util.$(FASLEXT)
$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
@@ -1313,9 +1308,6 @@ boot-pkg.$(FASLEXT): boot-pkg.lisp
$(BOOTSYS) -- --compile --output=$@ $<
<<bookvol5.lisp>>
-
-<<nrunopt.clisp>>
-
<<warm.data.stanza>>
buildom.$(FASLEXT): buildom.boot sys-macros.$(FASLEXT)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 20238790..757d59c9 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -405,7 +405,7 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body],
[.,.,$e]:= compMakeDeclaration([":",'_$,target],m,$e)
--The following loop sees if we can economise on ADDed operations
--by using those of Rep, if that is the same. Example: DIRPROD
- if $insideCategoryPackageIfTrue^= true then
+ if not $insideCategoryPackageIfTrue then
if body is ['add,ab:=[fn,:.],['CAPSULE,:cb]] and MEMQ(fn,'(List Vector))
and FindRep(cb) = ab
where FindRep cb ==
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 7fdf8d2b..3db6237b 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -582,14 +582,14 @@ NRTmakeSlot1Info() ==
-- a == b add c --- not allowed (line 7 of getTargetFromRhs)
-- a == b --- $NRTderivedTargetIfTrue = true; set directory to NIL
pairlis :=
- $insideCategoryPackageIfTrue = true =>
+ $insideCategoryPackageIfTrue =>
[:argl,dollarName] := rest $form
[[dollarName,:'_$],:mkSlot1sublis argl]
mkSlot1sublis rest $form
$lisplibOpAlist := transformOperationAlist SUBLIS(pairlis,$domainShell.1)
opList :=
$NRTderivedTargetIfTrue => 'derived
- $insideCategoryPackageIfTrue = true => slot1Filter $lisplibOpAlist
+ $insideCategoryPackageIfTrue => slot1Filter $lisplibOpAlist
$lisplibOpAlist
addList := SUBLIS(pairlis,$NRTaddForm)
[first $form,[addList,:opList]]
diff --git a/src/interp/nrunopt.boot.pamphlet b/src/interp/nrunopt.boot.pamphlet
index 803828da..5f4fb366 100644
--- a/src/interp/nrunopt.boot.pamphlet
+++ b/src/interp/nrunopt.boot.pamphlet
@@ -50,6 +50,9 @@
<<*>>=
<<license>>
+import '"c-util"
+)package "BOOT"
+
--=======================================================================
-- Generate Code to Create Infovec
--=======================================================================
@@ -145,8 +148,8 @@ orderBySubsumption items ==
for [a,b,:.] in subacc | b repeat
--NOTE: b = nil means that the signature a will appear in acc, that this
-- entry is be ignored (e.g. init: -> $ in ULS)
- while (u := ASSOC(b,subacc)) repeat b := CADR u
- u := ASSOC(b,acc) or systemError nil
+ while (u := assoc(b,subacc)) repeat b := CADR u
+ u := assoc(b,acc) or systemError nil
if null CADR u then u := [CAR u,1] --mark as missing operation
y := [[a,'Subsumed],u,:y] --makes subsuming signature follow one subsumed
z := insert(b,z) --mark a signature as already present
@@ -154,10 +157,10 @@ orderBySubsumption items ==
makeCompactSigCode(sig,$isOpPackageName) == [fn for x in sig] where
--$isOpPackageName = true only for an exported operation of a default package
- fn ==
+ fn() ==
x = '_$_$ => 2
x = '$ => 0
- NULL INTEGERP x => systemError ['"code vector slot is ",x,"; must be number"]
+ not INTEGERP x => systemError ['"code vector slot is ",x,"; must be number"]
-- x = 6 and $isOpPackageName => 0 --treat slot 6 as $ for default packages
x
@@ -183,9 +186,9 @@ stuffDomainSlots dollar ==
bitVector := dollar.3
predvec := CAR proto4
packagevec := CADR proto4
- auxvec := LIST2VEC [fn for i in 0..MAXINDEX predvec] where fn ==
+ auxvec := LIST2VEC [fn for i in 0..MAXINDEX predvec] where fn() ==
null testBitVector(bitVector,predvec.i) => nil
- packagevec.i or 'T
+ packagevec.i or true
[auxvec,:CDDR proto4]
getLookupFun infovec ==
@@ -210,7 +213,7 @@ stuffSlot(dollar,i,item) ==
NRTgenInitialAttributeAlist attributeList ==
--alist has form ((item pred)...) where some items are constructor forms
alist := [x for x in attributeList | -- throw out constructors
- null MEMQ(opOf first x,allConstructors())]
+ not MEMQ(opOf first x,allConstructors())]
$lisplibAttributes := simplifyAttributeAlist
[[a,:b] for [a,b] in SUBLIS($pairlis,alist) | a ^= 'nothing]
@@ -228,13 +231,13 @@ NRTgenFinalAttributeAlist() ==
[[a,:k] for [a,:b] in $NRTattributeAlist | (k := predicateBitIndex(b)) ^= -1]
predicateBitIndex x ==
- pn(x,nil) where
+ pn(x,false) where
pn(x,flag) ==
u := simpBool transHasCode x
u = 'T => 0
u = nil => -1
p := POSN1(u,$NRTslot1PredicateList) => p + 1
- null flag => pn(predicateBitIndexRemop x,true)
+ not flag => pn(predicateBitIndexRemop x,true)
systemError nil
predicateBitIndexRemop p==
@@ -256,7 +259,7 @@ makePrefixForm(u,op) ==
-- Generate Slot 3 Predicate Vector
--=======================================================================
makePredicateBitVector pl == --called by NRTbuildFunctor
- if $insideCategoryPackageIfTrue = true then
+ if $insideCategoryPackageIfTrue then
pl := union(pl,$categoryPredicateList)
$predGensymAlist := nil --bound by NRTbuildFunctor, used by optHas
for p in removeAttributePredicates pl repeat
@@ -329,10 +332,10 @@ orderByContainment pl ==
max := first pl
for x in rest pl repeat
if (y := CONTAINED(max,x)) then
- if null ASSOC(max,$predGensymAlist)
+ if null assoc(max,$predGensymAlist)
then $predGensymAlist := [[max,:GENSYM()],:$predGensymAlist]
else if CONTAINED(x,max)
- then if null ASSOC(x,$predGensymAlist) then $predGensymAlist := [[x,:GENSYM()],:$predGensymAlist]
+ then if null assoc(x,$predGensymAlist) then $predGensymAlist := [[x,:GENSYM()],:$predGensymAlist]
if y then max := x
[max,:orderByContainment delete(max,pl)]
@@ -349,7 +352,7 @@ buildPredVector(init,n,l) == fn(init,2 ** n,l) where fn(acc,n,l) ==
testBitVector(vec,i) ==
--bit vector indices are always 1 larger than position in vector
- EQ(i,0) => true
+ i = 0 => true
LOGBITP(i - 1,vec)
bitsOf n ==
@@ -412,7 +415,7 @@ depthAssoc x ==
x is ['Join,:u] or (u := getCatAncestors x) =>
v := depthAssocList u
HPUT($depthAssocCache,x,[[x,:n],:v])
- where n == 1 + "MAX"/[rest y for y in v]
+ where n() == 1 + "MAX"/[rest y for y in v]
HPUT($depthAssocCache,x,[[x,:0]])
getCatAncestors x == [CAAR y for y in parentsOf opOf x]
@@ -447,13 +450,13 @@ listOfCategoryEntries l ==
listOfCategoryEntriesIf(pred,conseq,alternate) ==
alternate in '(noBranch NIL) =>
conseq is ['IF,p,c,a] => listOfCategoryEntriesIf(makePrefixForm([pred,p],'AND),c,a)
- [fn for x in listOfEntries conseq] where fn ==
+ [fn for x in listOfEntries conseq] where fn() ==
x is ['IF,a,b] => ['IF,makePrefixForm([pred,a],'AND),b]
['IF,pred,x]
notPred := makePrefixForm(pred,'NOT)
conseq is ['IF,p,c,a] =>
listOfCategoryEntriesIf(makePrefixForm([notPred,p],'AND),c,a)
- [gn for x in listOfEntries conseq] where gn ==
+ [gn for x in listOfEntries conseq] where gn() ==
x is ['IF,a,b] => ['IF,makePrefixForm([notPred,a],'AND),b]
['IF,notPred,x]
@@ -853,7 +856,7 @@ extendsCategory(dom,u,v) ==
extendsCategoryBasic0(dom,u,v) ==
v is ['IF,p,['ATTRIBUTE,c],.] =>
- uVec := compMakeCategoryObject(u,$EmptyEnvironment).expr
+ uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr
null atom c and isCategoryForm(c,nil) =>
slot4 := uVec.4
LASSOC(c,CADR slot4) is [=p,:.]
@@ -864,7 +867,7 @@ extendsCategoryBasic0(dom,u,v) ==
extendsCategoryBasic(dom,u,v) ==
u is ["Join",:l] => or/[extendsCategoryBasic(dom,x,v) for x in l]
u = v => true
- uVec := compMakeCategoryObject(u,$EmptyEnvironment).expr
+ uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr
isCategoryForm(v,nil) => catExtendsCat?(u,v,uVec)
v is ['SIGNATURE,op,sig] =>
or/[uVec.i is [[=op,=sig],:.] for i in 6..MAXINDEX uVec]
@@ -875,12 +878,12 @@ extendsCategoryBasic(dom,u,v) ==
catExtendsCat?(u,v,uvec) ==
u = v => true
- uvec := uvec or compMakeCategoryObject(u,$EmptyEnvironment).expr
+ uvec := uvec or (compMakeCategoryObject(u,$EmptyEnvironment)).expr
slot4 := uvec.4
prinAncestorList := CAR slot4
member(v,prinAncestorList) => true
vOp := KAR v
- if similarForm := ASSOC(vOp,prinAncestorList) then
+ if similarForm := assoc(vOp,prinAncestorList) then
PRINT u
sayBrightlyNT '" extends "
PRINT similarForm
@@ -920,7 +923,7 @@ templateVal(template,domform,index) ==
--returns a domform or a lazy slot
index = 0 => harhar() --template
template.index
-
+
@
\eject
\begin{thebibliography}{99}
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
index b0142f43..418ddf66 100644
--- a/src/interp/wi2.boot
+++ b/src/interp/wi2.boot
@@ -138,7 +138,7 @@ compDefineFunctor1(df, m,$e,$prefix,$formalArgList) ==
[.,.,$e]:= compMakeDeclaration([":",'_$,target],m,$e)
--The following loop sees if we can economise on ADDed operations
--by using those of Rep, if that is the same. Example: DIRPROD
- if $insideCategoryPackageIfTrue^= true then
+ if not $insideCategoryPackageIfTrue then
if body is ['add,ab:=[fn,:.],['CAPSULE,:cb]] and MEMQ(fn,'(List Vector))
and FindRep(cb) = ab
where FindRep cb ==
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-03 22:16:40 +0000