diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 9 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 13 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 57 | ||||
| -rw-r--r-- | src/interp/sys-utility.boot | 3 |
4 files changed, 24 insertions, 58 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 3ca9aed2..2adf1737 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,14 @@ 2011-08-29 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/lisplib.boot (loadLib): Remove deadcode. + (isDomainForm): Tidy. + (isFunctor): Likewise. + (compDefineExports): Remove as no longer used. + * interp/sys-utility.boot (loadExports): Likewise. + * interp/g-util.boot (get0, get1, get2): Tidy. + +2011-08-29 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/lisplib.boot (writePrincipals): New. (finalizeLisplib): Use it. diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 321f8b9d..ec3afc21 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -222,22 +222,21 @@ get(x,prop,e) == get1(x,prop,e) get0(x,prop,e) == - cons? x => get(x.op,prop,e) - u:= QLASSQ(x,first first e) => QLASSQ(prop,u) - (tail:= rest first e) and (u:= fastSearchCurrentEnv(x,tail)) => + cons? x => get0(x.op,prop,e) + u := QLASSQ(x,first first e) => QLASSQ(prop,u) + (tail := rest first e) and (u := fastSearchCurrentEnv(x,tail)) => QLASSQ(prop,u) nil get1(x,prop,e) == - --this is the old get - cons? x => get(x.op,prop,e) - prop="modemap" and $insideCapsuleFunctionIfTrue => + cons? x => get1(x.op,prop,e) + prop = "modemap" and $insideCapsuleFunctionIfTrue => symbolLassoc("modemap",getProplist(x,$CapsuleModemapFrame)) or get2(x,prop) LASSOC(prop,getProplist(x,e)) or get2(x,prop) get2(x,prop) == - prop="modemap" and ident? x and constructor? x => + prop = "modemap" and ident? x and constructor? x => (u := getConstructorModemap x) => [u] nil nil diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 9029c3a6..de8a2cad 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -321,13 +321,7 @@ loadLib cname == clearConstructorCache cname updateDatabase(cname,cname,systemdir?) installConstructor(cname,kind) - u := getConstructorModemap cname updateCategoryTable(cname,kind) - coSig := - u => - [[.,:sig],:.] := u - [nil,:[categoryForm?(x) for x in rest sig]] - nil property(cname,'LOADED) := fullLibName if $InteractiveMode then $CategoryFrame := $EmptyEnvironment stopTimingProcess 'load @@ -770,15 +764,15 @@ getSlotFromCategoryForm (x,index) == u:= eval [x.op,:[MKQ f for f in $FormalMapVariableList for . in 1..#x.args]] not vector? u => systemErrorHere '"getSlotFromCategoryForm" - u . index + categoryRef(u,index) isDomainForm(D,e) == + op := opOf D --added for MPOLY 3/83 by RDJ - symbolMember?(KAR D,$SpecialDomainNames) or isFunctor D or - -- ((D is ['Mapping,target,:.]) and isCategoryForm(target,e)) or - ((getmode(D,e) is ['Mapping,target,:.]) and isCategoryForm(target,e)) or - isCategoryForm(getmode(D,e),e) or isDomainConstructorForm(D,e) + symbolMember?(op,$SpecialDomainNames) or isFunctor op or + ((getmode(op,e) is ['Mapping,target,:.]) and isCategoryForm(target,e)) or + isCategoryForm(getmode(op,e),e) or isDomainConstructorForm(D,e) isDomainConstructorForm(D,e) == D is [op,:argl] and (u:= get(op,"value",e)) and @@ -793,10 +787,10 @@ isFunctor x == getConstructorKindFromDB op in '(domain package) u:= get(op,'isFunctor,$CategoryFrame) or op in '(SubDomain Union Record Enumeration) => u - ab := getConstructorAbbreviationFromDB op => + getConstructorAbbreviationFromDB op => if getConstructorKindFromDB op = "category" then updateCategoryFrameForCategory op - else loadExports ab or updateCategoryFrameForConstructor op + else updateCategoryFrameForConstructor op get(op,'isFunctor,$CategoryFrame) nil @@ -808,8 +802,8 @@ getIndexPathname dir == getAllIndexPathnames: %String -> %List %Thing getAllIndexPathnames dir == - -- GCL's semantics of Common Lisp's `DIRECTORY *' differs from the - -- rest of everybody else' semantics. Namely, GCL would return a + -- GCL's semantics of Common Lisp's `DIRECTORY *' differs from + -- everybody else's. Namely, GCL would return a -- a list of drirectories AND files. Pretty much like `ls *'. -- Everybody else strips out directories. )if %hasFeature KEYWORD::GCL @@ -851,36 +845,3 @@ getIndexTable dir == finally (if stream ~= nil then closeStream stream) --% -compDefineExports(form,ops,sig,e) == - not $LISPLIB => systemErrorHere "compDefineExports" - op := first form - -- Ensure constructor parameters appear as formals - sig := applySubst($pairlis, sig) - ops := applySubst($pairlis,ops) - form := applySubst($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). - if $compileExportsOnly then - for entry in ops repeat - fixupSigloc entry where - fixupSigloc entry == - [opsig,pred,funsel] := entry - if pred isnt 'T then - entry.rest.first := simpBool pred - funsel is [op,a,:.] and op in '(ELT CONST) => - entry.rest.rest.first := [op,a,nil] - ops := listSort(function GGREATERP, ops, function first) - libName := getConstructorAbbreviation op - exportsFile := strconc(symbolName libName,'".sig") - removeFile exportsFile - withOutputFile(s,exportsFile, - PRETTYPRINT( - ["SETQ", "$CategoryFrame", - ["put", quoteForm op, quoteForm "isFunctor", quoteForm ops, - ["addModemap", quoteForm op, quoteForm form, - quoteForm sig, true, quoteForm op, - ["put", quoteForm op, quoteForm "mode", - quoteForm ["Mapping",:sig], "$CategoryFrame"]]]], s)) - [op,["Mapping",:sig],e] diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index c6859362..e6a36af3 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -222,9 +222,6 @@ loadModule(path,name) == FMAKUNBOUND name LOAD path -loadExports name == - loadFileIfPresent strconc(STRING name,'".sig") - --% numerics log10 x == LOG(x,10) |