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/cml/src/IO/new-bin-io-fn.sml
ViewVC logotype

Diff of /sml/trunk/src/cml/src/IO/new-bin-io-fn.sml

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

revision 1380, Wed Sep 17 20:20:51 2003 UTC revision 1381, Wed Sep 17 21:28:41 2003 UTC
# Line 10  Line 10 
10      structure OSPrimIO : OS_PRIM_IO      structure OSPrimIO : OS_PRIM_IO
11        where type PrimIO.array = BinPrimIO.array        where type PrimIO.array = BinPrimIO.array
12        where type PrimIO.vector = BinPrimIO.vector        where type PrimIO.vector = BinPrimIO.vector
13          where type PrimIO.array_slice = BinPrimIO.array_slice
14          where type PrimIO.vector_slice = BinPrimIO.vector_slice
15        where type PrimIO.elem = BinPrimIO.elem        where type PrimIO.elem = BinPrimIO.elem
16        where type PrimIO.pos = BinPrimIO.pos        where type PrimIO.pos = BinPrimIO.pos
17        where type PrimIO.reader = BinPrimIO.reader        where type PrimIO.reader = BinPrimIO.reader
# Line 455  Line 457 
457              closed : bool ref,              closed : bool ref,
458              bufferMode : IO.buffer_mode ref,              bufferMode : IO.buffer_mode ref,
459              writer : writer,              writer : writer,
460              writeArr : {buf : A.array, i : int, sz : int option} -> unit,              writeArr : AS.slice -> unit,
461              writeVec : {buf : V.vector, i : int, sz : int option} -> unit,              writeVec : VS.slice -> unit,
462              cleanTag : CleanIO.tag              cleanTag : CleanIO.tag
463            }            }
464    
# Line 477  Line 479 
479                case !pos                case !pos
480                 of 0 => ()                 of 0 => ()
481                  | n => ((                  | n => ((
482                      writeArr {buf=buf, i=0, sz=SOME n}; pos := 0)                      writeArr (AS.slice (buf, 0, SOME n)); pos := 0)
483                        handle ex => (                        handle ex => (
484                          SV.mPut(strmMV, strm); outputExn (strm, mlOp, ex)))                          SV.mPut(strmMV, strm); outputExn (strm, mlOp, ex)))
485                (* end case *))                (* end case *))
# Line 487  Line 489 
489                fun release () = SV.mPut (strmMV, strm)                fun release () = SV.mPut (strmMV, strm)
490                val {buf, pos, bufferMode, ...} = os                val {buf, pos, bufferMode, ...} = os
491                fun flush () = flushBuffer (strmMV, strm, "output")                fun flush () = flushBuffer (strmMV, strm, "output")
492                fun flushAll () = (#writeArr os {buf=buf, i=0, sz=NONE}                fun flushAll () = (#writeArr os (AS.full buf)
493                      handle ex => (release(); outputExn (strm, "output", ex)))                      handle ex => (release(); outputExn (strm, "output", ex)))
494                fun writeDirect () = (                fun writeDirect () = (
495                      case !pos                      case !pos
496                       of 0 => ()                       of 0 => ()
497                        | n => (#writeArr os {buf=buf, i=0, sz=SOME n}; pos := 0)                        | n => (#writeArr os (AS.slice (buf, 0, SOME n)); pos := 0)
498                      (* end case *);                      (* end case *);
499                      #writeVec os {buf=v, i=0, sz=NONE})                      #writeVec os (VS.full v))
500                        handle ex => (release(); outputExn (strm, "output", ex))                        handle ex => (release(); outputExn (strm, "output", ex))
501                fun insert copyVec = let                fun insert copyVec = let
502                      val bufLen = A.length buf                      val bufLen = A.length buf
# Line 541  Line 543 
543                  case !bufferMode                  case !bufferMode
544                   of IO.NO_BUF => (                   of IO.NO_BUF => (
545                        arrUpdate (buf, 0, elem);                        arrUpdate (buf, 0, elem);
546                        writeArr {buf=buf, i=0, sz=SOME 1}                        writeArr (AS.slice (buf, 0, SOME 1))
547                          handle ex => (release(); outputExn (strm, "output1", ex)))                          handle ex => (release(); outputExn (strm, "output1", ex)))
548                    | _ => let val i = !pos val i' = i+1                    | _ => let val i = !pos val i' = i+1
549                        in                        in
# Line 576  Line 578 
578                end                end
579    
580          fun mkOutstream (wr as PIO.WR{chunkSize, writeArr, writeVec, ...}, mode) =          fun mkOutstream (wr as PIO.WR{chunkSize, writeArr, writeVec, ...}, mode) =
581                let                let fun iterate (f, size, subslice) = let
582                fun iterate f (buf, i, sz) = let                        fun lp sl =
583                      fun lp (_, 0) = ()                            if size sl = 0 then ()
584                        | lp (i, n) = let val n' = f{buf=buf, i=i, sz=SOME n}                            else let val n = f sl
                           in lp (i+n', n-n') end  
                     in  
                       lp (i, sz)  
                     end  
               fun writeArr' {buf, i, sz} = let  
                     val len = (case sz  
                            of NONE => A.length buf - i  
                             | (SOME n) => n  
                           (* end case *))  
585                      in                      in
586                        iterate writeArr (buf, i, len)                                     lp (subslice (sl, n, NONE))
587                      end                      end
               fun writeVec' {buf, i, sz} = let  
                     val len = (case sz  
                            of NONE => V.length buf - i  
                             | (SOME n) => n  
                           (* end case *))  
588                      in                      in
589                        iterate writeVec (buf, i, len)                        lp
590                      end                      end
591                  val writeArr' = iterate (writeArr, AS.length, AS.subslice)
592                  val writeVec' = iterate (writeVec, VS.length, VS.subslice)
593              (* install a dummy cleaner *)              (* install a dummy cleaner *)
594                val tag = CleanIO.addCleaner dummyCleaner                val tag = CleanIO.addCleaner dummyCleaner
595                val strm = SV.mVarInit (OSTRM{                val strm = SV.mVarInit (OSTRM{

Legend:
Removed from v.1380  
changed lines
  Added in v.1381

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