Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/MiscUtil/library/unpickle-util.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/MiscUtil/library/unpickle-util.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 709, Sat Oct 7 03:35:08 2000 UTC revision 710, Tue Oct 17 08:21:09 2000 UTC
# Line 19  Line 19 
19   *         fewer generated thunks that make the code run faster.)   *         fewer generated thunks that make the code run faster.)
20   *   *
21   * July 1999, Matthias Blume   * July 1999, Matthias Blume
22     *
23     * We now use the high bit in char codes of shareable nodes to indicate
24     * that actual sharing has occured.  If the high bit is not set, we do
25     * no longer bother to insert the node into its sharing map.  This
26     * improves unpickling speed (e.g., for autoloading) by about 25% and
27     * saves tons of memory.
28     *
29     * October 2000, Matthias Blume
30   *)   *)
31  signature UNPICKLE_UTIL = sig  signature UNPICKLE_UTIL = sig
32    
# Line 104  Line 112 
112      val share : session -> 'v map -> (char -> 'v) -> 'v      val share : session -> 'v map -> (char -> 'v) -> 'v
113    
114      (* If you know that you don't need a map because there can be no      (* If you know that you don't need a map because there can be no
115       * sharing (typically if you didn't use any $ but only % for pickling       * sharing, then you can use "nonshare" instead of "share". *)
      * your type), then you can use "nonshare" instead of "share". *)  
116      val nonshare : session -> (char -> 'v) -> 'v      val nonshare : session -> (char -> 'v) -> 'v
117    
118      (* making readers for some common types *)      (* making readers for some common types *)
# Line 228  Line 235 
235          ({ state = mkMap (), getter = charGetter }: session)          ({ state = mkMap (), getter = charGetter }: session)
236    
237      fun share { state, getter = { read, seek, cur } } m r = let      fun share { state, getter = { read, seek, cur } } m r = let
238            (* "firsttime" is guaranteed to be called with a character
239             * that has the high-bit set. *)
240          fun firsttime (pos, c) = let          fun firsttime (pos, c) = let
241              val v = r c              val v = r (Char.chr (Char.ord c - 128))
242              val pos' = cur ()              val pos' = cur ()
243          in          in
244              m := M.insert (!m, pos, (v, pos'));              m := M.insert (!m, pos, (v, pos'));
245              v              v
246          end          end
247            val c = read ()
248      in      in
249          case read () of          if Char.ord c < 128 then
250              #"\255" => let              (* High-bit is not set, so this is not a shared node.
251                 * Therefore, it can't possibly be in the map, and
252                 * we can call r directly. *)
253                r c
254            else if c = #"\255" then let
255                  val pos = f_int read ()                  val pos = f_int read ()
256              in              in
257                  case M.find (!m, pos) of                  case M.find (!m, pos) of
# Line 248  Line 262 
262                          seek pos;                          seek pos;
263                          (* It is ok to use "read" here because                          (* It is ok to use "read" here because
264                           * there won't be back-references that jump                           * there won't be back-references that jump
265                           * to other back-references. *)                       * to other back-references.
266                         * (Since we are jumping to something that
267                         * was shared, it has the high-bit set, so
268                         * calling "firsttime" is ok.) *)
269                          firsttime (pos, read())                          firsttime (pos, read())
270                          before seek here                          before seek here
271                      end                      end
272              end              end
273            | c => let          else let
274                  (* Must subtract one to get back in front of c. *)                  (* Must subtract one to get back in front of c. *)
275                  val pos = cur () - 1                  val pos = cur () - 1
276              in              in
# Line 354  Line 371 
371      fun r_string session () = let      fun r_string session () = let
372          val { state = m, getter } = session          val { state = m, getter } = session
373          val { read, ... } = getter          val { read, ... } = getter
374          fun rs c = let          fun rs #"\"" =
375              fun loop (l, #"\"") = String.implode (rev l)              let fun loop (l, #"\"") = String.implode (rev l)
376                | loop (l, #"\\") = loop (read () :: l, read ())                | loop (l, #"\\") = loop (read () :: l, read ())
377                | loop (l, c) = loop (c :: l, read ())                | loop (l, c) = loop (c :: l, read ())
378          in          in
379              loop ([], c)                  loop ([], read ())
380          end          end
381              | rs _ = raise Format
382      in      in
383          share session m rs          share session m rs
384      end      end

Legend:
Removed from v.709  
changed lines
  Added in v.710

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0