File: target.ml

package info (click to toggle)
ocaml-obuild 0.2.2-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 1,456 kB
  • sloc: ml: 14,491; sh: 211; ansic: 34; makefile: 11
file content (273 lines) | stat: -rw-r--r-- 9,024 bytes parent folder | download
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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
open Filepath
open Fugue
open Types
open Dependencies

module Typ = struct
  type t =
    | Lib
    | Exe
    | Test
    | Bench

  let is_lib t = t = Lib
end

exception TargetNameNoType of string
exception TargetUnknownType of string * string
exception TargetNotRecognized of string

module Name = struct
  type t =
    | Lib of Libname.t
    | Exe of string
    | Test of string
    | Bench of string
    | Example of string

  let to_string = function
    | Exe e -> "exe-" ^ e
    | Bench e -> "bench-" ^ e
    | Test e -> "test-" ^ e
    | Example e -> "example-" ^ e
    | Lib l -> "lib-" ^ Libname.to_string l

  let of_string name =
    match String_utils.split ~limit:2 '-' name with
    | [ "exe"; n ] -> Exe n
    | [ "lib"; n ] -> Lib (Libname.of_string n)
    | [ "test"; n ] -> Test n
    | [ "bench"; n ] -> Bench n
    | [ "example"; n ] -> Example n
    | [ prefix; n ] -> raise (TargetUnknownType (prefix, n))
    | [ _ ] -> raise (TargetNameNoType name)
    | _ -> raise (TargetNotRecognized name)

  let to_dirname = function
    | Exe e | Bench e | Test e | Example e -> fn e
    | Lib l -> fn ("lib-" ^ Libname.to_string l)

  let get_clibname = function
    | Exe e -> "stubs_" ^ e
    | Bench e -> "stubs_" ^ e
    | Test e -> "stubs_" ^ e
    | Example e -> "stubs_" ^ e
    | Lib l -> "stubs_" ^ list_last (Libname.to_string_nodes l)

  (* get the core name of the final object representing the object
   * for an executable/test/bench it will be the name of the executable apart from the extension
   * for a test it will be the name of the library created (.cmxa/.cma) apart from the extension
   *)
  let get_dest_name = function
    | Exe e -> e
    | Bench e -> "bench-" ^ e
    | Test e -> "test-" ^ e
    | Example e -> "example-" ^ e
    | Lib l -> String.concat "_" (Libname.to_string_nodes l)
end

type target_stdlib =
  | Stdlib_None
  | Stdlib_Standard
  | Stdlib_Core

type runtime_bool =
  | BoolConst of bool
  | BoolVariable of string

let runtime_def v = BoolConst v

type target_cbits = {
  target_cdir : filepath;
  target_csources : filename list;
  target_cflags : string list (* CFLAGS *);
  target_clibs : string list;
  target_clibpaths : filepath list;
  target_cpkgs : cdependency list (* pkg-config name *);
}

type target_obits = {
  target_srcdir : filepath list;
  target_builddeps : dependency list;
  target_oflags : string list;
  target_pp : Pp.Type.t option;
  target_extradeps : (Hier.t * Hier.t) list;
  target_stdlib : target_stdlib;
}

type target_extra = {
  target_extra_objects : string list; (* targets of those extra settings *)
  target_extra_builddeps : dependency list;
  target_extra_oflags : string list;
  target_extra_cflags : string list;
  target_extra_pp : Pp.Type.t option;
}

(* Ctypes.cstubs support: pair of functor module -> generated instance name *)
type cstubs_description = {
  cstubs_functor : Hier.t; (* User's functor module, e.g., Bindings.Types *)
  cstubs_instance : string; (* Generated instance name, e.g., Types_gen *)
}

(* Ctypes.cstubs concurrency policy *)
type cstubs_concurrency =
  | Cstubs_sequential (* Default: no special concurrency support *)
  | Cstubs_unlocked (* Release runtime lock during C calls *)
  | Cstubs_lwt_jobs (* Lwt jobs-based concurrency *)
  | Cstubs_lwt_preemptive (* Lwt preemptive threading *)

(* Ctypes.cstubs errno policy *)
type cstubs_errno =
  | Cstubs_ignore_errno (* Default: errno not accessed *)
  | Cstubs_return_errno (* Functions return (retval, errno) pairs *)

(* Ctypes.cstubs configuration for a library *)
type target_cstubs = {
  cstubs_external_library_name : string; (* Name for generated C library *)
  cstubs_type_description : cstubs_description option; (* Types functor -> instance *)
  cstubs_function_description : cstubs_description option; (* Functions functor -> instance *)
  cstubs_generated_types : string; (* Intermediate types module name *)
  cstubs_generated_entry_point : string; (* Main entry module (e.g., "C") *)
  cstubs_headers : string list; (* C headers to include *)
  cstubs_concurrency : cstubs_concurrency; (* Concurrency policy *)
  cstubs_errno : cstubs_errno; (* Errno handling policy *)
}

(* Explicit generate block for multi-input generators or overrides *)
type target_generate = {
  generate_module : Hier.t;           (* Output module name *)
  generate_from : filepath list;      (* Input file(s) *)
  generate_using : string;            (* Generator name to use *)
  generate_args : string option;      (* Additional command-line arguments *)
}

type target = {
  target_name : Name.t;
  target_type : Typ.t;
  target_cbits : target_cbits;
  target_obits : target_obits;
  target_cstubs : target_cstubs option;
  target_generates : target_generate list;
  target_extras : target_extra list;
  target_buildable : runtime_bool;
  target_installable : runtime_bool;
}

let new_target_cbits =
  {
    target_cdir = current_dir;
    target_csources = [];
    target_cflags = [];
    target_clibs = [];
    target_clibpaths = [];
    target_cpkgs = [];
  }

let new_target_obits =
  {
    target_oflags = [];
    target_builddeps = [];
    target_pp = None;
    target_srcdir = [ current_dir ];
    target_extradeps = [];
    target_stdlib = Stdlib_Standard;
  }

let new_target_cstubs =
  {
    cstubs_external_library_name = "";
    cstubs_type_description = None;
    cstubs_function_description = None;
    cstubs_generated_types = "Types_generated";
    cstubs_generated_entry_point = "C";
    cstubs_headers = [];
    cstubs_concurrency = Cstubs_sequential;
    cstubs_errno = Cstubs_ignore_errno;
  }

let new_target n ty buildable installable =
  {
    target_name = n;
    target_buildable = runtime_def buildable;
    target_installable = runtime_def installable;
    target_type = ty;
    target_extras = [];
    target_cbits = new_target_cbits;
    target_obits = new_target_obits;
    target_cstubs = None;
    target_generates = [];
  }

let new_target_extra objs =
  {
    target_extra_objects = objs;
    target_extra_builddeps = [];
    target_extra_oflags = [];
    target_extra_cflags = [];
    target_extra_pp = None;
  }

let get_target_name target = Name.to_string target.target_name
let get_target_dest_name target = Name.get_dest_name target.target_name
let get_target_clibname target = Name.get_clibname target.target_name
let is_lib target = Typ.is_lib target.target_type

let get_ocaml_compiled_types target =
  let nat, byte =
    if is_lib target then
      (Gconf.get_target_option_typed Library_native, Gconf.get_target_option_typed Library_bytecode)
    else
      (Gconf.get_target_option_typed Executable_native, Gconf.get_target_option_typed Executable_bytecode)
  in
  (if nat then [ Native ] else []) @ if byte then [ ByteCode ] else []

let get_debug_profile target =
  if is_lib target then
    (Gconf.get_target_option_typed Library_debugging, Gconf.get_target_option_typed Library_profiling)
  else
    (Gconf.get_target_option_typed Executable_debugging, Gconf.get_target_option_typed Executable_profiling)

let get_compilation_opts target =
  let debug, prof = get_debug_profile target in
  (Normal :: (if debug then [ WithDebug ] else [])) @ if prof then [ WithProf ] else []

let get_all_builddeps target =
  let targetWideDeps = target.target_obits.target_builddeps in
  let fileSpecificDeps =
    List.map (fun extra -> extra.target_extra_builddeps) target.target_extras
  in
  targetWideDeps @ List.concat fileSpecificDeps

let find_extra_matching target s =
  List.filter (fun extra -> List.mem s extra.target_extra_objects) target.target_extras

(** Register output modules from generators so they can be found during validation and build.
    Handles both suffix-based generators (e.g., atdgen) and explicit generate blocks. *)
let register_generator_outputs target =
  let generators = Generators.get_all () in
  let src_dirs = target.target_obits.target_srcdir in
  (* Register suffix-based generator outputs *)
  List.iter (fun src_dir ->
    List.iter (fun (gen : Generators.t) ->
      if gen.Generators.suffix <> "" then begin
        let suffix = gen.Generators.suffix in
        let files = Filesystem.list_dir_pred (fun f ->
          String_utils.endswith suffix (fn_to_string f)
        ) src_dir in
        List.iter (fun src_file ->
          let src_path = src_dir </> src_file in
          let base = fn_to_string (chop_extension src_file) in
          let output_file = gen.Generators.generated_files src_file base in
          let output_base = fn_to_string (chop_extension output_file) in
          let module_name = Compat.string_capitalize output_base in
          let hier = Hier.of_string module_name in
          Hier.register_generated_entry hier src_dir src_path output_file
        ) files
      end
    ) generators
  ) src_dirs;
  (* Register generate block modules *)
  List.iter (fun (gen_block : target_generate) ->
    let module_name = Hier.to_string gen_block.generate_module in
    Hier.register_generated_module module_name
  ) target.target_generates