diff options
Diffstat (limited to 'src/interp/nruncomp.boot')
-rw-r--r-- | src/interp/nruncomp.boot | 94 |
1 files changed, 83 insertions, 11 deletions
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index db4bd860..9dd8bff1 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -290,6 +290,38 @@ NRTassignCapsuleFunctionSlot(op,sig) == $NRTdeltaListComp := [nil,:$NRTdeltaListComp] $NRTdeltaLength := $NRTdeltaLength+1 + +++ NRTaddInner should call following function instead of NRTgetLocalIndex +++ This would prevent putting spurious items in $NRTdeltaList +NRTinnerGetLocalIndex x == + atom x => x + -- following test should skip Unions, Records, Mapping + op := first x + op in '(Union Record Mapping Enumeration _[_|_|_]) => NRTgetLocalIndex x + constructor? op => NRTgetLocalIndex x + NRTaddInner x + + +NRTaddInner x == +--called by genDeltaEntry and others that affect $NRTdeltaList + PROGN + atom x => nil + x is ['Record,:l] => + for [.,.,y] in l repeat NRTinnerGetLocalIndex y + first x in '(Union Mapping _[_|_|_]) => + for y in rest x repeat + y is [":",.,z] => NRTinnerGetLocalIndex z + NRTinnerGetLocalIndex y + x is ['SubDomain,y,:.] => NRTinnerGetLocalIndex y + getConstructorSignature first x is [.,:ml] => + for y in rest x for m in ml | not (y = '$) repeat + isCategoryForm(m,$CategoryFrame) => NRTinnerGetLocalIndex y + x is ["Enumeration",:.] => + for y in rest x repeat NRTinnerGetLocalIndex y + keyedSystemError("S2NR0003",[x]) + x + + NRTisExported? opSig == or/[u for u in $domainShell.1 | u.0 = opSig] @@ -333,6 +365,27 @@ consDomainForm(x,dc) == get(x,'value,$e) or get(x,'mode,$e) => x MKQ x + +++ Called by buildFunctor fill $template slots with names +++ of compiled functions +NRTdescendCodeTran(u,condList) == + null u => nil + u is ['LIST] => nil + u is [op,.,i,a] and MEMQ(op,'(setShellEntry SETELT QSETREFV)) => + null condList and a is ['CONS,fn,:.] => + RPLACA(u,'LIST) + RPLACD(u,nil) + $template.i := + fn = 'IDENTITY => a + fn is ['dispatchFunction,fn'] => fn' + fn + nil --code for this will be generated by the instantiator + u is ['COND,:c] => + for [pred,:y] in c|y repeat NRTdescendCodeTran(first y,[pred,:condList]) + u is ['PROGN,:c] => for x in c repeat NRTdescendCodeTran(x,condList) + nil + + buildFunctor($definition is [name,:args],sig,code,$locals,$e) == --PARAMETERS -- $definition: constructor form, e.g. (SquareMatrix 10 (RationalNumber)) @@ -488,9 +541,6 @@ NRTcheckVector domainShell == [[first v,:$SetFunctions.i],:alist] alist --- Obsolete once we have moved to JHD's world -NRTvectorCopy(cacheName,domName,deltaLength) == GETREFV ($NRTbase + deltaLength) - mkDomainCatName id == INTERN STRCONC(id,";CAT") NRTsetVector4(siglist,formlist,condlist) == @@ -579,11 +629,6 @@ NRTsetVector4a(sig,form,cond) == cond = true => $uncondList := [form,:APPEND(evalform.4.0,$uncondList)] $condList := [[cond,[form,:evalform.4.0]],:$condList] -NRTmakeSlot1 domainShell == - opDirectName := INTERN STRCONC(PNAME first $definition,'";opDirect") - fun := '(function lookupInCompactTable) - ["setShellEntry", '$,1, ['LIST,fun,'$,opDirectName]] - NRTmakeSlot1Info() == -- 4 cases: -- a:T == b add c --- slot1 directory has #s for entries defined in c @@ -657,11 +702,11 @@ changeDirectoryInSlot1() == --called by NRTbuildFunctor $lastPred := pred newfnsel := fnsel is ['Subsumed,op1,sig1] => - ['Subsumed,op1,genSlotSig(sig1,"T",$newEnv)] + ['Subsumed,op1,genSlotSig(sig1,$newEnv)] fnsel - [[op, genSlotSig(sig,pred,$newEnv)] ,pred,newfnsel] + [[op, genSlotSig(sig,$newEnv)] ,pred,newfnsel] -genSlotSig(sig,pred,$e) == +genSlotSig(sig,$e) == [NRTgetLocalIndex t for t in sig] deepChaseInferences(pred,$e) == @@ -693,6 +738,33 @@ NRTsubstDelta(initSig) == MEMQ(CAR t,'(Mapping Union Record _:)) => [CAR t,:[replaceSlotTypes(x) for x in rest t]] t + +mapConsDB x == + [addConsDB y for y in x] + +addConsDB x == + min x where + min x == + y:=HGET($consDB,x) + y => y + PAIRP x => + for z in tails x repeat + u:=min CAR z + if not EQ(u,CAR z) then RPLACA(z,u) + HashCheck x + REFVECP x => + for i in 0..MAXINDEX x repeat + x.i:=min (x.i) + HashCheck x + STRINGP x => HashCheck x + x + HashCheck x == + y:=HGET($consDB,x) + y => y + HPUT($consDB,x,x) + x + x + -----------------------------SLOT1 DATABASE------------------------------------ updateSlot1DataBase [name,info] == HPUT($Slot1DataBase,name,info) |