aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-11-07 05:28:24 +0000
committerdos-reis <gdr@axiomatics.org>2011-11-07 05:28:24 +0000
commit0062eb960026efdf72e3ecb301aa46054e0d5ca2 (patch)
treed38784175f3296a34a3bca15b480a60cc166f888 /src/interp
parent58566223a7545abff4da2dabc323795e98711a94 (diff)
downloadopen-axiom-0062eb960026efdf72e3ecb301aa46054e0d5ca2.tar.gz
* interp/compiler.boot ($compileOnlyCertainItems): Remove.
* interp/define.boot ($NRTslot1Info): Likewise. (getInfovecCode): Add additional environment argument. Adjust caller. Call NRTmakeSlot1Info here. (NRTgetLookupFunction): Lose second and third arguments. They are derivable from the DB argument. Adjust caller. (compDefineFunctor1): Do not bind $NRTslot1Info. (compDefineCapsuleFunction): Adjust. (compile): Likewise. * interp/i-syscmd.boot (compilerDoitWithScreenedLisplib): Remove. Adjust caller. * interp/nruncomp.boot (NRTmakeSlot1Info): Tak a DB argument. Adjust caller. (mkSlot1sublis): Remove.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/compiler.boot4
-rw-r--r--src/interp/define.boot54
-rw-r--r--src/interp/i-syscmd.boot23
-rw-r--r--src/interp/nruncomp.boot12
4 files changed, 15 insertions, 78 deletions
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 88ef6691..5ab502a0 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -86,10 +86,6 @@ $coreDiagnosticFunctions ==
$IOFormDomains ==
[$InputForm,$OutputForm,$Syntax]
-++ list of functions to compile
-$compileOnlyCertainItems := []
-
-
--%
compTopLevel: (%Form,%Mode,%Env) -> %Maybe %Triple
diff --git a/src/interp/define.boot b/src/interp/define.boot
index f7752fc7..d8cf7fef 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -72,7 +72,6 @@ $condAlist := []
$uncondAlist := []
$NRTslot1PredicateList := []
$NRTattributeAlist := []
-$NRTslot1Info := nil
$NRTdeltaListComp := []
$signature := nil
$lookupFunction := nil
@@ -344,13 +343,13 @@ chaseInferences(pred,$e) ==
--=======================================================================
-- Generate Code to Create Infovec
--=======================================================================
-getInfovecCode db ==
+getInfovecCode(db,e) ==
--Function called by compDefineFunctor1 to create infovec at compile time
['LIST,
MKQ makeDomainTemplate db,
- MKQ makeCompactDirect(db,$NRTslot1Info),
- MKQ NRTgenFinalAttributeAlist(db,$e),
- NRTmakeCategoryAlist(db,$e),
+ MKQ makeCompactDirect(db,NRTmakeSlot1Info db),
+ MKQ NRTgenFinalAttributeAlist(db,e),
+ NRTmakeCategoryAlist(db,e),
MKQ $lookupFunction]
--=======================================================================
@@ -516,9 +515,10 @@ getXmode(x,e) ==
--=======================================================================
-- Compute the lookup function (complete or incomplete)
--=======================================================================
-NRTgetLookupFunction(db,domform,exCategory,addForm,env) ==
+NRTgetLookupFunction(db,addForm,env) ==
$why: local := nil
- domform := dbSubstituteFormals(db,domform)
+ domform := dbSubstituteFormals(db,dbConstructorForm db)
+ exCategory := dbCategory db
addForm isnt [.,:.] =>
ident? addForm and (m := getmode(addForm,env)) ~= nil and
isCategoryForm(m,env) and
@@ -1401,7 +1401,6 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
$uncondAlist: local := nil
$NRTslot1PredicateList: local := predicatesFromAttributes attributeList
$NRTattributeAlist: local := NRTgenInitialAttributeAlist(db,attributeList)
- $NRTslot1Info: local := nil --set in NRTmakeSlot1Info
$NRTaddForm: local := nil -- see compAdd
$NRTdeltaList: local := nil --list of misc. elts used in compiled fncts
$NRTdeltaListComp: local := nil --list of compiled forms for $NRTdeltaList
@@ -1443,11 +1442,6 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
u := sublisFormal(rhsArgs,u,$AtVariables)
emitSubdomainInfo($form,first u, second u)
T:= compFunctorBody(body,rettype,$e,parForm)
- -- If only compiling certain items, then ignore the body shell.
- $compileOnlyCertainItems =>
- reportOnFunctorCompilation()
- [nil, ['Mapping, :signature'], originale]
-
body':= T.expr
lamOrSlam :=
dbInstanceCache db = nil => 'LAM
@@ -1463,17 +1457,15 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
dbAncestors(db) := computeAncestorsOf($form,nil)
$insideFunctorIfTrue:= false
if not $bootStrapMode then
- $NRTslot1Info := NRTmakeSlot1Info()
libFn := dbAbbreviation db
- $lookupFunction: local :=
- NRTgetLookupFunction(db,$functorForm,modemap.mmTarget,$NRTaddForm,$e)
+ $lookupFunction: local := NRTgetLookupFunction(db,$NRTaddForm,$e)
--either lookupComplete (for forgetful guys) or lookupIncomplete
$byteAddress :local := 0
$byteVec :local := nil
$NRTslot1PredicateList :=
[simpBool x for x in $NRTslot1PredicateList]
LAM_,FILEACTQ('loadTimeStuff,
- ['MAKEPROP,MKQ $op,''infovec,getInfovecCode db])
+ ['MAKEPROP,MKQ $op,''infovec,getInfovecCode(db,$e)])
$lisplibOperationAlist:= operationAlist
-- Functors are incomplete during bootstrap
if $bootStrapMode then
@@ -1777,14 +1769,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,body],
not symbolMember?($op,$formalArgList) and
getXmode($op,e) is ['Mapping,:.] => 'local
'exported
-
- --6a skip if compiling only certain items but not this one
- -- could be moved closer to the top
- formattedSig := formatUnabbreviated ['Mapping,:signature']
- $compileOnlyCertainItems and _
- not symbolMember?($op, $compileOnlyCertainItems) =>
- sayBrightly ['" skipping ", localOrExported,:bright $op]
- [nil,['Mapping,:signature'],$e]
+ formattedSig := formatUnabbreviatedSig ['Mapping,:signature']
sayBrightly ['" compiling ",localOrExported,
:bright $op,'": ",:formattedSig]
@@ -1974,8 +1959,6 @@ putInLocalDomainReferences (def := [opName,[lam,varl,body]]) ==
def
-$savableItems := nil
-
compile u ==
[op,lamExpr] := u
if $suffix then
@@ -1996,23 +1979,6 @@ compile u ==
null symbolMember?(op,$formalArgList) and
getXmode(op,$e) is ['Mapping,:.]
u:= [op',lamExpr]
- -- If just updating certain functions, check for previous existence.
- -- Deduce old sequence number and use it (items have been skipped).
- if $compileOnlyCertainItems then
- parts := splitEncodedFunctionName(u.op, ";")
- -- Next line JHD/SMWATT 7/17/86 to deal with inner functions
- parts='inner => $savableItems:=[u.op,:$savableItems]
- unew := nil
- for [s,t] in $splitUpItemsAlreadyThere repeat
- if parts.0=s.0 and parts.1=s.1 and parts.2=s.2 then unew := t
- null unew =>
- sayBrightly ['" Error: Item did not previously exist"]
- sayBrightly ['" Item not saved: ", :bright u.op]
- sayBrightly ['" What's there is: ", $lisplibItemsAlreadyThere]
- nil
- sayBrightly ['" Renaming ", u.op, '" as ", unew]
- u := [unew, :rest u]
- $savableItems := [unew, :$saveableItems] -- tested by embedded RWRITE
optimizedBody:= optimizeFunctionDef u
stuffToCompile:=
if not $insideCapsuleFunctionIfTrue
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index a6483122..ec20fd06 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -527,7 +527,6 @@ compileSpad2Cmd args ==
optList := '( _
break _
constructor _
- functions _
library _
lisp _
new _
@@ -543,7 +542,6 @@ compileSpad2Cmd args ==
)
$scanIfTrue : local := false
- $compileOnlyCertainItems : local := nil
$f : local := nil -- compiler
$m : local := nil -- variables
@@ -571,10 +569,6 @@ compileSpad2Cmd args ==
fullopt is 'break => $scanIfTrue := nil
fullopt is 'vartrace => $QuickLet := false
fullopt is 'lisp => throwKeyedMsg("S2IZ0036",['")lisp"])
- fullopt is 'functions =>
- null optargs =>
- throwKeyedMsg("S2IZ0037",['")functions"])
- $compileOnlyCertainItems := optargs
fullopt is 'constructor =>
null optargs =>
throwKeyedMsg("S2IZ0037",['")constructor"])
@@ -590,11 +584,7 @@ compileSpad2Cmd args ==
$InteractiveMode : local := nil
-- avoid Boolean semantics transformations based on syntax only
$normalizeTree: local := false
- if $compileOnlyCertainItems then
- null constructor => sayKeyedMsg("S2IZ0040",nil)
- compilerDoitWithScreenedLisplib(constructor, fun)
- else
- compilerDoit(constructor, fun)
+ compilerDoit(constructor, fun)
if not $buildingSystemAlgebra then
extendLocalLibdb $newConlist
terminateSystemCommand()
@@ -615,17 +605,6 @@ compilerDoit(constructor, fun) ==
null member(ii,$constructorsSeen) =>
sayBrightly ['">>> Warning ",'"%b",ii,'"%d",'" was not found"]
-compilerDoitWithScreenedLisplib(constructor, fun) ==
- EMBED('RWRITE,
- '(LAMBDA (KEY VALUE STREAM)
- (COND ((AND (EQ STREAM $libFile)
- (NOT (MEMBER KEY $saveableItems)))
- VALUE)
- ((NOT NIL)
- (RWRITE KEY VALUE STREAM)))) )
- (try compilerDoit(constructor,fun); finally SEQ(UNEMBED 'RWRITE))
-
-
--% )copyright -- display copyright notice
summary l ==
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 2375b8d7..2ccdbd25 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -614,7 +614,7 @@ NRTsetVector4a(sig,form,cond) ==
$uncondList := [form,:append(categoryPrincipals evalform,$uncondList)]
$condList := [[cond,[form,:categoryPrincipals evalform]],:$condList]
-NRTmakeSlot1Info() ==
+NRTmakeSlot1Info db ==
-- 4 cases:
-- a:T == b add c --- slot1 directory has #s for entries defined in c
-- a:T == b --- slot1 has all slot #s = nil (see compFunctorBody)
@@ -622,9 +622,8 @@ NRTmakeSlot1Info() ==
-- a == b --- $NRTderivedTargetIfTrue = true; set directory to nil
pairlis :=
$insideCategoryPackageIfTrue =>
- [:argl,dollarName] := rest $form
- [[dollarName,:'_$],:mkSlot1sublis argl]
- mkSlot1sublis rest $form
+ [[first dbParameters db,:'_$],:dbFormalSubst db]
+ dbFormalSubst db
exports :=
transformOperationAlist applySubst(pairlis,categoryExports $domainShell)
opList :=
@@ -632,10 +631,7 @@ NRTmakeSlot1Info() ==
$insideCategoryPackageIfTrue => slot1Filter exports
exports
addList := applySubst(pairlis,$NRTaddForm)
- [$form.op,[addList,:opList]]
-
-mkSlot1sublis argl ==
- pairList(argl,$FormalMapVariableList)
+ [dbConstructor db,[addList,:opList]]
slot1Filter opList ==
--include only those ops which are defined within the capsule