| 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 |