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