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/cm/smlfile/skel-io.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/smlfile/skel-io.sml

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

revision 383, Tue Jul 20 06:05:56 1999 UTC revision 384, Wed Jul 21 08:54:00 1999 UTC
# Line 16  Line 16 
16      structure SS = SymbolSet      structure SS = SymbolSet
17      structure S = Symbol      structure S = Symbol
18      structure SP = GenericVC.SymPath      structure SP = GenericVC.SymPath
19        structure PU = PickleUtil
20        structure UU = UnpickleUtil
21    
22      exception FormatError      infix 3 $
23        infixr 4 &
24        val op & = PU.&
25        val % = PU.%
26    
27        exception Format = UU.Format
28    
29      val s2b = Byte.stringToBytes      val s2b = Byte.stringToBytes
30      val b2c = Byte.byteToChar      val b2c = Byte.byteToChar
31    
32      val version = "Skeleton 1\n"      val version = "Skeleton 2\n"
33    
34      fun makeset l = SS.addList (SS.empty, l)      fun makeset l = SS.addList (SS.empty, l)
35    
# Line 37  Line 44 
44          loop []          loop []
45      end      end
46    
     (* We are consing up the whole output as a list of strings  
      * before concatenating it to form the final result and  
      * writing it out using one single `output' call. *)  
     fun w_name (n, r) =  
         (case S.nameSpace n of  
              S.SIGspace => "'"          (* only tyvars could start like that *)  
            | S.FCTspace => "("          (* no sym can start like that *)  
            | S.FSIGspace => ")"         (* no sym can start like that *)  
            | S.STRspace => ""           (* this should be safe now *)  
            | _ => GenericVC.ErrorMsg.impossible "SkelIO.w_name")  
          :: S.name n :: "." :: r  
   
47      fun write_decl (s, d) = let      fun write_decl (s, d) = let
48    
49          (* foldl means that last element appears first in output! *)          val symbol = PU.w_symbol
50          fun w_list w (l, r) = foldl w (";" :: r) l          val list = PU.w_list
51    
52          fun w_path (SP.SPATH p, r) = w_list w_name (p, r)          fun path (SP.SPATH p) = list symbol p
53    
54          fun w_decl (SK.Bind (name, def), r) =          fun decl arg = let
55              "b" :: w_name (name, w_modExp (def, r))              val D = 1
56            | w_decl (SK.Local (x, y), r) = "l" :: w_decl (x, w_decl (y, r))              val op $ = PU.$ D
57            | w_decl (SK.Par l, r) = "p" :: w_list w_decl (l, r)              fun d (SK.Bind (name, def)) = "a" $ symbol name & modExp def
58            | w_decl (SK.Seq l, r) = "q" :: w_list w_decl (l, r)                | d (SK.Local (x, y)) = "b" $ decl x & decl y
59            | w_decl (SK.Open d, r) = "o" :: w_modExp (d, r)                | d (SK.Par l) = "c" $ list decl l
60            | w_decl (SK.Ref s, r) = "r" :: w_list w_name (SS.listItems s, r)                | d (SK.Seq l) = "d" $ list decl l
61                  | d (SK.Open d) = "e" $ modExp d
62          and w_modExp (SK.Var p, r) = "v" :: w_path (p, r)                | d (SK.Ref s) = "f" $ list symbol (SS.listItems s)
           | w_modExp (SK.Decl d, r) = "d" :: w_list w_decl (d, r)  
           | w_modExp (SK.Let (d, m), r) =  
             "l" :: w_list w_decl (d, w_modExp (m, r))  
           | w_modExp (SK.Ign1 (m1, m2), r) =  
             "i" :: w_modExp (m1, w_modExp (m2, r))  
63      in      in
64          BinIO.output (s, s2b (concat (version :: w_decl (d, ["\n"]))))              d arg
65      end      end
66    
67      fun read_decl s = let          and modExp arg = let
68                val M = 2
69          fun rd () = Option.map b2c (BinIO.input1 s)              val op $ = PU.$ M
70                fun m (SK.Var p) = "g" $ path p
71          local                | m (SK.Decl d) = "h" $ list decl d
72              fun get (ns, first) = let                | m (SK.Let (d, e)) = "i" $ list decl d & modExp e
73                  fun loop (accu, NONE) = raise FormatError                | m (SK.Ign1 (e1, e2)) = "j" $ modExp e1 & modExp e2
                   | loop ([], SOME #".") = raise FormatError  
                   | loop (accu, SOME #".") = ns (String.implode (rev accu))  
                   | loop (accu, SOME s) = loop (s :: accu, rd ())  
74              in              in
75                  loop ([], first)              m arg
             end  
         in  
             fun r_name (SOME #"'") = get (S.sigSymbol, rd ())  
               | r_name (SOME #"(") = get (S.fctSymbol, rd ())  
               | r_name (SOME #")") = get (S.fsigSymbol, rd ())  
               | r_name first = get (S.strSymbol, first)  
76          end          end
77    
78          (* lists are written in reverse order, so a tail-recursive          val pickle = s2b (PU.pickle () (decl d))
          * reader is exactly right because it undoes the reversal *)  
         fun r_list r first = let  
             (* argument order important: side effects in arguments! *)  
             fun rl (l, SOME #";") = l  
               | rl (l, first) = rl (r first :: l, rd ())  
79          in          in
80              rl ([], first)          BinIO.output (s, Byte.stringToBytes version);
81            BinIO.output (s, pickle)
82          end          end
83    
84          fun r_path first = SP.SPATH (r_list r_name first)      fun read_decl s = let
85    
86            fun rd () =
87                case BinIO.input1 s of
88                    SOME w8 => b2c w8
89                  | NONE => raise Format
90    
91          fun r_decl (SOME #"b") = SK.Bind (r_name (rd ()), r_modExp (rd ()))          val session = UU.mkSession rd
           | r_decl (SOME #"l") = SK.Local (r_decl (rd ()), r_decl (rd ()))  
           | r_decl (SOME #"p") = SK.Par (r_list r_decl (rd ()))  
           | r_decl (SOME #"q") = SK.Seq (r_list r_decl (rd ()))  
           | r_decl (SOME #"o") = SK.Open (r_modExp (rd ()))  
           | r_decl (SOME #"r") = SK.Ref (makeset (r_list r_name (rd ())))  
           | r_decl _ = raise FormatError  
92    
93          and r_modExp (SOME #"v") = SK.Var (r_path (rd ()))          val symbol = UU.r_symbol session
94            | r_modExp (SOME #"d") = SK.Decl (r_list r_decl (rd ()))          fun list m r = UU.r_list session m r
95            | r_modExp (SOME #"l") =          fun share m f = UU.share session m f
             SK.Let (r_list r_decl (rd ()), r_modExp (rd ()))  
           | r_modExp (SOME #"i") = SK.Ign1 (r_modExp (rd ()), r_modExp (rd ()))  
           | r_modExp _ = raise FormatError  
96    
97          val firstline = inputLine s          val symbolListM = UU.mkMap ()
98          val r = if firstline = version then r_decl (rd ())          val declM = UU.mkMap ()
99                  else raise FormatError          val declListM = UU.mkMap ()
100          val nl = rd ()          val modExpM = UU.mkMap ()
101    
102            val symbollist = list symbolListM symbol
103    
104            fun path () = SP.SPATH (symbollist ())
105    
106            fun decl () = let
107                fun d #"a" = SK.Bind (symbol (), modExp ())
108                  | d #"b" = SK.Local (decl (), decl ())
109                  | d #"c" = SK.Par (decllist ())
110                  | d #"d" = SK.Seq (decllist ())
111                  | d #"e" = SK.Open (modExp ())
112                  | d #"f" = SK.Ref (makeset (symbollist ()))
113                  | d _ = raise Format
114            in
115                share declM d
116            end
117    
118            and decllist () = list declListM decl ()
119    
120            and modExp () = let
121                fun m #"g" = SK.Var (path ())
122                  | m #"h" = SK.Decl (decllist ())
123                  | m #"i" = SK.Let (decllist (), modExp ())
124                  | m #"j" = SK.Ign1 (modExp (), modExp ())
125                  | m _ = raise Format
126            in
127                share modExpM m
128            end
129      in      in
130          if nl = SOME #"\n" then r else raise FormatError          if inputLine s = version then decl () else raise Format
131      end      end
132    
133      fun read (s, ts) =      fun read (s, ts) =

Legend:
Removed from v.383  
changed lines
  Added in v.384

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