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

SCM Repository

[smlnj] Annotation of /sml/branches/rt-transition/system/Basis/Implementation/IO/text-prim-io.sml
ViewVC logotype

Annotation of /sml/branches/rt-transition/system/Basis/Implementation/IO/text-prim-io.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2849 - (view) (download)

1 : monnier 416 (* text-prim-io.sml
2 :     *
3 : jhr 2849 * COPYRIGHT (c) 2007 Fellowship of SML/NJ
4 : monnier 416 *
5 :     *)
6 :    
7 : jhr 2849 structure TextPrimIO : TEXT_PRIM_IO =
8 :     struct
9 : monnier 416
10 : jhr 2849 local
11 :     structure PIO = PrimIO (
12 :     structure Vector = CharVector
13 :     structure Array = CharArray
14 :     structure VectorSlice = CharVectorSlice
15 :     structure ArraySlice = CharArraySlice
16 :     val someElem = #"\000"
17 :     type pos = Position.int
18 :     val compare = PositionImp.compare)
19 :     in
20 :     open PIO
21 :     end (* local *)
22 : monnier 416
23 : jhr 2849 val defaultBufferSize = 4096
24 :    
25 :     fun checkClosed closed =
26 :     if !closed then raise IO.ClosedStream else ()
27 :    
28 :     fun mkReader { fd = rfd as OS.IO.IODesc fd, name, chunkSize } = let
29 :     val isReg = (SMLBasis.ioDescKind fd = SMLBasis.IOD_KIND_FILE)
30 :     val chunkSize = getOpt (chunkSize, defaultBufferSize)
31 :     val closed = ref false
32 :     fun readVec i = let
33 :     val _ = checkClosed closed
34 :     val vopt = SMLBasis.readTextVec (false, fd, i)
35 :     val v = case vopt of SOME v => v | NONE => CharVector.fromList []
36 :     in
37 :     v
38 :     end
39 :     fun readVecNB i = let
40 :     val _ = checkClosed closed
41 :     val vopt = SMLBasis.readTextVec (true, fd, i)
42 :     in
43 :     vopt
44 :     end
45 :     fun readArr asl = let
46 :     val _ = checkClosed closed
47 :     val (buf, i, sz) = CharArraySlice.base asl
48 :     val n = SMLBasis.readTextArr (false, fd, buf, i, sz)
49 :     in
50 :     n
51 :     end
52 :     fun readArrNB asl = let
53 :     val _ = checkClosed closed
54 :     val (buf, i, sz) = CharArraySlice.base asl
55 :     val n = SMLBasis.readTextArr (true, fd, buf, i, sz)
56 :     in
57 :     if n < 0 then NONE else SOME n
58 :     end
59 :     fun avail () = if !closed then SOME 0 else NONE
60 :     fun close () =
61 :     if !closed then ()
62 :     else (closed := true; SMLBasis.closeFile fd)
63 :     in
64 :     RD { name = name,
65 :     chunkSize = chunkSize,
66 :     readVec = SOME readVec,
67 :     readArr = SOME readArr,
68 :     readVecNB = SOME readVecNB,
69 :     readArrNB = SOME readArrNB,
70 :     block = NONE,
71 :     canInput = NONE,
72 :     avail = avail,
73 :     getPos = NONE,
74 :     setPos = NONE,
75 :     endPos = NONE,
76 :     verifyPos = NONE,
77 :     close = close,
78 :     ioDesc = SOME rfd }
79 :     end
80 :    
81 :     fun mkWriter { fd = rfd as OS.IO.IODesc fd, name, chunkSize } = let
82 :     val isReg = (SMLBasis.ioDescKind fd = SMLBasis.IOD_KIND_FILE)
83 :     val chunkSize = getOpt (chunkSize, defaultBufferSize)
84 :     val closed = ref false
85 :     fun writeVec vsl =
86 :     let val _ = checkClosed closed
87 :     val (buf, i, sz) = CharVectorSlice.base vsl
88 :     in
89 :     SMLBasis.writeTextVec (false, fd, buf, i, sz)
90 :     end
91 :     fun writeArr asl =
92 :     let val _ = checkClosed closed
93 :     val (buf, i, sz) = CharArraySlice.base asl
94 :     in
95 :     SMLBasis.writeTextArr (false, fd, buf, i, sz)
96 :     end
97 :     fun writeVecNB vsl =
98 :     let val _ = checkClosed closed
99 :     val (buf, i, sz) = CharVectorSlice.base vsl
100 :     val n = SMLBasis.writeTextVec (true, fd, buf, i, sz)
101 :     in
102 :     if n < 0 then NONE else SOME n
103 :     end
104 :     fun writeArrNB asl =
105 :     let val _ = checkClosed closed
106 :     val (buf, i, sz) = CharArraySlice.base asl
107 :     val n = SMLBasis.writeTextArr (true, fd, buf, i, sz)
108 :     in
109 :     if n < 0 then NONE else SOME n
110 :     end
111 :     fun close () =
112 :     if !closed then ()
113 :     else (closed := true; SMLBasis.closeFile fd)
114 :     in
115 :     WR { name = name,
116 :     chunkSize = chunkSize,
117 :     writeVec = SOME writeVec,
118 :     writeArr = SOME writeArr,
119 :     writeVecNB = SOME writeVecNB,
120 :     writeArrNB = SOME writeArrNB,
121 :     block = NONE,
122 :     canOutput = NONE,
123 :     getPos = NONE,
124 :     setPos = NONE,
125 :     endPos = NONE,
126 :     verifyPos = NONE,
127 :     ioDesc = SOME rfd,
128 :     close = close }
129 :     end
130 :    
131 :     local
132 :     open SMLBasis
133 :     (* are these right ? *)
134 :     val openRdFlags = OPEN_RD
135 :     val openWrFlags = OPEN_WR + OPEN_CREATE + OPEN_TRUNC
136 :     val openAppFlags = OPEN_WR + OPEN_CREATE + OPEN_APPEND
137 :     val D = OS.IO.IODesc
138 :     in
139 :     fun openRd fname =
140 :     mkReader { fd = D (openFile (fname, openRdFlags)),
141 :     name = fname,
142 :     chunkSize = NONE }
143 :    
144 :     fun openWr fname =
145 :     mkWriter { fd = D (openFile (fname, openWrFlags)),
146 :     name = fname,
147 :     chunkSize = NONE }
148 :    
149 :     fun openApp fname =
150 :     mkWriter { fd = D (openFile (fname, openAppFlags)),
151 :     name = fname,
152 :     chunkSize = NONE }
153 :     fun stdIn () =
154 :     mkReader { fd = D (SMLBasis.getStdIn ()),
155 :     name = "<stdin>",
156 :     chunkSize = NONE }
157 :     fun stdOut () =
158 :     mkWriter { fd = D (SMLBasis.getStdOut ()),
159 :     name = "<stdout>",
160 :     chunkSize = NONE }
161 :     fun stdErr () =
162 :     mkWriter { fd = D (SMLBasis.getStdErr ()),
163 :     name = "<stderr>",
164 :     chunkSize = NONE }
165 :     end (* local *)
166 :    
167 :     val strReader = openVector
168 :    
169 :     end

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