aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/interp/c-util.boot82
-rw-r--r--src/interp/define.boot18
-rw-r--r--src/interp/g-util.boot12
3 files changed, 57 insertions, 55 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 05e29723..569e25d8 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -39,7 +39,7 @@ namespace BOOT
module c_-util where
makeWorkerName: %Symbol -> %Symbol
clearReplacement: %Symbol -> %Thing
- replaceSimpleFunctions: %Form -> %Form
+ replaceSimpleFunctions: (%FunctionContext, %Form) -> %Form
foldExportedFunctionReferences: (%Database,%List %Code) -> %List %Code
diagnoseUnknownType: (%Mode,%Env) -> %Form
declareUnusedParameters: %Code -> %Code
@@ -1260,55 +1260,30 @@ ambiguousSignatureError(op, sigs) ==
stackSemanticError(['"signature of lhs not unique. Candidates are:",
:displayAmbiguousSignatures($op,sigs)],nil)
-
---% Capsule Directory Management
-
-++ Holds the list of slot number-export function pairs of
-++ the current functor.
-$capsuleDirectory := nil
-
-clearCapsuleDirectory() ==
- $capsuleDirectory := nil
-
-++ Return the linkage name of the exported operation associated with
-++ slot number `slot'. A nil entry means that either the operation
-++ is not defined, or it is conditional.
-getCapsuleDirectoryEntry slot ==
- scalarTarget(slot,$capsuleDirectory)
-
-++ Update the current capsule directory with entry controlled by
-++ predicate `pred'.
-updateCapsuleDirectory(entry,pred) ==
- pred isnt true => nil
- $capsuleDirectory := [entry,:$capsuleDirectory]
-
-
-
-
--% Tree walkers
++ Walk VM conditional forms mutating sub-forms with the unary
++ function `fun'
-mutateConditionalFormWithUnaryFunction(form,fun) ==
+mutateConditionalFormWithUnaryFunction(fc,form,fun) ==
form isnt ['%when,:body] => form
for clauses in tails body repeat
-- a clause is a list of forms
for subForms in tails first clauses repeat
- subForms.first := apply(fun,[first subForms])
+ subForms.first := apply(fun,[fc,first subForms])
form
++ Walk VM a binding-form mutating enclosed expression forms with
++ the unary function `fun'. Every sub-form is visited except
++ local variable declarations, though their initializers
++ are visited.
-mutateBindingFormWithUnaryFunction(form,fun) ==
+mutateBindingFormWithUnaryFunction(fc,form,fun) ==
form isnt [op,inits,:body] and op in '(LET %bind) => form
for defs in tails inits repeat
def := first defs
def isnt [.,:.] => nil -- no initializer
- def.rest.first := apply(fun,[second def])
+ def.rest.first := apply(fun,[fc,second def])
for stmts in tails body repeat
- stmts.first := apply(fun,[first stmts])
+ stmts.first := apply(fun,[fc,first stmts])
form
--%
@@ -1366,19 +1341,19 @@ redexForm name ==
++ Attempt to resolve the indirect reference to a constant form
++ `[spadConstant,$,n]' to a simpler expression
-resolveConstantForm form ==
- fun := getCapsuleDirectoryEntry third form or return form
+resolveConstantForm(fc,form) ==
+ fun := getCapsuleDirectoryEntry(fc,third form) or return form
-- Conservatively preserve object identity and storage
-- consumption by not folding non-atomic constant forms.
getFunctionReplacement fun isnt ['XLAM,=nil,body] => form
atomic? body or isVMConstantForm body => body
form
-mutateArgumentList(args,fun) ==
+mutateArgumentList(fc,args,fun) ==
for x in tails args repeat
arg := first x
atomic? arg => nil
- x.first := apply(fun,[arg])
+ x.first := apply(fun,[fc,arg])
args
inlineDirectCall call ==
@@ -1407,31 +1382,31 @@ inlineDirectCall call ==
call
call
-resolveIndirectCall form ==
+resolveIndirectCall(fc,form) ==
fun := lastNode form
fun isnt [['%tref,'$,n]] => form
- op := getCapsuleDirectoryEntry n or return form
+ op := getCapsuleDirectoryEntry(fc,n) or return form
form.op := op
fun.first := '$
inlineDirectCall form
++ Walk `form' and replace simple functions as appropriate.
-replaceSimpleFunctions form ==
+replaceSimpleFunctions(fc,form) ==
atomic? form => form
form.op is 'DECLARE => form
form.op is '%when =>
- mutateConditionalFormWithUnaryFunction(form,function replaceSimpleFunctions)
+ mutateConditionalFormWithUnaryFunction(fc,form,function replaceSimpleFunctions)
form.op in '(LET %bind) =>
- mutateBindingFormWithUnaryFunction(form,function replaceSimpleFunctions)
- form is ['spadConstant,'$,.] => resolveConstantForm form
+ mutateBindingFormWithUnaryFunction(fc,form,function replaceSimpleFunctions)
+ form is ['spadConstant,'$,.] => resolveConstantForm(fc,form)
-- process argument first.
- mutateArgumentList(form.args,function replaceSimpleFunctions)
- form.op is 'SPADCALL => resolveIndirectCall form
+ mutateArgumentList(fc,form.args,function replaceSimpleFunctions)
+ form.op is 'SPADCALL => resolveIndirectCall(fc,form)
-- see if we know something about this function.
[fun,:args] := form
symbol? fun => inlineDirectCall form
not cons? fun => form
- form.first := replaceSimpleFunctions fun
+ form.first := replaceSimpleFunctions(fc,fun)
form
@@ -1493,6 +1468,22 @@ almostPure? x ==
ops := [:$coreDiagnosticFunctions,:$VMsideEffectFreeOperators]
semiSimpleRelativeTo?(x,ops)
+++ Return a function context structure for a capsule-level function
+++ definition.
+makeCapsuleFunctionContext(db,fun) ==
+ or/[mk%FunctionContext(db,op,sig,pred)
+ for [[[op,:sig],:pred],:impl] in dbCapsuleDefinitions db
+ | symbolEq?(fun,rest impl)]
+ or systemError ['"cannot find context for",:bright fun]
+
+++ Return the linkage name of the exported operation associated with
+++ slot number `slot'. A nil result means that either the operation
+++ is not defined, or the scope predicates don't match.
+getCapsuleDirectoryEntry(fc,slot) ==
+ pred' := fcPredicate fc
+ or/[rest impl for [[.,:pred],:impl] in dbCapsuleDefinitions fcDatabase fc
+ | first impl = slot and (pred is true or pred = pred')]
+
++ `defs' is a list of function definitions from the current domain.
++ Walk that list and replace references to unconditional operations
++ with their corresponding linkage names.
@@ -1501,7 +1492,8 @@ foldExportedFunctionReferences(db,defs) ==
fun isnt [name,lamex] => nil
getFunctionReplacement name => nil
lamex isnt ['%lambda,vars,body] => nil
- body := replaceSimpleFunctions body
+ fc := makeCapsuleFunctionContext(db,name)
+ body := replaceSimpleFunctions(fc,body)
form := expandableDefinition?(vars,body) =>
registerFunctionReplacement(db,name,form)
second(fun) := ["LAMBDA",vars,["DECLARE",["IGNORE",last vars]],body]
diff --git a/src/interp/define.boot b/src/interp/define.boot
index dfdf79f0..3218e285 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1586,7 +1586,6 @@ incompleteFunctorBody(db,m,body,e) ==
++ for a functor definition.
compFunctorBody(db,body,m,e) ==
$bootStrapMode => incompleteFunctorBody(db,m,body,e)
- clearCapsuleDirectory() -- start collecting capsule functions.
T:= compOrCroak(body,m,e)
dbCapsuleIR(db) := reverse! dbCapsuleIR db
-- ??? Don't resolve default definitions, yet.
@@ -1594,7 +1593,6 @@ compFunctorBody(db,body,m,e) ==
$insideCategoryPackageIfTrue => dbCapsuleIR db
not $optExportedFunctionReference => dbCapsuleIR db
foldExportedFunctionReferences(db,dbCapsuleIR db)
- clearCapsuleDirectory() -- release storage.
body is [op,:.] and op in '(add CAPSULE) => T
$NRTaddForm :=
body is ["SubDomain",domainForm,predicate] => domainForm
@@ -1985,8 +1983,6 @@ compDefineCapsuleFunction(db,df is ['DEF,form,signature,body],
encodeFunctionName(db,$op,signature,$suffix)
pred := mkpf($predl,'and)
noteCapsuleFunctionDefinition(db,[[$op,:signature],:pred],[n,:op'])
- if n ~= nil and not $insideCategoryPackageIfTrue then
- updateCapsuleDirectory([n,:op'],pred)
-- Let the backend know about this function's type
if $optProclaim then
proclaimCapsuleFunction(db,op',signature)
@@ -1997,7 +1993,8 @@ compDefineCapsuleFunction(db,df is ['DEF,form,signature,body],
body' := replaceExitEtc(T.expr,catchTag,"TAGGEDreturn",$returnMode)
body' := addArgumentConditions(body',$op)
finalBody := ['%scope,catchTag,body']
- compile(db,[op',['%lambda,[:argl,'$],finalBody]],signature)
+ fc := mk%FunctionContext(db,$op,signature,pred)
+ compile(fc,[op',['%lambda,[:argl,'$],finalBody]])
$functorStats:= addStats($functorStats,$functionStats)
--7. give operator a 'value property
@@ -2098,9 +2095,9 @@ putInLocalDomainReferences(db,def := [opName,[lam,varl,body]]) ==
def
-compile(db,u,signature) ==
- stuffToCompile := putInLocalDomainReferences(db,optimizeFunctionDef u)
- try spadCompileOrSetq(db,stuffToCompile)
+compile(fc,u) ==
+ stuffToCompile := putInLocalDomainReferences(fcDatabase fc,optimizeFunctionDef u)
+ try spadCompileOrSetq(fc,stuffToCompile)
finally
functionStats := [0,elapsedTime()]
$functionStats := addStats($functionStats,functionStats)
@@ -2108,10 +2105,11 @@ compile(db,u,signature) ==
++ Subroutine of compile. Called to generate backend code for
++ items defined directly or indirectly at capsule level.
-spadCompileOrSetq(db,form is [nam,[lam,vl,body]]) ==
+spadCompileOrSetq(fc,form is [nam,[lam,vl,body]]) ==
+ db := fcDatabase fc
vl := cleanParameterList! vl
if $optReplaceSimpleFunctions then
- body := replaceSimpleFunctions body
+ body := replaceSimpleFunctions(fc,body)
if nam' := forwardingCall?(vl,body) then
registerFunctionReplacement(db,nam,nam')
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index dc73604a..34997305 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -51,6 +51,18 @@ module g_-util where
--%
+++ Data structure holding a information about capsule-level function
+++ specification.
+structure %FunctionContext ==
+ Record(db: %Maybe %Database, op: %Identifier, sig: %Signature,
+ pred: %Predicate) with
+ fcDatabase == (.db)
+ fcOperator == (.op)
+ fcSignature == (.sig)
+ fcPredicate == (.pred)
+
+--%
+
abstraction? x ==
x is [op,:.] and ident? op and abstractionOperator? op