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/getset.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1029 - (view) (download)

1 : blume 1029 (*
2 :     * Getter and setter functions for primitive C types, using ML-side
3 :     * representation types for convenience.
4 :     *
5 :     * (C) 2002, Lucent Technologies, Bell Laboratories
6 :     *
7 :     * author: Matthias Blume
8 :     *)
9 :     structure CGetSet : C_GETSET = struct
10 :    
11 :     (* "fetch" methods for various types;
12 :     * fetching does not care about constness *)
13 :     structure Get = struct
14 :    
15 :     (* primitive types *)
16 :     fun schar x = C.Cvt.ml_schar (C.Get.schar x)
17 :     fun uchar x = C.Cvt.ml_uchar (C.Get.uchar x)
18 :     fun sint x = C.Cvt.ml_sint (C.Get.sint x)
19 :     fun uint x = C.Cvt.ml_uint (C.Get.uint x)
20 :     fun sshort x = C.Cvt.ml_sshort (C.Get.sshort x)
21 :     fun ushort x = C.Cvt.ml_ushort (C.Get.ushort x)
22 :     fun slong x = C.Cvt.ml_slong (C.Get.slong x)
23 :     fun ulong x = C.Cvt.ml_ulong (C.Get.ulong x)
24 :     fun float x = C.Cvt.ml_float (C.Get.float x)
25 :     fun double x = C.Cvt.ml_double (C.Get.double x)
26 :    
27 :     (* alt *)
28 :     fun schar' x = C.Cvt.ml_schar (C.Get.schar' x)
29 :     fun uchar' x = C.Cvt.ml_uchar (C.Get.uchar' x)
30 :     fun sint' x = C.Cvt.ml_sint (C.Get.sint' x)
31 :     fun uint' x = C.Cvt.ml_uint (C.Get.uint' x)
32 :     fun sshort' x = C.Cvt.ml_sshort (C.Get.sshort' x)
33 :     fun ushort' x = C.Cvt.ml_ushort (C.Get.ushort' x)
34 :     fun slong' x = C.Cvt.ml_slong (C.Get.slong' x)
35 :     fun ulong' x = C.Cvt.ml_ulong (C.Get.ulong' x)
36 :     fun float' x = C.Cvt.ml_float (C.Get.float' x)
37 :     fun double' x = C.Cvt.ml_double (C.Get.double' x)
38 :    
39 :     (* bitfields *)
40 :     fun sbf x = C.Cvt.ml_sint (C.Get.sbf x)
41 :     fun ubf x = C.Cvt.ml_uint (C.Get.ubf x)
42 :     end
43 :    
44 :     (* "store" methods; these require rw objects *)
45 :     structure Set = struct
46 :     local
47 :     infix $
48 :     fun (f $ g) (x, y) = f (x, g y)
49 :     in
50 :     (* primitive types *)
51 :     val schar = C.Set.schar $ C.Cvt.c_schar
52 :     val uchar = C.Set.uchar $ C.Cvt.c_uchar
53 :     val sint = C.Set.sint $ C.Cvt.c_sint
54 :     val uint = C.Set.uint $ C.Cvt.c_uint
55 :     val sshort = C.Set.sshort $ C.Cvt.c_sshort
56 :     val ushort = C.Set.ushort $ C.Cvt.c_ushort
57 :     val slong = C.Set.slong $ C.Cvt.c_slong
58 :     val ulong = C.Set.ulong $ C.Cvt.c_ulong
59 :     val float = C.Set.float $ C.Cvt.c_float
60 :     val double = C.Set.double $ C.Cvt.c_double
61 :    
62 :     (* alt *)
63 :     val schar' = C.Set.schar' $ C.Cvt.c_schar
64 :     val uchar' = C.Set.uchar' $ C.Cvt.c_uchar
65 :     val sint' = C.Set.sint' $ C.Cvt.c_sint
66 :     val uint' = C.Set.uint' $ C.Cvt.c_uint
67 :     val sshort' = C.Set.sshort' $ C.Cvt.c_sshort
68 :     val ushort' = C.Set.ushort' $ C.Cvt.c_ushort
69 :     val slong' = C.Set.slong' $ C.Cvt.c_slong
70 :     val ulong' = C.Set.ulong' $ C.Cvt.c_ulong
71 :     val float' = C.Set.float' $ C.Cvt.c_float
72 :     val double' = C.Set.double' $ C.Cvt.c_double
73 :    
74 :     (* bitfields *)
75 :     val sbf = C.Set.sbf $ C.Cvt.c_sint
76 :     val ubf = C.Set.ubf $ C.Cvt.c_uint
77 :     end
78 :     end
79 :     end

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