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/smlnj-c/libs/binC2ML/binary-C-file.sml
ViewVC logotype

Annotation of /sml/trunk/src/smlnj-c/libs/binC2ML/binary-C-file.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 249 (* COPYRIGHT (c) 1996 Bell Laboratories, Lucent Technologies
2 :     *
3 :     * binaryC convertor
4 :     *
5 :     * this functor provides functions to convert binary C data
6 :     * (as stored in e.g. a Word8Vector) to/from structured C data
7 :     * (as used in the SML/NJ-C interface).
8 :     *)
9 :    
10 :     functor BinaryC(structure C : C_CALLS) : BINARY_C =
11 :     struct
12 :     structure W8V = Word8Vector
13 :     structure W8 = Word8
14 :    
15 :     structure C = C
16 :     open C
17 :    
18 :     val toChar = Char.chr o W8.toInt
19 :     val fromChar = W8.fromInt o Char.ord
20 :    
21 :     fun vecToCvec v =
22 :     let val len = W8V.length v
23 :     in
24 :     (Cvector(Vector.tabulate(len,
25 :     fn i => Cchar(toChar(W8V.sub(v,i))))),
26 :     CvectorT(len,CcharT))
27 :     end
28 :    
29 :     fun cVecToVec (cv,n) =
30 :     W8V.tabulate (n,fn i => let val Cchar c = Vector.sub(cv,i)
31 :     in fromChar c
32 :     end)
33 :    
34 :     fun okTypeForFile CcharT = true
35 :     | okTypeForFile CintT = true
36 :     | okTypeForFile CdoubleT = true
37 :     | okTypeForFile CfloatT = true
38 :     | okTypeForFile (CstructT l) =
39 :     foldr (fn (x,y) => y andalso (okTypeForFile x)) true l
40 :     | okTypeForFile (CarrayT(_,t)) = okTypeForFile t
41 :     | okTypeForFile (CvectorT(_,t)) = okTypeForFile t
42 :     | okTypeForFile _ = false
43 :    
44 :     exception NonFlatFileType
45 :     fun fromBits typ v =
46 :     let val _ = okTypeForFile typ orelse raise NonFlatFileType
47 :     val (v,vtype) = vecToCvec v
48 :     (* Warning: the next lines perform a cast *)
49 :     val (p,plist) = datumMLtoC (CptrT vtype) (Cptr v)
50 :     val (Cptr res) = datumCtoML (CptrT typ) p
51 :     in app free plist;
52 :     res
53 :     end
54 :    
55 :     fun toBits typ datum =
56 :     let val _ = okTypeForFile typ orelse raise NonFlatFileType
57 :     val szb = sizeof typ
58 :     (* Warning: the next lines perform a cast *)
59 :     val (p,plist) = datumMLtoC (CptrT typ) (Cptr datum)
60 :     val Cptr (Cvector res) =
61 :     datumCtoML (CptrT (CvectorT(szb,CcharT))) p
62 :     in app free plist;
63 :     cVecToVec (res,szb)
64 :     end
65 :    
66 :     end (* functor BinaryCFile *)
67 :    

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