Import Upstream version 20180207
[hcoop/debian/mlton.git] / mlnlffigen / main.sml
1 (* Copyright (C) 2005-2008 Henry Cejtin, Matthew Fluet, Suresh
2 * Jagannathan, and Stephen Weeks.
3 *
4 * MLton is released under a BSD-style license.
5 * See the file MLton-LICENSE for details.
6 *)
7
8 structure Main : sig val main : unit -> unit end =
9 struct
10
11 structure RE =
12 RegExpFn (structure P = AwkSyntax
13 structure E = DfaEngine)
14
15 fun makeOptions {usage} =
16 let
17 open Popt Control
18 in
19 List.map
20 ([(Expert, "debug", " {false|true}", "",
21 boolRef debug),
22 (Normal, "allSU", " {false|true}",
23 "generate ML definitions for all #include-d struct and union definitions",
24 boolRef allSU),
25 (Normal, "collect", " {true|false}",
26 "collect enum constants from unnamed enumerateions",
27 boolRef collect_enums),
28 (Normal, "cppopt", " <opt>",
29 "pass option to preprocessor",
30 SpaceString (fn s => List.push (cppopts, s))),
31 (Normal, "dir", " <dir>",
32 "output directory for generated files",
33 SpaceString (fn s => dir := s)),
34 (Normal, "enum-constructors", " {false|true}",
35 "when possible, make the ML representation type of enumerations a datatype",
36 boolRef enum_cons),
37 (Normal, "gensym", " <string>",
38 "suffix for \"gensym-ed\" generated ML structure names",
39 SpaceString (fn s => gensym := s)),
40 (Normal, "heavy", "",
41 "suppress 'light' versions of function wrappers and field accessors",
42 None (fn () => weight := {heavy = true, light = false})),
43 (Normal, "include", " <file>",
44 "include file in the generated .mlb file",
45 SpaceString (fn s => List.push (extramembers, s))),
46 (Normal, "libhandle", " <longid>",
47 "Use the <longid> to refer to the handle to the shared library",
48 SpaceString (fn s => libhandle := s)),
49 (Normal, "light", "",
50 "suppress 'heavy' versions of function wrappers and field accessors",
51 None (fn () => weight := {heavy = false, light = true})),
52 (Normal, "linkage", " {archive|dynamic|shared}",
53 "how to link C objects",
54 SpaceString (fn s =>
55 if s = "archive" orelse s = "static"
56 then linkage := Linkage.Archive
57 else if s = "dynamic"
58 then linkage := Linkage.Dynamic
59 else if s = "shared"
60 then linkage := Linkage.Shared
61 else usage (concat ["invalid -linkage arg: ", s]))),
62 (Normal, "match", " <re>",
63 "generate ML definitions for #include-d definitions matching <re>",
64 SpaceString (fn re =>
65 let
66 val regexp =
67 SOME (RE.compileString re)
68 handle RegExpSyntax.CannotParse => NONE
69 | RegExpSyntax.CannotCompile => NONE
70 in
71 case regexp of
72 SOME regexp =>
73 let
74 val scanFn = RE.prefix regexp
75 fun matchFn s =
76 let
77 val n = String.length s
78 fun getc i =
79 if (i < n)
80 then SOME (String.sub (s, i), i + 1)
81 else NONE
82 in
83 case scanFn getc 0 of
84 NONE => false
85 | SOME (x, k) => k = n
86 end
87 in
88 match := matchFn
89 end
90 | NONE => usage (concat ["invalid -match arg: ", re])
91 end)),
92 (Normal, "mlbfile", " <file>",
93 "name of the generated .mlb file",
94 SpaceString (fn s => mlbfile := s)),
95 (Normal, "namedargs", " {false|true}",
96 "generate function wrappers with named arguments",
97 boolRef namedargs),
98 (Normal, "prefix", " <string>",
99 "prefix for generated ML structure names",
100 SpaceString (fn s => prefix := s)),
101 (Normal, "target", " <arch>-<os>",
102 "platform that executable will run on",
103 SpaceString (fn s =>
104 (case Target.fromString s of
105 NONE =>
106 usage (concat ["invalid -target arg: ", s])
107 | SOME t =>
108 (case Target.make t of
109 NONE => usage (concat ["unsupported -target arg: ", s])
110 | SOME z => target := SOME z)))),
111 (Normal, "width", " 75",
112 "output line width for pretty-printing",
113 intRef width)],
114 fn (style, name, arg, desc, opt) =>
115 {arg = arg, desc = desc, name = name, opt = opt, style = style})
116 end
117
118 val mainUsage = "mlnlffigen [option ...] C-file ..."
119 val {parse, usage} =
120 Popt.makeUsage {mainUsage = mainUsage,
121 makeOptions = makeOptions,
122 showExpert = fn () => !Control.debug}
123
124 val die = Process.fail
125
126 fun commandLine args =
127 let
128 val rest = parse args
129 val () = if Option.isNone (!Control.target)
130 then usage "no -target specified"
131 else ()
132 in
133 case rest of
134 Result.No msg => usage msg
135 | Result.Yes [] => usage "no C-file(s)"
136 | Result.Yes cfiles => Gen.gen {cfiles = cfiles}
137 end
138
139 val main = Process.makeMain commandLine
140
141 end