2017-07-21 07:43:36 -07:00
|
|
|
(**************************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* OCaml *)
|
|
|
|
(* *)
|
|
|
|
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 2016 Institut National de Recherche en Informatique et *)
|
|
|
|
(* en Automatique. *)
|
|
|
|
(* *)
|
|
|
|
(* All rights reserved. This file is distributed under the terms of *)
|
|
|
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
|
|
|
(* special exception on linking described in the file LICENSE. *)
|
|
|
|
(* *)
|
|
|
|
(**************************************************************************)
|
|
|
|
|
2018-02-07 09:47:11 -08:00
|
|
|
(* Types of files involved in an OCaml project and related functions *)
|
|
|
|
|
|
|
|
type backend_specific = Object | Library | Program
|
2017-07-21 07:43:36 -07:00
|
|
|
|
|
|
|
type t =
|
|
|
|
| Implementation
|
|
|
|
| Interface
|
|
|
|
| C
|
|
|
|
| C_minus_minus
|
|
|
|
| Lexer
|
|
|
|
| Grammar
|
2018-02-07 09:47:11 -08:00
|
|
|
| Binary_interface
|
2018-04-16 06:46:41 -07:00
|
|
|
| Obj
|
2018-02-07 09:47:11 -08:00
|
|
|
| Backend_specific of Ocaml_backends.t * backend_specific
|
2018-03-05 02:09:57 -08:00
|
|
|
| Text (* used by ocamldoc for text only documentation *)
|
2018-02-07 09:47:11 -08:00
|
|
|
|
|
|
|
let string_of_backend_specific = function
|
|
|
|
| Object -> "object"
|
|
|
|
| Library -> "library"
|
|
|
|
| Program -> "program"
|
2017-07-21 07:43:36 -07:00
|
|
|
|
|
|
|
let string_of_filetype = function
|
|
|
|
| Implementation -> "implementation"
|
|
|
|
| Interface -> "interface"
|
|
|
|
| C -> "C source file"
|
|
|
|
| C_minus_minus -> "C minus minus source file"
|
|
|
|
| Lexer -> "lexer"
|
|
|
|
| Grammar -> "grammar"
|
2018-02-07 09:47:11 -08:00
|
|
|
| Binary_interface -> "binary interface"
|
2017-08-12 13:24:41 -07:00
|
|
|
| Obj -> "object"
|
2018-02-07 09:47:11 -08:00
|
|
|
| Backend_specific (backend, filetype) ->
|
|
|
|
((Ocaml_backends.string_of_backend backend) ^ " " ^
|
|
|
|
(string_of_backend_specific filetype))
|
2018-03-05 02:09:57 -08:00
|
|
|
| Text -> "text"
|
2017-07-21 07:43:36 -07:00
|
|
|
|
|
|
|
let extension_of_filetype = function
|
|
|
|
| Implementation -> "ml"
|
|
|
|
| Interface -> "mli"
|
|
|
|
| C -> "c"
|
|
|
|
| C_minus_minus -> "cmm"
|
|
|
|
| Lexer -> "mll"
|
|
|
|
| Grammar -> "mly"
|
2018-02-07 09:47:11 -08:00
|
|
|
| Binary_interface -> "cmi"
|
2018-04-16 06:46:41 -07:00
|
|
|
| Obj -> Ocamltest_config.objext
|
2018-02-07 09:47:11 -08:00
|
|
|
| Backend_specific (backend, filetype) ->
|
|
|
|
begin match (backend, filetype) with
|
|
|
|
| (Ocaml_backends.Native, Object) -> "cmx"
|
|
|
|
| (Ocaml_backends.Native, Library) -> "cmxa"
|
|
|
|
| (Ocaml_backends.Native, Program) -> "opt"
|
|
|
|
| (Ocaml_backends.Bytecode, Object) -> "cmo"
|
|
|
|
| (Ocaml_backends.Bytecode, Library) -> "cma"
|
|
|
|
| (Ocaml_backends.Bytecode, Program) -> "byte"
|
|
|
|
end
|
2018-03-05 02:09:57 -08:00
|
|
|
| Text -> "txt"
|
2017-07-21 07:43:36 -07:00
|
|
|
|
|
|
|
let filetype_of_extension = function
|
|
|
|
| "ml" -> Implementation
|
|
|
|
| "mli" -> Interface
|
|
|
|
| "c" -> C
|
|
|
|
| "cmm" -> C_minus_minus
|
|
|
|
| "mll" -> Lexer
|
|
|
|
| "mly" -> Grammar
|
2018-02-07 09:47:11 -08:00
|
|
|
| "cmi" -> Binary_interface
|
2018-04-16 06:46:41 -07:00
|
|
|
| "o" -> Obj
|
|
|
|
| "obj" -> Obj
|
2018-02-07 09:47:11 -08:00
|
|
|
| "cmx" -> Backend_specific (Ocaml_backends.Native, Object)
|
|
|
|
| "cmxa" -> Backend_specific (Ocaml_backends.Native, Library)
|
|
|
|
| "opt" -> Backend_specific (Ocaml_backends.Native, Program)
|
|
|
|
| "cmo" -> Backend_specific (Ocaml_backends.Bytecode, Object)
|
|
|
|
| "cma" -> Backend_specific (Ocaml_backends.Bytecode, Library)
|
|
|
|
| "byte" -> Backend_specific (Ocaml_backends.Bytecode, Program)
|
2018-03-05 02:09:57 -08:00
|
|
|
| "txt" -> Text
|
2018-04-16 06:46:41 -07:00
|
|
|
| _ as e -> Printf.eprintf "Unknown file extension %s\n%!" e; exit 2
|
2017-07-21 07:43:36 -07:00
|
|
|
|
|
|
|
let split_filename name =
|
|
|
|
let l = String.length name in
|
|
|
|
let is_dir_sep name i = name.[i] = Filename.dir_sep.[0] in
|
|
|
|
let rec search_dot i =
|
|
|
|
if i < 0 || is_dir_sep name i then (name, "")
|
|
|
|
else if name.[i] = '.' then
|
|
|
|
let basename = String.sub name 0 i in
|
|
|
|
let extension = String.sub name (i+1) (l-i-1) in
|
|
|
|
(basename, extension)
|
|
|
|
else search_dot (i - 1) in
|
|
|
|
search_dot (l - 1)
|
|
|
|
|
|
|
|
let filetype filename =
|
|
|
|
let (basename, extension) = split_filename filename in
|
|
|
|
(basename, filetype_of_extension extension)
|
|
|
|
|
|
|
|
let make_filename (basename, filetype) =
|
|
|
|
let extension = extension_of_filetype filetype in
|
|
|
|
basename ^ "." ^ extension
|
2017-12-20 01:53:33 -08:00
|
|
|
|
|
|
|
let action_of_filetype = function
|
|
|
|
| Implementation -> "Compiling implementation"
|
|
|
|
| Interface -> "Compiling interface"
|
|
|
|
| C -> "Compiling C source file"
|
|
|
|
| C_minus_minus -> "Processing C-- file"
|
|
|
|
| Lexer -> "Generating lexer"
|
|
|
|
| Grammar -> "Generating parser"
|
2018-02-07 09:47:11 -08:00
|
|
|
| filetype -> ("nothing to do for " ^ (string_of_filetype filetype))
|