aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog6
-rw-r--r--src/interp/Makefile.in7
-rw-r--r--src/interp/br-data.boot3
-rw-r--r--src/interp/buildom.boot5
-rw-r--r--src/interp/category.boot2
-rw-r--r--src/interp/define.boot6
-rw-r--r--src/interp/functor.boot12
-rw-r--r--src/interp/nruncomp.boot19
-rw-r--r--src/interp/showimp.boot7
9 files changed, 40 insertions, 27 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 35d1e555..bec1627b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2015-12-29 Gabriel Dos Reis <gdr@axiomatics.org>
+
+ * interp/nruncomp.boot ($AddChainIndex): Define.
+ * interp/br-data.boot: Now import nruncomp.
+ * interp/buildom.boot: Likewise.
+
2015-12-27 Gabriel Dos Reis <gdr@axiomatics.org>
* interp/daase.lisp (DATABASE): Add new field 'optable'.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 0ec8f0e1..b0b9c507 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -253,7 +253,7 @@ br-op2.$(FASLEXT): br-op1.$(FASLEXT)
br-op1.$(FASLEXT): bc-util.$(FASLEXT)
br-con.$(FASLEXT): bc-util.$(FASLEXT)
br-prof.$(FASLEXT): bc-util.$(FASLEXT)
-br-data.$(FASLEXT): bc-util.$(FASLEXT)
+br-data.$(FASLEXT): bc-util.$(FASLEXT) nruncomp.$(FASLEXT)
br-util.$(FASLEXT): bc-util.$(FASLEXT)
bc-solve.$(FASLEXT): bc-matrix.$(FASLEXT) bc-misc.$(FASLEXT)
bc-matrix.$(FASLEXT): bc-util.$(FASLEXT)
@@ -354,7 +354,7 @@ monitor.$(FASLEXT): sys-macros.$(FASLEXT) sys-utility.$(FASLEXT)
sfsfun-l.$(FASLEXT): sys-macros.$(FASLEXT)
trace.$(FASLEXT): debug.$(FASLEXT)
termrw.$(FASLEXT): sys-macros.$(FASLEXT)
-showimp.$(FASLEXT): c-util.$(FASLEXT)
+showimp.$(FASLEXT): c-util.$(FASLEXT) nruncomp.$(FASLEXT)
sfsfun.$(FASLEXT): sys-macros.$(FASLEXT)
slam.$(FASLEXT): g-timer.$(FASLEXT)
clammed.$(FASLEXT): g-timer.$(FASLEXT)
@@ -372,7 +372,8 @@ msg.$(FASLEXT): sys-macros.$(FASLEXT) astr.$(FASLEXT)
util.$(FASLEXT): lexing.$(FASLEXT)
fname.$(FASLEXT): sys-macros.$(FASLEXT)
sys-macros.$(FASLEXT): diagnostics.$(FASLEXT) union.$(FASLEXT)
-buildom.$(FASLEXT): buildom.boot sys-macros.$(FASLEXT) c-util.$(FASLEXT)
+buildom.$(FASLEXT): buildom.boot sys-macros.$(FASLEXT) c-util.$(FASLEXT) \
+ nruncomp.$(FASLEXT)
diagnostics.$(FASLEXT): sys-globals.$(FASLEXT) vmlisp.$(FASLEXT)
sys-driver.$(FASLEXT): sys-driver.boot types.$(FASLEXT)
sys-globals.$(FASLEXT): sys-constants.$(FASLEXT) hash.$(FASLEXT)
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index 1951754f..039874d5 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -33,6 +33,7 @@
import bc_-util
+import nruncomp
namespace BOOT
lefts u ==
@@ -461,7 +462,7 @@ getImports conname == --called by mkUsersHashTable
infovec := dbInfovec conname or return nil
template := infovec.0
u := [doImport(i,template)
- for i in 5..(maxIndex template) | test] where
+ for i in $AddChainIndex..(maxIndex template) | test] where
test() == template.i is [op,:.] and ident? op
and not (op in '(Mapping Union Record Enumeration CONS QUOTE local %constant))
doImport(x,template) ==
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 2006b1c8..3201ee43 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2012, Gabriel Dos Reis.
+-- Copyright (C) 2007-2015, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -42,6 +42,7 @@
import sys_-macros
import c_-util
+import nruncomp
namespace BOOT
$noCategoryDomains == '(Mode SubDomain)
@@ -251,7 +252,7 @@ lookupInCategories(op,sig,dom,dollar) ==
eval applySubst(pairList(varList,valueList),catform),dollar)
for catform in catformList | catform ~= nil ] where
valueList() ==
- [MKQ dom,:[MKQ domainRef(dom,5+i) for i in 1..(#rest catform)]]
+ [MKQ dom,:[MKQ domainRef(dom,$AddChainIndex+i) for i in 1..(#rest catform)]]
r or lookupDisplay(op,sig,'"category defaults",'"-- not found")
--=======================================================
diff --git a/src/interp/category.boot b/src/interp/category.boot
index cdfc9958..c5d4fbfe 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -116,7 +116,7 @@ mkCategory(domainOrPackage,sigList,attList,domList,principal) ==
categoryAttributes(v) := attList
categoryRef(v,3) := $Category
if principal ~= nil then
- for x in 6..#principal-1 repeat
+ for x in $NRTbase..#principal-1 repeat
categoryRef(v,x) := categoryRef(principal,x)
categoryAssociatedTypes(v) :=
[categoryPrincipals principal,
diff --git a/src/interp/define.boot b/src/interp/define.boot
index b33f9f20..dbac6f62 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -489,11 +489,11 @@ makeCategoryAlist(db,e) ==
pcAlist := [:[[x,:true] for x in $uncondAlist],:$condAlist]
levelAlist := depthAssocList(substSource pcAlist,hashTable 'EQUAL)
opcAlist := sortBy(function(x +-> LASSOC(first x,levelAlist)),pcAlist)
- newPairlis := [[i,:b] for [.,:b] in dbFormalSubst db for i in 6..]
+ newPairlis := [[i,:b] for [.,:b] in dbFormalSubst db for i in $NRTbase..]
slot1 := [[a,:k] for [a,:b] in dbSubstituteAllQuantified(db,opcAlist)
| (k := predicateBitIndex(db,b,e)) ~= -1]
slot0 := [getCategoryConstructorDefault a.op for [a,:.] in slot1]
- sixEtc := [5 + i for i in 1..dbArity db]
+ sixEtc := [$AddChainIndex + i for i in 1..dbArity db]
formals := substTarget dbFormalSubst db
for x in slot1 repeat
x.first := applySubst(pairList(['$,:formals],["$$",:sixEtc]),first x)
@@ -602,7 +602,7 @@ extendsCategoryBasic(dom,u,v,tbl,env) ==
isCategoryForm(v,env) => catExtendsCat?(u,v,tbl,env)
v is ['SIGNATURE,op,sig,:.] =>
uVec := getCategoryObjectIfCan(tbl,u,env) or return false
- or/[categoryRef(uVec,i) is [[=op,=sig],:.] for i in 6..maxIndex uVec]
+ or/[categoryRef(uVec,i) is [[=op,=sig],:.] for i in $NRTbase..maxIndex uVec]
u is ['CATEGORY,.,:l] =>
v is ['IF,:.] => listMember?(v,l)
false
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 4a294084..c6185c94 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -53,7 +53,7 @@ CategoryPrint(D,$e) ==
SAY("This has an alternate view: slot ",rest u," corresponds to ",first u)
for u in third categoryRef(D,4) repeat
SAY("This has a local domain: slot ",rest u," corresponds to ",first u)
- for j in 6..maxIndex D repeat
+ for j in $NRTbase..maxIndex D repeat
u := categoryRef(D,j)
null u => SAY "another domain"
first u isnt [.,:.] => SAY("Alternate View corresponding to: ",u)
@@ -115,7 +115,7 @@ DomainPrint1(D,brief,$e) ==
vv.j := name
if i>1 then
uu.1 := uu.2 := uu.5 := '"As in first view"
- for i in 6..maxIndex uu repeat
+ for i in $NRTbase..maxIndex uu repeat
uu.i := DomainPrintSubst(uu.i,Sublis)
if vector? uu.i then
name := DPname()
@@ -382,7 +382,7 @@ DescendCodeAdd1(db,base,flag,target,formalArgs,formalArgModes) ==
n:=maxIndex cat
code:=
[u
- for i in 6..n | cons? cat.i and cons? (sig:= first cat.i)
+ for i in $NRTbase..n | cons? cat.i and cons? (sig:= first cat.i)
and
(u:=
SetFunctionSlots(applySubst(slist,sig),['ELT,instantiatedBase,i],flag,
@@ -399,7 +399,7 @@ DescendCodeAdd1(db,base,flag,target,formalArgs,formalArgModes) ==
true
code is ['%store,['%tref,name,number],u'] =>
update(u',copyvec,[[name,:number],:sofar])
- for i in 6..n repeat
+ for i in $NRTbase..n repeat
for u in copyvec.i repeat
[name,:count]:=u
j:=i+1
@@ -468,7 +468,7 @@ DescendCode(db,code,flag,viewAssoc,e) ==
u := member(name,$locals) =>
CONTAINED('$,body) and isDomainForm(body,e) =>
--instantiate domains which depend on $ after constants are set
- code:=['%store,['%tref,['%tref,'$,5],#$locals-#u],code]
+ code:=['%store,['%tref,['%tref,'$,$AddChainIndex],#$locals-#u],code]
$epilogue:=
TruthP flag => [code,:$epilogue]
[['%when,[ProcessCond(db,flag,e),code]],:$epilogue]
@@ -726,7 +726,7 @@ getViewsConditions(u,tbl) ==
DescendCodeVarAdd(db,base,flag) ==
[SetFunctionSlots(sig,implem,flag,'adding) repeat
- for i in 6..maxIndex dbDomainShell db |
+ for i in $NRTbase..maxIndex dbDomainShell db |
categoryRef(dbDomainShell db,i) is [sig:=[op,types],:.] and
LASSOC([base,:substitute(base,'$,types)],get(op,'modemap,$e)) is
[[pred,implem]]]
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 118fe6b4..459472d2 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -37,12 +37,15 @@ import profile
import functor
namespace BOOT
+++ The "add-chain" index for a functor instance.
+$AddChainIndex == 5
++ The base index for encoding items into a functor template
++ (e.g. domainShell). This is also the minimum length that a
++ template could possibly have.
-$NRTbase ==
- 6
+++ Note: This is the index right after $AddChainIndex.
+++ Note: It is equal to $FirstParamSlot.
+$NRTbase == $AddChainIndex + 1
++
$devaluateList := []
@@ -77,7 +80,7 @@ addDeltaCode db ==
for i in $NRTbase..
for [item,:compItem] in reverse dbUsedEntities db repeat
domainRef(dbTemplate db,i) := deltaTran(db,item,compItem)
- domainRef(dbTemplate db,5) :=
+ domainRef(dbTemplate db,$AddChainIndex) :=
$NRTaddForm =>
$NRTaddForm is ["%Comma",:y] => reverse! y
NRTencode(db,$NRTaddForm,$addForm)
@@ -238,7 +241,7 @@ assocIndex: (%Thing,%Form) -> %Maybe %Short
assocIndex(db,x) ==
x = nil => x
x is '$ => 0
- x = $NRTaddForm => 5
+ x = $NRTaddForm => $AddChainIndex
dbEntitySlot(db,['%domain,x])
getLocalIndex: (%Thing,%Form) -> %Short
@@ -391,9 +394,9 @@ stuffDomainSlots dollar ==
infovec := property(opOf domname,'infovec)
lookupFunction := symbolFunction getLookupFun infovec
template := infovec.0
- if vectorRef(template,5) then
- stuffSlot(dollar,5,vectorRef(template,5))
- for i in (6 + # rest domname)..maxIndex template
+ if vectorRef(template,$AddChainIndex) then
+ stuffSlot(dollar,$AddChainIndex,vectorRef(template,$AddChainIndex))
+ for i in ($NRTbase + # rest domname)..maxIndex template
| item := vectorRef(template,i) repeat
stuffSlot(dollar,i,item)
domainDirectory(dollar) := [lookupFunction,dollar,infovec.1]
@@ -489,7 +492,7 @@ buildFunctor(db,sig,code,$locals,$e) ==
for arg in args]
if symbolMember?($NRTaddForm,$locals) then
addargname := $FormalMapVariableList.(symbolPosition($NRTaddForm,$locals))
- argStuffCode := [['%store,['%tref,'$,5],addargname],:argStuffCode]
+ argStuffCode := [['%store,['%tref,'$,$AddChainIndex],addargname],:argStuffCode]
[['stuffDomainSlots,'$],:argStuffCode,
:predBitVectorCode2,storeOperationCode]
diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot
index 78977b06..5d863887 100644
--- a/src/interp/showimp.boot
+++ b/src/interp/showimp.boot
@@ -33,6 +33,7 @@
import c_-util
+import nruncomp
namespace BOOT
$returnNowhereFromGoGet := false
@@ -228,7 +229,7 @@ showAttributes dom ==
showGoGet dom ==
numvec := CDDR vectorRef(dom,4)
- for i in 6..maxIndex dom | (slot := vectorRef(dom,i)) is ['newGoGet,dol,index,:op] repeat
+ for i in $NRTbase..maxIndex dom | (slot := vectorRef(dom,i)) is ['newGoGet,dol,index,:op] repeat
numOfArgs := arrayRef(numvec,index)
whereNumber := arrayRef(numvec,index := index + 1)
signumList :=
@@ -277,7 +278,7 @@ dcSlots con ==
name := abbreviation? con or con
$infovec: local := getInfovec name
template := $infovec.0
- for i in 5..maxIndex template repeat
+ for i in $AddChainIndex..maxIndex template repeat
sayBrightlyNT bright i
item := template.i
item is [n,:op] and integer? n => dcOpLatchPrint(op,n)
@@ -469,7 +470,7 @@ dcSize(:options) ==
lazy := 0 --# of lazy domain slots
fun := 0 --# of function slots
lazyNodes := 0 --# of nodes needed for lazy domain slots
- for i in 5..maxindex repeat
+ for i in $AddChainIndex..maxindex repeat
(item := template.i) isnt [.,:.] => fun := fun + 1
integer? first item => latch := latch + 1
'T =>
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-01 06:49:21 +0000