diff options
| -rw-r--r-- | src/interp/c-util.boot | 82 | ||||
| -rw-r--r-- | src/interp/define.boot | 18 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 12 |
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 |