diff options
| -rw-r--r-- | src/ChangeLog | 6 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 19 | ||||
| -rw-r--r-- | src/interp/database.boot | 2 | ||||
| -rw-r--r-- | src/interp/define.boot | 24 | ||||
| -rw-r--r-- | src/interp/functor.boot | 6 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 11 | ||||
| -rw-r--r-- | src/interp/sys-globals.boot | 3 |
7 files changed, 40 insertions, 31 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 67a73452..0f7983ef 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2013-05-28 Gabriel Dos Reis <gdr@integrable-solutions.net> + + * interp/sys-globals.boot ($domainShell): Remove. + * interp/c-util.boot (%CompilationData): Add shell field. + (dbDomainShell): New accessor. Replace $domainShell variable. + 2013-05-27 Gabriel Dos Reis <gdr@integrable-solutions.net> * interp/compiler.boot(compNoStacking): Add DB parameter. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index bc0c6726..9ac95081 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -145,15 +145,17 @@ macro domainData d == structure %CompilationData == Record(subst: %Substitution,idata: %Substitution,bytes: List %Fixnum, - items: %Buffer %Pair(%SourceEntity,%Elaboration)) with - cdSubstitution == (.subst) - cdImplicits == (.idata) - cdBytes == (.bytes) - cdItems == (.items) + shell: %Vector %Thing, + items: %Buffer %Pair(%SourceEntity,%Elaboration)) with + cdSubstitution == (.subst) + cdImplicits == (.idata) + cdBytes == (.bytes) + cdShell == (.shell) + cdItems == (.items) ++ Make a fresh compilation data structure. makeCompilationData() == - mk%CompilationData(nil,nil,nil,[nil,:0]) + mk%CompilationData(nil,nil,nil,nil,[nil,:0]) ++ Subsitution that replaces parameters with formals. macro dbFormalSubst db == @@ -174,6 +176,11 @@ macro dbImplicitData db == macro dbByteList db == cdBytes dbCompilerData db +++ Return the domain shell of the category object (or the category object +++ of the domain) being elaborated. +macro dbDomainShell db == + cdShell dbCompilerData db + ++ Return a buffer of entities referenced during elaboration ++ of current functor. macro dbEntityBuffer db == diff --git a/src/interp/database.boot b/src/interp/database.boot index d96fba4a..f4786648 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -212,7 +212,7 @@ modemapsFromCategory(db,form,body,signature) == form := applySubst(sl,form) body := applySubst(sl,body) signature := applySubst(sl,signature) - opAlist := applySubst(sl,categoryExports $domainShell) or return nil + opAlist := applySubst(sl,categoryExports dbDomainShell db) or return nil nonCategorySigAlist := mkAlistOfExplicitCategoryOps substitute("*1","$",body) catPredList := [['ofCategory,"*1",form], diff --git a/src/interp/define.boot b/src/interp/define.boot index 443f93cb..bb4f541a 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1179,7 +1179,7 @@ compDefineCategory2(form,signature,body,m,e,$formalArgList) == parForm := applySubst(pairlis,form) -- 6. put modemaps into InteractiveModemapFrame - $domainShell := eval [op',:[MKQ f for f in sargl]] + dbDomainShell(db) := eval [op',:[MKQ f for f in sargl]] dbConstructorModemap(db) := [[parForm,:parSignature],[buildConstructorCondition db,$op]] dbPrincipals(db) := getParentsFor db @@ -1194,7 +1194,6 @@ mkConstructor form == ['%list,MKQ form.op,:[mkConstructor x for x in form.args]] compDefineCategory(df,m,e,fal) == - $domainShell: local := nil -- holds the category of the object being compiled -- since we have so many ways to say state the kind of a constructor, -- make sure we do have some minimal internal coherence. lhs := second df @@ -1342,8 +1341,8 @@ getOperationAlist(db,name,functorForm,form) == (u:= get(functorForm,'isFunctor,$CategoryFrame)) and not ($insideFunctorIfTrue and first functorForm=first $functorForm) => u $insideFunctorIfTrue and name is "$" => - $domainShell => categoryExports $domainShell - systemError '"$ has no shell now" + dbDomainShell db = nil => systemError '"$ has no shell now" + categoryExports dbDomainShell db T:= compMakeCategoryObject(form,$e) => ([.,.,$e]:= T; categoryExports T.expr) stackMessage('"not a category form: %1bp",[form]) @@ -1444,7 +1443,6 @@ getDollarName env == get('%compilerData,'%dollar,env) compDefineFunctor(df,m,e,fal) == - $domainShell: local := nil -- holds the category of the object being compiled $profileCompiler: local := true $profileAlist: local := nil compDefineLisplib(df,m,e,fal,'compDefineFunctor1) @@ -1493,7 +1491,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body],m,$e,$formalArgList) == $e := giveFormalParametersValues(form.args,$e) [ds,.,$e] := compMakeCategoryObject(target,$e) or return stackAndThrow('" cannot produce category object: %1pb",[target]) - $domainShell: local := copyVector ds + dbDomainShell(db) := copyVector ds attributeList := categoryAttributes ds --see below under "loadTimeAlist" $condAlist: local := nil $uncondAlist: local := nil @@ -1568,7 +1566,7 @@ incompleteFunctorBody(db,m,body,e) == -- Nullify them so people don't think they bear any meaningful -- semantics (well, they should not think these are forwarding either). ops := nil - for [opsig,pred,funsel] in categoryExports $domainShell repeat + for [opsig,pred,funsel] in categoryExports dbDomainShell db repeat if pred isnt true then pred := simpBool pred if funsel is [op,.,.] and op in '(ELT CONST) then @@ -1778,7 +1776,7 @@ orderByDependency(vl,dl) == ++ Subroutine of compDefineCapsuleFunction. assignCapsuleFunctionSlot(db,op,sig) == - kind := or/[u.mapKind for u in categoryExports $domainShell + kind := or/[u.mapKind for u in categoryExports dbDomainShell db | symbolEq?(op,u.mapOperation) and sig = u.mapSignature] kind = nil => nil -- op is local and need not be assigned if $insideCategoryPackageIfTrue then @@ -1804,8 +1802,8 @@ compareMode2Arg(x,m) == null x or modeEqual(x,m) ++ Determine whether the function with possibly partial signature `target' ++ is exported. Return the complete signature if yes; otherwise ++ return nil, with diagnostic in ambiguity case. -hasSigInTargetCategory(form,target,e) == - sigs := candidateSignatures(form.op,#form,categoryExports $domainShell) +hasSigInTargetCategory(db,form,target,e) == + sigs := candidateSignatures(form.op,#form,categoryExports dbDomainShell db) cc := checkCallingConvention(sigs,#form.args) mList:= [(cc.i > 0 => quasiquote x; getArgumentMode(x,e)) for x in form.args for i in 0..] @@ -1872,10 +1870,10 @@ partialSignature? sig == ++ We are about to elaborate a definition with `form' as head, and ++ parameter types specified in `signature'. Refine that signature ++ in case some or all of the parameter types are missing. -refineDefinitionSignature(form,signature,e) == +refineDefinitionSignature(db,form,signature,e) == --let target and local signatures help determine modes of arguments signature' := - x := hasSigInTargetCategory(form,signature.target,e) => x + x := hasSigInTargetCategory(db,form,signature.target,e) => x x := getSignatureFromMode(form,e) => x [signature.target,:[getArgumentMode(a,e) for a in form.args]] signature'.source := stripOffSubdomainConditions(signature'.source,form.args) @@ -1956,7 +1954,7 @@ compDefineCapsuleFunction(db,df is ['DEF,form,signature,body], $form := [$op,:argl] argl:= stripOffArgumentConditions argl $formalArgList:= [:argl,:$formalArgList] - signature := refineDefinitionSignature(form,signature,e) or return nil + signature := refineDefinitionSignature(db,form,signature,e) or return nil $signatureOfForm := signature --this global is bound in compCapsuleItems e := processDefinitionParameters(db,form,signature,e) rettype := resolve(signature.target,$returnMode) diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 2955caa6..19711b83 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -581,7 +581,7 @@ InvestigateConditions(db,catvecListMaker,env) == null $Conditions => [true,:[true for u in secondaries]] PrincipalSecondaries:= getViewsConditions principal' MinimalPrimary:= first first PrincipalSecondaries - MaximalPrimary := first categoryPrincipals $domainShell + MaximalPrimary := first categoryPrincipals dbDomainShell db necessarySecondaries:= [first u for u in PrincipalSecondaries | rest u=true] and/[listMember?(u,necessarySecondaries) for u in secondaries] => [true,:[true for u in secondaries]] @@ -736,8 +736,8 @@ getViewsConditions u == DescendCodeVarAdd(db,base,flag) == [SetFunctionSlots(sig,implem,flag,'adding) repeat - for i in 6..maxIndex $domainShell | - categoryRef($domainShell,i) is [sig:=[op,types],:.] and + for i in 6..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 d73344de..33539fa0 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -437,7 +437,6 @@ buildFunctor(db,sig,code,$locals,$e) == -- this list is not augmented by this function -- $e: environment --GLOBAL VARIABLES REFERENCED: --- $domainShell: passed in from compDefineFunctor1 -- $QuickCode: compilation flag $definition: local := dbConstructorForm db [name,:args] := $definition @@ -466,7 +465,7 @@ buildFunctor(db,sig,code,$locals,$e) == [$catsig,:argsig] := sig catvecListMaker := removeDuplicates [comp($catsig,$EmptyMode,$e).expr, - :[compCategories(u,$e) for [u,:.] in categoryAncestors $domainShell]] + :[compCategories(u,$e) for [u,:.] in categoryAncestors dbDomainShell db]] condCats := InvestigateConditions(db,[$catsig,:rest catvecListMaker],$e) -- a list, one %for each element of catvecListMaker -- indicating under what conditions this @@ -555,7 +554,7 @@ NRTsetVector4a(db,sig,form,cond) == sig is '$ => domainList := [optimize comp(d,$EmptyMode,$e).expr or d - for d in categoryPrincipals $domainShell] + for d in categoryPrincipals dbDomainShell db] $uncondList := append(domainList,$uncondList) if isCategoryForm(form,$e) then $uncondList := [form,:$uncondList] $uncondList @@ -575,7 +574,7 @@ NRTmakeSlot1Info db == [[first dbParameters db,:'_$],:dbFormalSubst db] dbFormalSubst db exports := - transformOperationAlist applySubst(pairlis,categoryExports $domainShell) + transformOperationAlist applySubst(pairlis,categoryExports dbDomainShell db) opList := $NRTderivedTargetIfTrue => 'derived $insideCategoryPackageIfTrue => slot1Filter exports @@ -613,7 +612,7 @@ changeDirectoryInSlot1 db == --called by buildFunctor -- if called inside buildFunctor, dbEntityCount gives different locs -- otherwise called from compFunctorBody (all lookups are forwarded): -- dbUsedEntities = nil ===> all slot numbers become nil - $lisplibOperationAlist := [sigloc(db,entry) for entry in categoryExports $domainShell] where + $lisplibOperationAlist := [sigloc(db,entry) for entry in categoryExports dbDomainShell db] where sigloc(db,[opsig,pred,fnsel]) == if pred isnt true then pred := simpBool pred @@ -627,7 +626,7 @@ changeDirectoryInSlot1 db == --called by buildFunctor copyList $lisplibOperationAlist,function second) $lastPred: local := false $newEnv: local := $e - categoryExports($domainShell) := [fn(db,entry) for entry in sortedOplist] where + categoryExports(dbDomainShell db) := [fn(db,entry) for entry in sortedOplist] where fn(db,[[op,sig],pred,fnsel]) == if $lastPred ~= pred then $newEnv := deepChaseInferences(pred,$e) diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index d9433cfe..282d5969 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.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 @@ -382,7 +382,6 @@ $categoryPredicateList := [] $getDomainCode := nil $addForm := nil -$domainShell := nil --% |