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/trunk/src/ml-nlffi-lib/internals/zstring.sml
ViewVC logotype

Annotation of /sml/trunk/src/ml-nlffi-lib/internals/zstring.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 828 - (view) (download)

1 : blume 828 (* dealing with C's 0-terminated strings *)
2 :     structure ZString : sig
3 :    
4 :     type 'c zstring = (C.uchar, unit, 'c) C.ptr
5 :     type 'c zstring' = (C.uchar, unit, 'c) C.ptr'
6 :    
7 :     (* the C strlen function *)
8 :     val length : 'c zstring -> int
9 :     val length' : 'c zstring' -> int
10 :    
11 :     (* make ML string from 0-terminated C string *)
12 :     val toML : 'c zstring -> string
13 :     val toML' : 'c zstring' -> string
14 :    
15 :     (* Copy contents of ML string into C string and add terminating 0. *)
16 :     val cpML : { from: string, to: C.rw zstring } -> unit
17 :     val cpML' : { from: string, to: C.rw zstring' } -> unit
18 :    
19 :     (* Make C-duplicate of ML string (allocate memory and then copy). *)
20 :     val dupML : string -> C.rw zstring option
21 :     val dupML' : string -> C.rw zstring' option
22 :     end = struct
23 :    
24 :     local
25 :     open C
26 :     fun get' p = Cvt.ml_uchar (Get.uchar' (Ptr.|*! p))
27 :     fun set' (p, w) = Set.uchar' (Ptr.|*! p, Cvt.c_uchar w)
28 :     fun nxt' p = Ptr.|+! S.uchar (p, 1)
29 :     in
30 :     type 'c zstring = (uchar, unit, 'c) ptr
31 :     type 'c zstring' = (uchar, unit, 'c) ptr'
32 :    
33 :     fun length' p = let
34 :     fun loop (n, p) = if get' p = 0w0 then n else loop (n + 1, nxt' p)
35 :     in
36 :     loop (0, p)
37 :     end
38 :     fun length p = length' (Light.ptr p)
39 :    
40 :     fun toML' p = let
41 :     fun loop (l, p) =
42 :     case get' p of
43 :     0w0 => String.implode (rev l)
44 :     | c => loop (Char.chr (Word32.toInt c) :: l, nxt' p)
45 :     in
46 :     loop ([], p)
47 :     end
48 :     fun toML p = toML' (Light.ptr p)
49 :    
50 :     fun cpML' { from, to } = let
51 :     val n = String.size from
52 :     fun loop (i, p) =
53 :     if i >= n then set' (p, 0w0)
54 :     else (set' (p, Word32.fromInt (Char.ord
55 :     (String.sub (from, i))));
56 :     loop (i+1, nxt' p))
57 :     in
58 :     loop (0, to)
59 :     end
60 :     fun cpML { from, to } = cpML' { from = from, to = Light.ptr to }
61 :    
62 :     fun dupML' s =
63 :     Option.map (fn z => (cpML' { from = s, to = z }; z))
64 :     (C.alloc'' C.S.uchar (Word.fromInt (size s + 1)))
65 :     fun dupML s =
66 :     Option.map (fn z => (cpML { from = s, to = z }; z))
67 :     (C.alloc C.T.uchar (Word.fromInt (size s + 1)))
68 :     end
69 :     end

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