aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/define.boot38
-rw-r--r--src/interp/lisplib.boot7
2 files changed, 21 insertions, 24 deletions
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