1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
(* Copyright (C) 2004-2009 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
*
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
*)
structure Control: CONTROL =
struct
structure C = Control ()
open C
val debug = control {name = "debug",
default = false,
toString = Bool.toString}
val allSU = control {name = "allSU",
default = false,
toString = Bool.toString}
val collect_enums = control {name = "collect_enums",
default = true,
toString = Bool.toString}
val cppopts = control {name = "cppopts",
default = [],
toString = List.toString (fn s => s)}
val dir = control {name = "dir",
default = "NLFFI-Generated",
toString = fn s => s}
val enum_cons = control {name = "enum_cons",
default = false,
toString = Bool.toString}
val extramembers = control {name = "extramembers",
default = [],
toString = List.toString (fn s => s)}
val gensym = control {name = "gensym",
default = "",
toString = fn s => s}
val libhandle = control {name = "libhandle",
default = "Library.libh",
toString = fn s => s}
structure Linkage =
struct
datatype t = Archive | Dynamic | Shared
val toString =
fn Archive => "archive"
| Dynamic => "dynamic"
| Shared => "shared"
end
val linkage = control {name = "linkage",
default = Linkage.Dynamic,
toString = Linkage.toString}
val match = control {name = "match",
default = fn _ => false,
toString = fn _ => "<fn>"}
val mlbfile = control {name = "mlbfile",
default = "nlffi-generated.mlb",
toString = fn s => s}
val namedargs = control {name = "namedargs",
default = false,
toString = Bool.toString}
val prefix = control {name = "prefix",
default = "",
toString = fn s => s}
structure Target =
struct
open MLton.Platform
datatype arch = datatype Arch.t
datatype os = datatype OS.t
datatype t = T of {arch: arch, os: os}
val host = T {arch = Arch.host, os = OS.host}
fun toString (T {arch, os}) =
concat [Arch.toString arch, "-", OS.toString os]
fun fromString s =
case String.split (s, #"-") of
[arch, os] =>
(case (Arch.fromString arch, OS.fromString os) of
(SOME arch, SOME os) =>
SOME (T {arch = arch, os = os})
| _ => NONE)
| _ => NONE
fun make (t as T {arch, os}) =
case (arch, os) of
(AMD64, _) => SOME {name = toString t, sizes = SizesAMD64.sizes,
endianShift = EndianLittle.shift}
| (HPPA, _) => SOME {name = toString t, sizes = SizesHPPA.sizes,
endianShift = EndianBig.shift}
| (IA64, Hurd) => SOME {name = toString t, sizes = SizesIA64.sizes,
endianShift = EndianBig.shift}
| (IA64, HPUX) => SOME {name = toString t, sizes = SizesIA64.sizes,
endianShift = EndianBig.shift}
| (IA64, Linux) => SOME {name = toString t, sizes = SizesIA64.sizes,
endianShift = EndianLittle.shift}
| (Sparc, _) => SOME {name = toString t, sizes = SizesSparc.sizes,
endianShift = EndianBig.shift}
| (PowerPC, _) => SOME {name = toString t, sizes = SizesPPC.sizes,
endianShift = EndianLittle.shift}
| (PowerPC64, _) => SOME {name = toString t,
sizes = SizesPowerPC64.sizes,
endianShift = EndianLittle.shift}
| (X86, _) => SOME {name = toString t, sizes = SizesX86.sizes,
endianShift = EndianLittle.shift}
| _ => NONE
end
val target = control {name = "target",
default = Target.make Target.host,
toString = Option.toString (fn {name, ...} => name)}
val weight = control {name = "weight",
default = {heavy = true, light = true},
toString = fn {heavy, light} =>
concat ["{heavy = ", Bool.toString heavy,
", light = ", Bool.toString light, "}"]}
val width = control {name = "width",
default = 75,
toString = Int.toString}
val defaults = setDefaults
val _ = defaults ()
end
|
