aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGabriel Dos Reis <gdr@axiomatics.org>2016-02-01 05:07:49 -0800
committerGabriel Dos Reis <gdr@axiomatics.org>2016-02-01 05:07:49 -0800
commit88441bdc4ddfec01e7d6a7e7387b555f2e98eb96 (patch)
treede806526e9b7156ce04293c4841c3bd1bd22a91e /src
parent04be6d65c9bae10780f463c23a14922249c187de (diff)
downloadopen-axiom-88441bdc4ddfec01e7d6a7e7387b555f2e98eb96.tar.gz
Better indirect call resolution
The infrastructure put in place in the last few commits now enables better indirect calls ('SPADCALL') to operations implemented in the same capsule. The improvement here is that the limitation of unconditional definition is removed. Now, even conditional definitions are resolved as long as the its predicate and the predicate of the current function match.
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