diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/define.boot | 20 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 22 |
2 files changed, 22 insertions, 20 deletions
diff --git a/src/interp/define.boot b/src/interp/define.boot index 10403767..0195e4e2 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -479,7 +479,7 @@ depthAssocList(u,cache) == depthAssoc(x,cache) == y := tableValue(cache,x) => y - x is ['Join,:u] or (u := ASSOCLEFT parentsOfForm x) => + x is ['Join,:u] or (u := substSource parentsOfForm x) => v := depthAssocList(u,cache) tableValue(cache,x) := [[x,:n],:v] where n() == 1 + "MAX"/[rest y for y in v] @@ -487,20 +487,20 @@ depthAssoc(x,cache) == NRTmakeCategoryAlist(db,e) == pcAlist := [:[[x,:true] for x in $uncondAlist],:$condAlist] - levelAlist := depthAssocList(ASSOCLEFT pcAlist,hashTable 'EQUAL) + levelAlist := depthAssocList(substSource pcAlist,hashTable 'EQUAL) opcAlist := sortBy(function(x +-> LASSOC(first x,levelAlist)),pcAlist) - newPairlis := [[5 + i,:b] for [.,:b] in dbFormalSubst db for i in 1..] + newPairlis := [[i,:b] for [.,:b] in dbFormalSubst db for i in 6..] slot1 := [[a,:k] for [a,:b] in dbSubstituteAllQuantified(db,opcAlist) | (k := predicateBitIndex(b,e)) ~= -1] - slot0 := [hasDefaultPackage a.op for [a,:b] in slot1] + slot0 := [hasDefaultPackage a.op for [a,:.] in slot1] sixEtc := [5 + i for i in 1..dbArity db] - formals := ASSOCRIGHT dbFormalSubst db + formals := substTarget dbFormalSubst db for x in slot1 repeat x.first := applySubst(pairList(['$,:formals],["$$",:sixEtc]),first x) -----------code to make a new style slot4 ----------------- - predList := ASSOCRIGHT slot1 --is list of predicate indices + predList := substTarget slot1 --is list of predicate indices maxPredList := "MAX"/predList - catformvec := ASSOCLEFT slot1 + catformvec := substSource slot1 maxElement := "MAX"/dbByteList db ['CONS, ['makeByteWordVec2,MAX(maxPredList,1),MKQ predList], ['CONS, MKQ vector slot0, @@ -625,7 +625,7 @@ catExtendsCat?(u,v,tbl,env) == PRINT similarForm sayBrightlyNT '" but not " PRINT v - or/[catExtendsCat?(x,v,tbl,env) for x in ASSOCLEFT categoryAncestors uvec] + or/[catExtendsCat?(x,v,tbl,env) for x in substSource categoryAncestors uvec] substSlotNumbers(form,template,domain) == form is ['SIGNATURE,op,sig,:q] => @@ -1098,7 +1098,7 @@ deduceImplicitParameters(db,e) == buildConstructorCondition db == dbImplicitData db is [subst,cond] => - ['%exist,ASSOCRIGHT subst,mkpf(applySubst(subst,cond),'AND)] + ['%exist,substTarget subst,mkpf(applySubst(subst,cond),'AND)] true getArgumentMode: (%Form,%Env) -> %Maybe %Mode @@ -1763,7 +1763,7 @@ compDefWhereClause(['DEF,form,signature,body],m,e) == -- 3. obtain a list of parameter identifiers (x1 .. xn) ordered so that -- the type of xi is independent of xj if i < j varList := - orderByDependency(ASSOCLEFT argDepAlist,ASSOCRIGHT argDepAlist) where + orderByDependency(substSource argDepAlist,substTarget argDepAlist) where argDepAlist := [[x,:dependencies] for [x,:y] in argSigAlist] where dependencies() == diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index bd6424fd..0271c9a4 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.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-2013, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -480,7 +480,7 @@ buildFunctor(db,sig,code,$locals,$e) == -- Do this now to create predicate vector; then DescendCode can refer -- to predicate vector if it can [$uncondAlist,:$condAlist] := --bound in compDefineFunctor1 - NRTsetVector4Part1(db,viewNames,catvecListMaker,condCats) + NRTsetVector4Part1(db,viewNames,catvecListMaker,condCats,$e) [$NRTslot1PredicateList,predBitVectorCode1,:predBitVectorCode2] := makePredicateBitVector(db,[:ASSOCRIGHT $condAlist,:$NRTslot1PredicateList],$e) @@ -527,13 +527,13 @@ buildFunctor(db,sig,code,$locals,$e) == SAY ['"time taken in buildFunctor: ",TEMPUS_-FUGIT()-oldtime] ans -NRTsetVector4Part1(db,siglist,formlist,condlist) == +NRTsetVector4Part1(db,siglist,formlist,condlist,e) == $uncondList: local := nil $condList: local := nil $count: local := 0 for sig in reverse siglist for form in reverse formlist for cond in reverse condlist repeat - NRTsetVector4a(db,sig,form,cond) + NRTsetVector4a(db,sig,form,cond,e) reducedUncondlist := removeDuplicates $uncondList reducedConlist := [[x,:y] for [x,z] in $condList| y := SETDIFFERENCE(z,reducedUncondlist)] @@ -551,15 +551,17 @@ reverseCondlist cl == u.rest := [x,:rest u] alist -NRTsetVector4a(db,sig,form,cond) == +NRTsetVector4a(db,sig,form,cond,e) == sig is '$ => domainList := - [optimize comp(d,$EmptyMode,$e).expr or d - for d in categoryPrincipals dbDomainShell db] - $uncondList := append(domainList,$uncondList) - if isCategoryForm(form,$e) then $uncondList := [form,:$uncondList] + [domForm for d in categoryPrincipals dbDomainShell db] where + domForm() == optimize + T := comp(d,$EmptyMode,e) => T.expr + d + $uncondList := append!(domainList,$uncondList) + if isCategoryForm(form,e) then $uncondList := [form,:$uncondList] $uncondList - evalform := evalCategoryForm(form,$e) + evalform := evalCategoryForm(form,e) cond is true => $uncondList := [form,:append(categoryPrincipals evalform,$uncondList)] $condList := [[cond,[form,:categoryPrincipals evalform]],:$condList] |