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 514, Thu Dec 16 08:32:57 1999 UTC revision 515, Sun Jan 9 09:59:14 2000 UTC
# Line 30  Line 30 
30      type 'ahm pickle      type 'ahm pickle
31      type ('ahm, 'v) pickler = 'v -> 'ahm pickle      type ('ahm, 'v) pickler = 'v -> 'ahm pickle
32    
     (* Combining pickles into one.  The resulting compound pickle will not  
      * automatically be subject to hash-consing.  Wrap it with $ to get  
      * that effect. *)  
     val & : 'ahm pickle * 'ahm pickle -> 'ahm pickle  
   
33      (* $ produces the pickle for one case (constructor) of a datatype.      (* $ produces the pickle for one case (constructor) of a datatype.
34       * The string must be one character long and the argument pickle       * The string must be one character long and the argument pickle
35       * should be the pickle for the constructor's arguments.  If there       * should be the pickle for the constructor's arguments.
      * are no arguments, then use % instead of $.  
36       * Use the same tinfo for all constructors of the same datatype       * Use the same tinfo for all constructors of the same datatype
37       * and different tinfos for constructors of different types.       * and different tinfos for constructors of different types.
38       *       *
# Line 56  Line 50 
50       * long.  In this case the corresponding unpickling function must       * long.  In this case the corresponding unpickling function must
51       * be sure to get all those characters out of the input stream.       * be sure to get all those characters out of the input stream.
52       * We actually do exploit this "feature" internally. *)       * We actually do exploit this "feature" internally. *)
53      val $ : tinfo -> string * 'ahm pickle -> 'ahm pickle      val $ : tinfo -> string * 'ahm pickle list -> 'ahm pickle
     val % : tinfo -> string -> 'ahm pickle  
54    
55      (* "ah_share" is used to specify potential for "ad-hoc" sharing      (* "ah_share" is used to specify potential for "ad-hoc" sharing
56       * using the user-supplied map.  It is important that ah_share is       * using the user-supplied map.
57       * applied to pickles constructed by $ or % but never to those       * Ad-hoc sharing is used to break structural
      * constructed by &.  Ad-hoc sharing is used to break structural  
58       * cycles, to identify parts of the value that the hash-conser cannot       * cycles, to identify parts of the value that the hash-conser cannot
59       * automatically identify but which should be identified nevertheless,       * automatically identify but which should be identified nevertheless,
60       * or to identify those parts that would be too expensive to be left       * or to identify those parts that would be too expensive to be left
# Line 166  Line 158 
158          (fc @ gc, CONCAT (fpr, gpr), state'')          (fc @ gc, CONCAT (fpr, gpr), state'')
159      end      end
160    
161        (* collapse a non-empty list of pickles into one *)
162        fun collapse (h, []) = h
163          | collapse (h, ht :: tt) = h & collapse (ht, tt)
164    
165      fun anyint_encode (n, negative) = let      fun anyint_encode (n, negative) = let
166          (* this is essentially the same mechanism that's also used in          (* this is essentially the same mechanism that's also used in
167           * TopLevel/batch/binfile.sml (maybe we should share it) *)           * TopLevel/batch/binfile.sml (maybe we should share it) *)
# Line 204  Line 200 
200                       (HCM.insert (hcm, key, next), ahm, next + size c))                       (HCM.insert (hcm, key, next), ahm, next + size c))
201      end      end
202    
203      fun dollar ti (c, p) (hcm, ahm, next) = let      fun dollar ti (c, []) state = % ti c state
204          | dollar ti (c, plh :: plt) (hcm, ahm, next) = let
205                val p = collapse (plh, plt)
206          val (codes, pr, (hcm', ahm', next')) = p (hcm, ahm, next + size c)          val (codes, pr, (hcm', ahm', next')) = p (hcm, ahm, next + size c)
207          val key = (c, ti, codes)          val key = (c, ti, codes)
208      in      in
# Line 290  Line 288 
288              val op $ = dollar L              val op $ = dollar L
289              fun wc [] = % L "N"              fun wc [] = % L "N"
290                | wc ((a, b, c, d, e) :: r) =                | wc ((a, b, c, d, e) :: r) =
291                  "C" $ w a & w b & w c & w d & w e & wc r                  "C" $ [w a, w b, w c, w d, w e, wc r]
292          in          in
293              case chop5 l of              case chop5 l of
294                  ([], []) => % L "0"                  ([], []) => % L "0"
295                | ([a], []) => "1" $ w a                | ([a], []) => "1" $ [w a]
296                | ([a, b], []) => "2" $ w a & w b                | ([a, b], []) => "2" $ [w a, w b]
297                | ([a, b, c], []) => "3" $ w a & w b & w c                | ([a, b, c], []) => "3" $ [w a, w b, w c]
298                | ([a, b, c, d], []) => "4" $ w a & w b & w c & w d                | ([a, b, c, d], []) => "4" $ [w a, w b, w c, w d]
299                | ([], r) => "5" $ wc r                | ([], r) => "5" $ [wc r]
300                | ([a], r) => "6" $ w a & wc r                | ([a], r) => "6" $ [w a, wc r]
301                | ([a, b], r) => "7" $ w a & w b & wc r                | ([a, b], r) => "7" $ [w a, w b, wc r]
302                | ([a, b, c], r) => "8" $ w a & w b & w c & wc r                | ([a, b, c], r) => "8" $ [w a, w b, w c, wc r]
303                | ([a, b, c, d], r) => "9" $ w a & w b & w c & w d & wc r                | ([a, b, c, d], r) => "9" $ [w a, w b, w c, w d, wc r]
304                | _ => raise Fail "PickleUtil.w_list: impossible chop"                | _ => raise Fail "PickleUtil.w_list: impossible chop"
305          end          end
306      end      end
# Line 313  Line 311 
311          fun w_option arg = let          fun w_option arg = let
312              val op $ = dollar O              val op $ = dollar O
313              fun wo w NONE = % O "n"              fun wo w NONE = % O "n"
314                | wo w (SOME i) = "s" $ w i                | wo w (SOME i) = "s" $ [w i]
315          in          in
316              wo arg              wo arg
317          end          end
318      end      end
319    
320      fun w_pair (wa, wb) (a, b) = wa a & wb b      local
321            val P = ~7
322        in
323            fun w_pair (wa, wb) (a, b) = let
324                val op $ = dollar P
325            in
326                "p" $ [wa a, wb b]
327            end
328        end
329    
330      local      local
331          val S = ~7          val S = ~8
332      in      in
333          fun w_string s = let          fun w_string s = let
334              val op $ = dollar S              val op $ = dollar S
# Line 337  Line 343 
343                | esc #"\255" = "\\\255"  (* need to escape backref char *)                | esc #"\255" = "\\\255"  (* need to escape backref char *)
344                | esc c = String.str c                | esc c = String.str c
345          in          in
346              (String.translate esc s ^ "\"") $ dummy_pickle              (String.translate esc s ^ "\"") $ [dummy_pickle]
347          end          end
348      end      end
349    
350      local      local
351          val B = ~8          val B = ~9
352      in      in
353          fun w_bool true = % B "t"          fun w_bool true = % B "t"
354            | w_bool false = % B "f"            | w_bool false = % B "f"

Legend:
Removed from v.514  
changed lines
  Added in v.515

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