diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 12 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 50 | ||||
| -rw-r--r-- | src/interp/define.boot | 11 | ||||
| -rw-r--r-- | src/interp/functor.boot | 12 |
4 files changed, 78 insertions, 7 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 8eefe4d1..cfdb4394 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,17 @@ 2008-10-06 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/functor.boot (DescendCode): Update capsule directory only + for non-default implementations. + * interp/c-util.boot ($capsuleDirectory): New. + (clearCapsuleDirectory): Likewise. + (getCapsuleDirectoryEntry): Likewise. + (updateCapsuleDirectory): Likewise. + (foldSpadcall): Likewise. + (foldExportedFunctionReferences): Likewise. + * interp/define.boot (compFunctorBody): Use it. + +2008-10-06 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/sys-macros.lisp (|quietlyIfInteractive|): New. * interp/compiler.boot (quietlyIfInteractive): Use it. (compQuietly): Likewise. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 080e683d..be616cc5 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -38,6 +38,7 @@ namespace BOOT module c_-util where clearReplacement: %Symbol -> %Thing replaceSimpleFunctions: %Form -> %Form + foldExportedFunctionReferences: %List -> %List --% ++ if true continue compiling after errors @@ -836,6 +837,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 + $capsuleFunctionStack := 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 == + rest ASSOC(slot,$capsuleDirectory) + +++ Update the current capsule directory with entry controlled by +++ predicate `pred'. +updateCapsuleDirectory(entry,pred) == + pred ^= true => nil + entry isnt ["$",slot,["CONS",["dispatchFunction",fun],:.],:.] => nil + $capsuleDirectory := [[slot,:fun],:$capsuleDirectory] + --% -- A function is simple if it looks like a super combinator, and it @@ -895,6 +920,31 @@ replaceSimpleFunctions form == not EQ(fun',fun) => rplac(first form,fun') form + +++ Replace all SPADCALLs to operations defined in the current +++ domain. Conditional operations are not folded. +foldSpadcall: %Form -> %Form +foldSpadcall form == + isAtomicForm form => form + for args in tails rest form repeat + foldSpadcall first args + first form isnt "SPADCALL" => form + fun := lastNode form + fun isnt [["getShellEntry","$",slot]] => form + null (op := getCapsuleDirectoryEntry slot) => form + rplac(first fun, "$") + rplac(first form, op) + + +++ `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. +foldExportedFunctionReferences defs == + for fun in defs repeat + foldSpadcall fun is [.,lamex] => + rplac(third lamex, replaceSimpleFunctions third lamex) + defs + ++ record optimizations permitted at level `level'. setCompilerOptimizations level == level = nil => nil diff --git a/src/interp/define.boot b/src/interp/define.boot index 7dc8a79a..a2af1e8a 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -663,10 +663,15 @@ disallowNilAttribute x == compFunctorBody(body,m,e,parForm) == $bootStrapMode = true => [bootStrapError($functorForm, _/EDITFILE),m,e] - $capsuleFunctionStack := nil -- start collecting capsule functions. + clearCapsuleDirectory() -- start collecting capsule functions. T:= compOrCroak(body,m,e) - COMP $capsuleFunctionStack - $capsuleFunctionStack := nil -- release storage. + $capsuleFunctionStack := nreverse $capsuleFunctionStack + -- ??? Don't resolve default definitions, yet. + if $insideCategoryPackageIfTrue then + COMP $capsuleFunctionStack + else + COMP foldExportedFunctionReferences $capsuleFunctionStack + clearCapsuleDirectory() -- release storage. body is [op,:.] and MEMQ(op,'(add CAPSULE)) => T $NRTaddForm := body is ["SubDomain",domainForm,predicate] => domainForm diff --git a/src/interp/functor.boot b/src/interp/functor.boot index af887d1a..a3e122c6 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -639,6 +639,9 @@ DescendCode(code,flag,viewAssoc,EnvToPass) == dom body:= ['CONS,implem,dom] u:= SetFunctionSlots(sig,body,flag,'original) + -- ??? We do not resolve default definitions, yet. + if not $insideCategoryPackageIfTrue then + updateCapsuleDirectory(rest u, flag) ConstantCreator u => if not (flag=true) then u:= ['COND,[ProcessCond(flag,viewAssoc),u]] $ConstantAssignments:= [u,:$ConstantAssignments] @@ -657,9 +660,10 @@ DescendCode(code,flag,viewAssoc,EnvToPass) == code ConstantCreator u == - null u => nil - u is [q,.,.,u'] and (q in '(setShellEntry SETELT QSETREFV)) => ConstantCreator u' - u is ['CONS,:.] => nil + null u => false + u is [q,.,.,u'] and (q in '(setShellEntry SETELT QSETREFV)) => + ConstantCreator u' + u is ['CONS,:.] => false true ProcessCond(cond,viewassoc) == @@ -683,7 +687,7 @@ SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding" --+ catNames := ['$] for u in $catvecList for v in catNames repeat - null body => return NIL + null body => return nil for catImplem in LookUpSigSlots(sig,u.1) repeat if catImplem is [q,.,index] and (q='ELT or q='CONST) then |