diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/interp/buildom.boot | 29 | ||||
| -rw-r--r-- | src/interp/clam.boot | 1 |
3 files changed, 29 insertions, 6 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 9dccb36a..b032d3f6 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2008-03-30 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/buildom.boot: Cache constructor instantiations. + * interp/clam.boot (haddProp): Update comment. + 2008-03-29 Gabriel Dos Reis <gdr@cs.tamu.edu> Fix SF/1849435. diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index a78a281b..d696b2bc 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -81,11 +81,17 @@ oldSlotCode: %Short -> %Short oldSlotCode n == 2 * ($FirstParamSlot + n) + Record0 args == + srcArgs := [[":",first a, devaluate rest a] for a in args] + -- if we already have this instantiation in store, just hand it back. + t := lassocShiftWithFunction(srcArgs, + HGET($ConstructorCache,"Record"), "domainEqualList") => + CDRwithIncrement t nargs := #args dom := newShell(nargs + 10) -- JHD added an extra slot to cache EQUAL methods - dom.0 := ["Record", :[[":", first a, devaluate rest a] for a in args]] + dom.0 := ["Record", :srcArgs] dom.1 := ["lookupInTable",dom, [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]], @@ -103,6 +109,8 @@ Record0 args == dom.($FirstParamSlot + nargs + 3) := if nargs <= 2 then [NIL,:NIL] else newShell nargs + -- remember this instantiation for future re-use. + haddProp($ConstructorCache,"Record",srcArgs,[1,:dom]) dom RecordEqual(x,y,dom) == @@ -151,10 +159,13 @@ coerceRe2E(x,source) == -- Want to eventually have the coerce to and from branch types. Union(:args) == + srcArgs := [(a is [":",tag,d] => [":",tag,devaluate d]; devaluate a) + for a in args] + t := lassocShiftWithFunction(srcArgs,HGET($ConstructorCache,"Union"), + "domainEqualList") => CDRwithIncrement t nargs := #args dom := newShell (nargs + 9) - dom.0 := ["Union", :[(if a is [":",tag,domval] then [":",tag,devaluate domval] - else devaluate a) for a in args]] + dom.0 := ["Union", :srcArgs] dom.1 := ["lookupInTable",dom, [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]], @@ -168,6 +179,7 @@ Union(:args) == dom.($FirstParamSlot + nargs) := [function UnionEqual, :dom] dom.($FirstParamSlot + nargs + 1) := [function UnionPrint, :dom] dom.($FirstParamSlot + nargs + 2) := [function Undef, :dom] + haddProp($ConstructorCache,"Union",srcArgs,[1,:dom]) dom UnionEqual(x, y, dom) == @@ -205,9 +217,12 @@ coerceUn2E(x,source) == -- Want to eventually have elt: ($, args) -> target Mapping(:args) == + srcArgs := [devaluate a for a in args] + t := lassocShiftWithFunction(srcArgs,HGET($ConstructorCache,"Mapping"), + "domainEqualList") => CDRwithIncrement t nargs := #args dom := newShell(nargs + 9) - dom.0 := ["Mapping", :[devaluate a for a in args]] + dom.0 := ["Mapping", :srcArgs] dom.1 := ["lookupInTable",dom, [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]], @@ -221,6 +236,7 @@ Mapping(:args) == dom.($FirstParamSlot + nargs) := [function MappingEqual, :dom] dom.($FirstParamSlot + nargs + 1) := [function MappingPrint, :dom] dom.($FirstParamSlot + nargs + 2) := [function Undef, :dom] + haddProp($ConstructorCache,"Mapping",srcArgs,[1,:dom]) dom MappingEqual(x, y, dom) == EQ(x,y) @@ -236,7 +252,9 @@ coerceMap2E(x) == --% Enumeration Enumeration(:"args") == - nargs := #nargs + t := lassocShiftWithFunction(args,HGET($ConstructorCache,"Enumeration"), + "domainEqualList") => CDRwithIncrement t + nargs := #args dom := newShell(nargs + 9) -- JHD added an extra slot to cache EQUAL methods dom.0 := ["Enumeration", :args] @@ -255,6 +273,7 @@ Enumeration(:"args") == dom.($FirstParamSlot + nargs) := [function EnumEqual, :dom] dom.($FirstParamSlot + nargs + 1) := [function createEnum, :dom] dom.($FirstParamSlot + nargs + 2) := [function EnumPrint, :dom] + haddProp($ConstructorCache,"Enumeration",args,[1,:dom]) dom EnumEqual(e1,e2,dom) == diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 0f6b17d4..ff119529 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -522,7 +522,6 @@ addToConstructorCache(op,args,value) == ['haddProp,'$ConstructorCache,MKQ op,args,['CONS,1,value]] haddProp(ht,op,prop,val) == - --called inside functors (except for union and record types ??) --presently, ht always = $ConstructorCache statRecordInstantiationEvent() if $reportInstantiations = true or $reportEachInstantiation = true then |