diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/clam.boot | 1 | ||||
| -rw-r--r-- | src/interp/define.boot | 16 | ||||
| -rw-r--r-- | src/interp/functor.boot | 27 | ||||
| -rw-r--r-- | src/interp/modemap.boot | 2 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 17 |
5 files changed, 27 insertions, 36 deletions
diff --git a/src/interp/clam.boot b/src/interp/clam.boot index d0eefed6..cdfb6e73 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -545,7 +545,6 @@ recordInstantiation(op,prop,dropIfTrue) == stopTimingProcess 'debug recordInstantiation1(op,prop,dropIfTrue) == - op in '(CategoryDefaults RepeatedSquaring) => nil--ignore defaults for now if $reportEachInstantiation then trailer:= (dropIfTrue => '" dropped"; '" instantiated") if $insideCoerceInteractive= true then diff --git a/src/interp/define.boot b/src/interp/define.boot index d78c5770..39c2abc1 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1706,23 +1706,19 @@ compSubDomain1(domainForm,predicate,m,e) == compCapsuleInner(itemList,m,e) == e:= addInformation(m,e) --puts a new 'special' property of $Information - data:= ["PROGN",:itemList] + data := ["PROGN",:itemList] --RPLACd by compCapsuleItems and Friends - e:= compCapsuleItems(itemList,nil,e) + e := compCapsuleItems(itemList,nil,e) localParList:= $functorLocalParameters - if $addForm then data:= ['add,$addForm,data] - code:= + if $addForm ~= nil then + data := ['add,$addForm,data] + code := $insideCategoryIfTrue and not $insideCategoryPackageIfTrue => data - processFunctor($form,$signature,data,localParList,e) + buildFunctor($form,$signature,data,localParList,e) [MKPF([:$getDomainCode,code],"PROGN"),m,e] --% PROCESS FUNCTOR CODE -processFunctor(form,signature,data,localParList,e) == - form is ["CategoryDefaults"] => - error "CategoryDefaults is a reserved name" - buildFunctor(form,signature,data,localParList,e) - compCapsuleItems(itemlist,$predl,$e) == $signatureOfForm: local := nil $suffix: local:= 0 diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 70085b74..e3782d26 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -433,22 +433,22 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) == code:=[v,:code] [["%LET",instantiatedBase,base],:code] -DescendCode(code,flag,viewAssoc,EnvToPass) == +DescendCode(code,flag,viewAssoc) == -- flag = true if we are walking down code always executed; -- otherwise set to conditions in which - code=nil => nil - code='%noBranch => nil + code = nil => nil + code is '%noBranch => nil isMacro(code,$e) => nil --RDJ: added 3/16/83 code is ['add,base,:codelist] => codelist:= - [v for u in codelist | (v:= DescendCode(u,flag,viewAssoc,EnvToPass))~=nil] + [v for u in codelist | (v:= DescendCode(u,flag,viewAssoc))~=nil] -- must do this first, to get this overriding Add code ['PROGN,:DescendCodeAdd(base,flag),:codelist] code is ['PROGN,:codelist] => ['PROGN,: --Two REVERSEs leave original order, but ensure last guy wins reverse! [v for u in reverse codelist | - (v:= DescendCode(u,flag,viewAssoc,EnvToPass))~=nil]] + (v:= DescendCode(u,flag,viewAssoc))~=nil]] code is ['%when,:condlist] => c:= [[u2:= ProcessCond first u,:q] for u in condlist] where q() == null u2 => nil @@ -462,17 +462,17 @@ DescendCode(code,flag,viewAssoc,EnvToPass) == [DescendCode(v, f, if first u is ['HasCategory,dom,cat] then [[dom,:cat],:viewAssoc] - else viewAssoc,EnvToPass) for v in rest u] + else viewAssoc) for v in rest u] TruthP CAAR c => ['PROGN,:CDAR c] while (c and (last c is [c1] or last c is [c1,[]]) and (c1 = '%true or c1 is ['HasAttribute,:.])) repeat --strip out some worthless junk at the end c:=reverse! rest reverse! c - null c => '(LIST) + c = nil => ['%list] ['%when,:c] code is ["%LET",name,body,:.] => --only keep the names that are useful - u:=member(name,$locals) => + 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] @@ -484,10 +484,9 @@ DescendCode(code,flag,viewAssoc,EnvToPass) == code -- doItIf deletes entries from $locals so can't optimize this code is ['CodeDefine,sig,implem] => --Generated by doIt in COMPILER BOOT - dom:= EnvToPass - dom:= - u:= LASSOC(dom,viewAssoc) => ['getDomainView,dom,u] - dom + dom := + u := LASSOC('$,viewAssoc) => ['getDomainView,'$,u] + '$ body:= ['CONS,implem,dom] u := SetFunctionSlots(sig,body,flag,'original) -- ??? We do not resolve default definitions, yet. @@ -536,8 +535,8 @@ SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding" null body => return nil u := first $catvecList for catImplem in LookUpSigSlots(sig,categoryExports u) repeat - catImplem is [q,.,index] and (q='ELT or q='CONST) => - if q is 'CONST and body is ['CONS,a,b] then + catImplem is [q,.,index] and q in '(ELT CONST) => + if q = 'CONST and body is ['CONS,a,b] then body := ['CONS,'IDENTITY,['FUNCALL,a,b]] body:= ['%store,['%tref,'$,index],body] not vector? $SetFunctions => nil --packages don't set it diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index 0f393f5c..c066b16e 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -122,8 +122,6 @@ addModemapKnown(op,mc,sig,pred,fn,$e) == addModemap0(op,mc,sig,pred,fn,e) == --mc is the "mode of computation"; fn the "implementation" - $functorForm is ['CategoryDefaults,:.] and mc="$" => e - --don't put CD modemaps into environment --fn is ['Subsumed,:.] => e -- don't skip subsumed modemaps -- breaks -:($,$)->U($,failed) in DP op='elt or op='setelt => addEltModemap(op,mc,sig,pred,fn,e) diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index ff071ab4..fcd0ea1f 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -473,7 +473,6 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) == $GENNO: local:= 0 --bound in compDefineFunctor1, then as parameter here $catvecList: local := nil --list of vectors v1..vn for each view $hasCategoryAlist: local := nil --list of GENSYMs bound to (HasCategory ..) items - $catNames: local := nil --list of names n1..nn for each view $catsig: local := nil --target category (used in ProcessCond) $SetFunctions: local := nil --copy of p view with preds telling when fnct defined $ConstantAssignments: local := nil --code for creation of constants @@ -501,21 +500,21 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) == for i in 0..4 repeat vectorRef(domainShell,i) := vectorRef($domainShell,i) --we will clobber elements; copy since $domainShell may be a cached vector - $template := newShell ($NRTbase + $NRTdeltaLength) - $catvecList:= [domainShell,:[emptyVector for u in second domainShell.4]] - $catNames := ['$] -- for DescendCode -- to be changed below for slot 4 - $SetFunctions:= newShell # domainShell - $catNames:= ['$,:[genvar() for u in rest catvecListMaker]] - domname:='dv_$ + $template := newShell($NRTbase + $NRTdeltaLength) + $SetFunctions := newShell # domainShell + $catvecList := [domainShell,:[emptyVector for u in second domainShell.4]] + -- list of names n1..nn for each view + viewNames := ['$,:[genvar() for u in rest catvecListMaker]] + domname := 'dv_$ -- Do this now to create predicate vector; then DescendCode can refer -- to predicate vector if it can [$uncondAlist,:$condAlist] := --bound in compDefineFunctor1 - NRTsetVector4Part1($catNames,catvecListMaker,condCats) + NRTsetVector4Part1(viewNames,catvecListMaker,condCats) [$NRTslot1PredicateList,predBitVectorCode1,:predBitVectorCode2] := makePredicateBitVector [:ASSOCRIGHT $condAlist,:$NRTslot1PredicateList] - storeOperationCode:= DescendCode(code,true,nil,first $catNames) + storeOperationCode := DescendCode(code,true,nil) NRTaddDeltaCode() storeOperationCode:= NRTputInLocalReferences storeOperationCode NRTdescendCodeTran(storeOperationCode,nil) --side effects storeOperationCode |