Commit | Line | Data |
---|---|---|
7f918cf1 CE |
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 |