diff options
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/interp/define.boot | 38 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 7 |
3 files changed, 28 insertions, 24 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 0f7983ef..8adfcbcc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,12 @@ 2013-05-28 Gabriel Dos Reis <gdr@integrable-solutions.net> + * interp/define.boot (compDefineCategory1): Take DB parameter. + (compDefineCategory2): Likewise. + (compDefineFunctor1): Likewise. + * interp/lisplib.boot (compDefineLisplib): Likewise. + +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. diff --git a/src/interp/define.boot b/src/interp/define.boot index bb4f541a..f4b2887e 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -980,7 +980,7 @@ evalCategoryForm(x,e) == skipCategoryPackage? capsule == null capsule or $bootStrapMode -compDefineCategory1(df is ['DEF,form,sig,body],m,e,fal) == +compDefineCategory1(db,df is ['DEF,form,sig,body],m,e,fal) == categoryCapsule := body is ['add,cat,capsule] => body := cat @@ -988,11 +988,10 @@ compDefineCategory1(df is ['DEF,form,sig,body],m,e,fal) == nil if form isnt [.,:.] then form := [form] - [d,m,e]:= compDefineCategory2(form,sig,body,m,e,fal) + [d,m,e]:= compDefineCategory2(db,form,sig,body,m,e,fal) if not skipCategoryPackage? categoryCapsule then [.,.,e] := $insideCategoryPackageIfTrue: local := true - $categoryPredicateList: local := - makeCategoryPredicates(form,dbCategory constructorDB form.op) + $categoryPredicateList: local := makeCategoryPredicates(form,dbCategory db) defaults := mkCategoryPackage(form,cat,categoryCapsule) T := compDefine1(nil,defaults,$EmptyMode,e) or return stackSemanticError( @@ -1108,7 +1107,7 @@ getArgumentModeOrMoan(x,form,e) == getArgumentMode(x,e) or stackSemanticError(["argument ",x," of ",form," is not declared"],nil) -compDefineCategory2(form,signature,body,m,e,$formalArgList) == +compDefineCategory2(db,form,signature,body,m,e,$formalArgList) == --1. bind global variables $prefix: local := nil $op: local := form.op @@ -1120,9 +1119,6 @@ compDefineCategory2(form,signature,body,m,e,$formalArgList) == $currentCategoryBody : local := body --Set in DomainSubstitutionFunction, used further down -- 1.1 augment e to add declaration $: <form> - db := constructorDB $op - dbClearForCompilation! db - dbCompilerData(db) := makeCompilationData() dbFormalSubst(db) := pairList(form.args,$TriangleVariableList) dbInstanceCache(db) := true deduceImplicitParameters(db,e) @@ -1201,11 +1197,13 @@ compDefineCategory(df,m,e,fal) == db := constructorDB ctor kind := dbConstructorKind db kind ~= "category" => throwKeyedMsg("S2IC0016",[ctor,"category",kind]) + dbClearForCompilation! db dbConstructorForm(db) := lhs - $insideFunctorIfTrue => - try compDefineCategory1(df,m,e,fal) - finally dbCompilerData(db) := nil - compDefineLisplib(df,m,e,fal,'compDefineCategory1) + dbCompilerData(db) := makeCompilationData() + try + $insideFunctorIfTrue => compDefineCategory1(db,df,m,e,fal) + compDefineLisplib(db,df,m,e,fal,'compDefineCategory1) + finally dbCompilerData(db) := nil %CatObjRes -- result of compiling a category @@ -1445,9 +1443,15 @@ getDollarName env == compDefineFunctor(df,m,e,fal) == $profileCompiler: local := true $profileAlist: local := nil - compDefineLisplib(df,m,e,fal,'compDefineFunctor1) - -compDefineFunctor1(df is ['DEF,form,signature,body],m,$e,$formalArgList) == + form := second df + db := constructorDB opOf form + dbClearForCompilation! db + dbConstructorForm(db) := form + dbCompilerData(db) := makeCompilationData() + try compDefineLisplib(db,df,m,e,fal,'compDefineFunctor1) + finally dbCompilerData(db) := nil + +compDefineFunctor1(db,df is ['DEF,form,signature,body],m,$e,$formalArgList) == -- 0. Make `form' a constructor instantiation form if form isnt [.,:.] then form := [form] @@ -1469,10 +1473,6 @@ compDefineFunctor1(df is ['DEF,form,signature,body],m,$e,$formalArgList) == $insideFunctorIfTrue: local:= true $genSDVar: local:= 0 originale:= $e - db := constructorDB $op - dbClearForCompilation! db - dbConstructorForm(db) := form - dbCompilerData(db) := makeCompilationData() dbFormalSubst(db) := pairList(form.args,$FormalMapVariableList) $e := registerConstructor($op,$e) $e := setDollarName(form,$e) diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 54220181..6695c431 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -413,12 +413,10 @@ compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) == val:= _/D_,2_,LIB(fun,infile,outstream,auxOp,editFlag,traceFlag) val -compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,fal,fn) == +compDefineLisplib(db,df:=["DEF",[op,:.],:.],m,e,fal,fn) == --fn= compDefineCategory1 OR compDefineFunctor1 sayMSG fillerSpaces(72,char "-") $op: local := op - db := constructorDB op - dbPredicates(db) := nil $lisplibOperationAlist: local := nil $libFile: local := nil --for categories, is rhs of definition; otherwise, is target of functor @@ -435,13 +433,12 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,fal,fn) == -- following guarantee's compiler output files get closed. ok := false; try - res:= FUNCALL(fn,df,m,e,fal) + res:= FUNCALL(fn,db,df,m,e,fal) leaveIfErrors(libName,dbConstructorKind db) sayMSG ['" finalizing ",$spadLibFT,:bright libName] ok := finalizeLisplib(db,libName) finally RSHUT $libFile - dbCompilerData(db) := nil if ok then lisplibDoRename(libName) filearg := makeFullFilePath [libName,$spadLibFT,$libraryDirectory] RPACKFILE filearg |