[MLton-commit] r6342
Vesa Karvonen
vesak at mlton.org
Fri Jan 18 09:32:55 PST 2008
Eliminated the use of the DataRecInfo generic from the implementation of
the pickling generic. DataRecInfo performs a simple data recursion
analysis, which was used in the pickling generic to automatically perform
an optimization similar to the {ref0} combinator described in
Type-specialized serialization with sharing.
Martin Elsman.
In Sixth Symposium on Trends in Functional Programming (TFP'05),
September 2005.
Unfortunately, the data recursion analysis is expensive and cannot
typically be constant folded by compilers. Furthermore, the optimization
allowed by the analysis is rather insignificant. It allows to avoid
creating a dummy value and to delay the insertion of the ref or array into
the pickling environment. Leaving the analysis out and just treating all
refs and arrays as potentially cyclic seems to be a better approach.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
U mltonlib/trunk/com/ssh/generic/unstable/public/value/pickle.sig
U mltonlib/trunk/com/ssh/generic/unstable/test/generic.sml
U mltonlib/trunk/com/ssh/generic/unstable/test.mlb
U mltonlib/trunk/com/ssh/generic/unstable/test.use
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2008-01-18 15:39:16 UTC (rev 6341)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2008-01-18 17:32:54 UTC (rev 6342)
@@ -357,13 +357,6 @@
sz = SOME 5}
end
- fun mutable (methods as {readProxy, readBody, writeWhole, self}) =
- if Arg.mayBeCyclic self
- then cyclic methods
- else share self (P {rd = let open I in readProxy >>= readBody end,
- wr = writeWhole,
- sz = NONE})
-
fun mkSeq (Ops.S {length, toSlice, getItem, fromList, ...})
(P {rd = aR, wr = aW, ...}) =
P {rd = let
@@ -609,44 +602,41 @@
fun op --> _ = fake "Pickle.--> unsupported"
- fun refc aT = let
- val P {rd, wr, ...} = getT aT
- val self = Arg.Open.refc ignore aT
- in
- if Arg.mayBeCyclic self
- then cyclic {readProxy = I.thunk (fn () => ref (Arg.some aT)),
+ fun refc aT =
+ case getT aT
+ of P {rd, wr, ...} =>
+ cyclic {readProxy = I.thunk (fn () => ref (Arg.some aT)),
readBody = fn r => I.map (fn v => (r := v ; r)) rd,
writeWhole = wr o !,
- self = self}
- else share self (P {rd = I.map ref rd, wr = wr o !, sz = NONE})
- end
+ self = Arg.Open.refc ignore aT}
- fun array aT = let
- val P {rd = aR, wr = aW, ...} = getT aT
- in
- mutable {readProxy = I.map (fn n => Array.array (n, Arg.some aT))
- (rd size),
- readBody = fn a => let
- open I
- fun lp i = if i = Array.length a
- then return a
- else aR >>= (fn e =>
- (Array.update (a, i, e)
- ; lp (i+1)))
- in
- lp 0
- end,
- writeWhole = fn a => let
- open O
- fun lp i =
- if i = Array.length a
- then return ()
- else aW (Array.sub (a, i)) >>= (fn () => lp (i+1))
- in
- wr size (Array.length a) >>= (fn () => lp 0)
- end,
- self = Arg.Open.array ignore aT}
- end
+ fun array aT =
+ case getT aT
+ of P {rd = aR, wr = aW, ...} =>
+ cyclic {readProxy =
+ I.map (fn n => Array.array (n, Arg.some aT))
+ (rd size),
+ readBody = fn a => let
+ open I
+ fun lp i = if i = Array.length a
+ then return a
+ else aR >>= (fn e =>
+ (Array.update (a, i, e)
+ ; lp (i+1)))
+ in
+ lp 0
+ end,
+ writeWhole = fn a => let
+ open O
+ fun lp i =
+ if i = Array.length a
+ then return ()
+ else aW (Array.sub (a, i)) >>= (fn () =>
+ lp (i+1))
+ in
+ wr size (Array.length a) >>= (fn () => lp 0)
+ end,
+ self = Arg.Open.array ignore aT}
fun list aT =
share (Arg.Open.list ignore aT) (mkSeq ListOps.ops (getT aT))
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/pickle.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/pickle.sig 2008-01-18 15:39:16 UTC (rev 6341)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/pickle.sig 2008-01-18 17:32:54 UTC (rev 6342)
@@ -42,14 +42,9 @@
* unpickling reconstructs the cycles and sharing present in the object
* that was pickled.
*
- * As an interesting statistic, the pickling generic uses no less than 6
+ * As an interesting statistic, the pickling generic uses no less than 5
* other generics:
*
- * {DataRecInfo}
- * is used to perform a simple data recursion analysis, which allows the
- * pickling generic to automatically perform a (minor) optimization
- * similar to the {ref0} combinator described in [5].
- *
* {Eq} and {Hash}
* are used in the implementation of sharing (and cycle reconstruction).
*
@@ -170,7 +165,6 @@
end
signature WITH_PICKLE_DOM = sig
- include CASES DATA_REC_INFO EQ HASH SOME TYPE_HASH TYPE_INFO
- sharing Open.Rep = DataRecInfoRep = EqRep = HashRep = SomeRep = TypeHashRep
- = TypeInfoRep
+ include CASES EQ HASH SOME TYPE_HASH TYPE_INFO
+ sharing Open.Rep = EqRep = HashRep = SomeRep = TypeHashRep = TypeInfoRep
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/generic.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/generic.sml 2008-01-18 15:39:16 UTC (rev 6341)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/generic.sml 2008-01-18 17:32:54 UTC (rev 6342)
@@ -92,21 +92,6 @@
signature Generic = sig
- include Generic DATA_REC_INFO
-end
-
-functor MkGeneric (Arg : Generic) = struct
- structure Open = MkGeneric (Arg)
- open Arg Open
- structure DataRecInfoRep = Open.Rep
-end
-
-structure Generic =
- MkGeneric (structure Open = WithDataRecInfo (Generic)
- open Generic Open)
-
-
-signature Generic = sig
include Generic SOME
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/test.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test.mlb 2008-01-18 15:39:16 UTC (rev 6341)
+++ mltonlib/trunk/com/ssh/generic/unstable/test.mlb 2008-01-18 17:32:54 UTC (rev 6342)
@@ -22,7 +22,6 @@
with/hash.sml
with/pretty.sml
with/eq.sml
- with/data-rec-info.sml
with/some.sml
with/pickle.sml
with/seq.sml
Modified: mltonlib/trunk/com/ssh/generic/unstable/test.use
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test.use 2008-01-18 15:39:16 UTC (rev 6341)
+++ mltonlib/trunk/com/ssh/generic/unstable/test.use 2008-01-18 17:32:54 UTC (rev 6342)
@@ -15,7 +15,6 @@
"with/hash.sml",
"with/pretty.sml",
"with/eq.sml",
- "with/data-rec-info.sml",
"with/some.sml",
"with/pickle.sml",
"with/seq.sml",
More information about the MLton-commit
mailing list