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/pickle-util.sml
ViewVC logotype

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

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

revision 568, Tue Mar 7 03:59:09 2000 UTC revision 569, Tue Mar 7 04:01:07 2000 UTC
# Line 131  Line 131 
131              end              end
132          end)          end)
133    
134        structure PM = IntRedBlackMap
135    
136      datatype pre_result =      datatype pre_result =
137          STRING of string          STRING of string
138        | CONCAT of pre_result * pre_result        | CONCAT of pre_result * pre_result
# Line 143  Line 145 
145      val nullbytes = STRING ""      val nullbytes = STRING ""
146    
147      type hcm = id HCM.map      type hcm = id HCM.map
148      type 'ahm state = hcm * 'ahm * pos      type fwdm = id PM.map               (* forwarding map *)
149        type 'ahm state = hcm * fwdm * 'ahm * pos
150    
151      type 'ahm pickle = 'ahm state -> codes * pre_result * 'ahm state      type 'ahm pickle = 'ahm state -> codes * pre_result * 'ahm state
152      type ('ahm, 'v) pickler = 'v -> 'ahm pickle      type ('ahm, 'v) pickler = 'v -> 'ahm pickle
# Line 191  Line 194 
194      val int32_encode = largeint_encode o Int32.toLarge      val int32_encode = largeint_encode o Int32.toLarge
195      val int_encode = largeint_encode o Int.toLarge      val int_encode = largeint_encode o Int.toLarge
196    
197      fun % ti c (hcm, ahm, next) = let      fun % ti c (hcm, fwdm, ahm, next) = let
198          val key = (c, ti, [])          val key = (c, ti, [])
199      in      in
200          case HCM.find (hcm, key) of          case HCM.find (hcm, key) of
201              SOME i => ([i], STRING c, (hcm, ahm, next + size c))              SOME i => ([i], STRING c, (hcm, PM.insert (fwdm, next, i),
202                                           ahm, next + size c))
203            | NONE => ([next], STRING c,            | NONE => ([next], STRING c,
204                       (HCM.insert (hcm, key, next), ahm, next + size c))                       (HCM.insert (hcm, key, next), fwdm, ahm, next + size c))
205      end      end
206    
207      fun dollar ti (c, []) state = % ti c state      fun dollar ti (c, []) state = % ti c state
208        | dollar ti (c, plh :: plt) (hcm, ahm, next) = let        | dollar ti (c, plh :: plt) (hcm, fwdm, ahm, next) = let
209              val p = collapse (plh, plt)              val p = collapse (plh, plt)
210              val (codes, pr, (hcm', ahm', next')) = p (hcm, ahm, next + size c)              val (codes, pr, (hcm', fwdm', ahm', next')) =
211                    p (hcm, fwdm, ahm, next + size c)
212              val key = (c, ti, codes)              val key = (c, ti, codes)
213          in          in
214              case HCM.find (hcm, key) of              case HCM.find (hcm, key) of
# Line 211  Line 216 
216                      val brnum = int_encode i                      val brnum = int_encode i
217                  in                  in
218                      ([i], CONCAT (backref, STRING brnum),                      ([i], CONCAT (backref, STRING brnum),
219                       (hcm, ahm, next + size_backref + size brnum))                       (hcm, PM.insert (fwdm, next, i),
220                          ahm, next + size_backref + size brnum))
221                  end                  end
222                | NONE =>                | NONE =>
223                  ([next], CONCAT (STRING c, pr),                  ([next], CONCAT (STRING c, pr),
224                   (HCM.insert (hcm', key, next), ahm', next'))                   (HCM.insert (hcm', key, next), fwdm', ahm', next'))
225          end          end
226    
227      fun ah_share { find, insert } w v (hcm, ahm, next) =      fun ah_share { find, insert } w v (hcm, fwdm, ahm, next) =
228          case find (ahm, v) of          case find (ahm, v) of
229              SOME i => let              SOME i0 => let
230                    val i = getOpt (PM.find (fwdm, i0), i0)
231                  val brnum = int_encode i                  val brnum = int_encode i
232              in              in
233                  ([i], CONCAT (backref, STRING brnum),                  ([i], CONCAT (backref, STRING brnum),
234                   (hcm, ahm, next + size_backref + size brnum))                   (hcm, fwdm, ahm, next + size_backref + size brnum))
235              end              end
236            | NONE => w v (hcm, insert (ahm, v, next), next)            | NONE => w v (hcm, fwdm, insert (ahm, v, next), next)
237    
238      fun w_lazy w thunk (hcm, ahm, next) = let      fun w_lazy w thunk (hcm, fwdm, ahm, next) = let
239          val v = thunk ()          val v = thunk ()
240          (* The larger the value of trialStart, the smaller the chance that          (* The larger the value of trialStart, the smaller the chance that
241           * the loop (see below) will run more than once.  However, some           * the loop (see below) will run more than once.  However, some
# Line 239  Line 246 
246           * encoding of the thunk's value, but that encoding depends           * encoding of the thunk's value, but that encoding depends
247           * on the length (or rather: on the length of the length). *)           * on the length (or rather: on the length of the length). *)
248          fun loop (nxt, ilen) = let          fun loop (nxt, ilen) = let
249              val (codes, pr, state) = w v (hcm, ahm, nxt)              val (codes, pr, state) = w v (hcm, fwdm, ahm, nxt)
250              val sz = pre_size pr              val sz = pre_size pr
251              val ie = int_encode sz              val ie = int_encode sz
252              val iesz = size ie              val iesz = size ie
# Line 365  Line 372 
372          end          end
373      in      in
374          fun pickle emptyMap p = let          fun pickle emptyMap p = let
375              val (_, pr, _) = p (HCM.empty, emptyMap, 0)              val (_, pr, _) = p (HCM.empty, PM.empty, emptyMap, 0)
376          in          in
377               pr2s pr               pr2s pr
378          end          end
# Line 374  Line 381 
381      type ('b_ahm, 'a_ahm) map_lifter =      type ('b_ahm, 'a_ahm) map_lifter =
382          { extract: 'a_ahm -> 'b_ahm, patchback: 'a_ahm * 'b_ahm -> 'a_ahm }          { extract: 'a_ahm -> 'b_ahm, patchback: 'a_ahm * 'b_ahm -> 'a_ahm }
383    
384      fun lift_pickler { extract, patchback } wb b (hcm, a_ahm, next) = let      fun lift_pickler { extract, patchback } wb b (hcm, fwdm, a_ahm, next) = let
385          val b_ahm = extract a_ahm          val b_ahm = extract a_ahm
386          val (codes, pr, (hcm', b_ahm', next')) = wb b (hcm, b_ahm, next)          val (codes, pr, (hcm', fwdm', b_ahm', next')) =
387                wb b (hcm, fwdm, b_ahm, next)
388          val a_ahm' = patchback (a_ahm, b_ahm')          val a_ahm' = patchback (a_ahm, b_ahm')
389      in      in
390          (codes, pr, (hcm', a_ahm', next'))          (codes, pr, (hcm', fwdm', a_ahm', next'))
391      end      end
392    
393      (* for export *)      (* for export *)

Legend:
Removed from v.568  
changed lines
  Added in v.569

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