diff options
| author | dos-reis <gdr@axiomatics.org> | 2008-11-24 23:03:27 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2008-11-24 23:03:27 +0000 |
| commit | 98bc135baf2bae90f39bb919f56afce5ae13a1ad (patch) | |
| tree | ad560e2494e42935496088417472b5d25f4e789e /src/interp/lisplib.boot | |
| parent | 5b693510bb2368f453b71086fcd1916cee7fea82 (diff) | |
| download | open-axiom-98bc135baf2bae90f39bb919f56afce5ae13a1ad.tar.gz | |
* interp/lisplib.boot (compDefineExports): Tidy.
* interp/define.boot (compDefineFunctor1): Adjust call.
Diffstat (limited to 'src/interp/lisplib.boot')
| -rw-r--r-- | src/interp/lisplib.boot | 27 |
1 files changed, 15 insertions, 12 deletions
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index fe0972da..79b4ec24 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -705,24 +705,27 @@ getIndexTable dir == nil) --% -compDefineExports(op,ops,sig,e) == +compDefineExports(form,ops,sig,e) == not $LISPLIB => systemErrorHere "compDefineExports" + op := first form -- Ensure constructor parameters appear as formals sig := SUBLIS($pairlis, sig) ops := SUBLIS($pairlis,ops) - -- Since we don't compile the capsule, the slot numbers are + form := SUBLIS($pairlis,form) + -- In case we are not compiling the capsule, the slot numbers are -- most likely bogus. Nullify them so people don't think they -- bear any meaningful semantics (well, they should not think -- these are forwarding either). - for entry in ops repeat - fixupSigloc entry where - fixupSigloc entry == - [opsig,pred,funsel] := entry - if pred ^= 'T then - rplac(second entry, simpBool pred) - funsel is [op,a,:.] and op in '(ELT CONST) => - rplac(third entry,[op,a,nil]) - ops := listSort(function GGREATERP, ops, function first) + if $compileExportsOnly then + for entry in ops repeat + fixupSigloc entry where + fixupSigloc entry == + [opsig,pred,funsel] := entry + if pred ^= 'T then + rplac(second entry, simpBool pred) + funsel is [op,a,:.] and op in '(ELT CONST) => + rplac(third entry,[op,a,nil]) + ops := listSort(function GGREATERP, ops, function first) libName := getConstructorAbbreviation op exportsFile := strconc(STRING libName,'".sig") removeFile exportsFile @@ -730,7 +733,7 @@ compDefineExports(op,ops,sig,e) == PRETTYPRINT( ["SETQ", "$CategoryFrame", ["put", quoteForm op, quoteForm "isFunctor", quoteForm ops, - ["addModemap", quoteForm op, quoteForm first sig, + ["addModemap", quoteForm op, quoteForm form, quoteForm sig, true, quoteForm op, ["put", quoteForm op, quoteForm "mode", quoteForm ["Mapping",:sig], "$CategoryFrame"]]]], s)) |