Merge pull request #359 from rgrinberg/lint2
Implement lint field and run linting with @lint alias.
This commit is contained in:
commit
9ed300e5a2
17
src/alias.ml
17
src/alias.ml
|
@ -113,6 +113,7 @@ let default = make "DEFAULT"
|
||||||
let runtest = make "runtest"
|
let runtest = make "runtest"
|
||||||
let install = make "install"
|
let install = make "install"
|
||||||
let doc = make "doc"
|
let doc = make "doc"
|
||||||
|
let lint = make "lint"
|
||||||
|
|
||||||
module Store = struct
|
module Store = struct
|
||||||
type entry =
|
type entry =
|
||||||
|
@ -183,3 +184,19 @@ let rules store =
|
||||||
(Path.Set.elements deps))))
|
(Path.Set.elements deps))))
|
||||||
in
|
in
|
||||||
rule :: acc)
|
rule :: acc)
|
||||||
|
|
||||||
|
let add_stamp_dep (store: Store.t) (t : t) ~data =
|
||||||
|
let digest = Digest.string (Sexp.to_string data) in
|
||||||
|
let digest_path = file_with_digest_suffix t ~digest in
|
||||||
|
add_deps store t [digest_path];
|
||||||
|
digest_path
|
||||||
|
|
||||||
|
let add_action_dep (store: Store.t) (t : t) ~action ~action_deps =
|
||||||
|
let data =
|
||||||
|
let deps = Sexp.To_sexp.list Jbuild.Dep_conf.sexp_of_t action_deps in
|
||||||
|
let action =
|
||||||
|
match action with
|
||||||
|
| None -> Sexp.Atom "none"
|
||||||
|
| Some a -> List [Atom "some"; Action.Unexpanded.sexp_of_t a] in
|
||||||
|
Sexp.List [deps ; action] in
|
||||||
|
add_stamp_dep store t ~data
|
||||||
|
|
|
@ -26,6 +26,7 @@ val default : dir:Path.t -> t
|
||||||
val runtest : dir:Path.t -> t
|
val runtest : dir:Path.t -> t
|
||||||
val install : dir:Path.t -> t
|
val install : dir:Path.t -> t
|
||||||
val doc : dir:Path.t -> t
|
val doc : dir:Path.t -> t
|
||||||
|
val lint : dir:Path.t -> t
|
||||||
|
|
||||||
val dep : t -> ('a, 'a) Build.t
|
val dep : t -> ('a, 'a) Build.t
|
||||||
|
|
||||||
|
@ -69,3 +70,21 @@ end
|
||||||
val add_deps : Store.t -> t -> Path.t list -> unit
|
val add_deps : Store.t -> t -> Path.t list -> unit
|
||||||
|
|
||||||
val rules : Store.t -> Build_interpret.Rule.t list
|
val rules : Store.t -> Build_interpret.Rule.t list
|
||||||
|
|
||||||
|
(** Create an alias dependency for an action and its inputs represented by
|
||||||
|
[~data]. The path returned is the file that should be represented by the
|
||||||
|
file the action will create following execution.*)
|
||||||
|
val add_stamp_dep
|
||||||
|
: Store.t
|
||||||
|
-> t
|
||||||
|
-> data:Sexp.t
|
||||||
|
-> Path.t
|
||||||
|
|
||||||
|
(** Like [add_stamp_dep] but an action (if present) and the dependencies can be
|
||||||
|
passed in directly. *)
|
||||||
|
val add_action_dep
|
||||||
|
: Store.t
|
||||||
|
-> t
|
||||||
|
-> action:Action.Unexpanded.t option
|
||||||
|
-> action_deps:Jbuild.Dep_conf.t list
|
||||||
|
-> Path.t
|
||||||
|
|
|
@ -228,13 +228,15 @@ module Gen(P : Params) = struct
|
||||||
| Some m -> String_map.add modules ~key:m.name ~data:m
|
| Some m -> String_map.add modules ~key:m.name ~data:m
|
||||||
in
|
in
|
||||||
String_map.values modules);
|
String_map.values modules);
|
||||||
|
|
||||||
(* Preprocess before adding the alias module as it doesn't need preprocessing *)
|
(* Preprocess before adding the alias module as it doesn't need preprocessing *)
|
||||||
let modules =
|
let modules =
|
||||||
SC.PP.pped_modules sctx ~dir ~dep_kind ~modules ~preprocess:lib.buildable.preprocess
|
SC.PP.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope
|
||||||
|
~preprocess:lib.buildable.preprocess
|
||||||
~preprocessor_deps:lib.buildable.preprocessor_deps
|
~preprocessor_deps:lib.buildable.preprocessor_deps
|
||||||
~lib_name:(Some lib.name)
|
~lint:lib.buildable.lint
|
||||||
~scope
|
~lib_name:(Some lib.name) in
|
||||||
in
|
|
||||||
let modules =
|
let modules =
|
||||||
match alias_module with
|
match alias_module with
|
||||||
| None -> modules
|
| None -> modules
|
||||||
|
@ -501,13 +503,15 @@ module Gen(P : Params) = struct
|
||||||
if not (String_map.mem (String.capitalize_ascii name) modules) then
|
if not (String_map.mem (String.capitalize_ascii name) modules) then
|
||||||
die "executable %s in %s doesn't have a corresponding .ml file"
|
die "executable %s in %s doesn't have a corresponding .ml file"
|
||||||
name (Path.to_string dir));
|
name (Path.to_string dir));
|
||||||
|
|
||||||
let modules =
|
let modules =
|
||||||
SC.PP.pped_modules sctx ~dir ~dep_kind ~modules
|
SC.PP.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope
|
||||||
~preprocess:exes.buildable.preprocess
|
~preprocess:exes.buildable.preprocess
|
||||||
~preprocessor_deps:exes.buildable.preprocessor_deps
|
~preprocessor_deps:exes.buildable.preprocessor_deps
|
||||||
|
~lint:exes.buildable.lint
|
||||||
~lib_name:None
|
~lib_name:None
|
||||||
~scope
|
|
||||||
in
|
in
|
||||||
|
|
||||||
let item = List.hd exes.names in
|
let item = List.hd exes.names in
|
||||||
let dep_graph =
|
let dep_graph =
|
||||||
Ocamldep.rules sctx ~dir ~item ~modules ~alias_module:None
|
Ocamldep.rules sctx ~dir ~item ~modules ~alias_module:None
|
||||||
|
@ -570,21 +574,11 @@ module Gen(P : Params) = struct
|
||||||
~scope)
|
~scope)
|
||||||
|
|
||||||
let alias_rules (alias_conf : Alias_conf.t) ~dir ~scope =
|
let alias_rules (alias_conf : Alias_conf.t) ~dir ~scope =
|
||||||
let digest =
|
|
||||||
let deps =
|
|
||||||
Sexp.To_sexp.list Dep_conf.sexp_of_t alias_conf.deps in
|
|
||||||
let action =
|
|
||||||
match alias_conf.action with
|
|
||||||
| None -> Sexp.Atom "none"
|
|
||||||
| Some a -> List [Atom "some" ; Action.Unexpanded.sexp_of_t a]
|
|
||||||
in
|
|
||||||
Sexp.List [deps ; action]
|
|
||||||
|> Sexp.to_string
|
|
||||||
|> Digest.string
|
|
||||||
in
|
|
||||||
let alias = Alias.make alias_conf.name ~dir in
|
let alias = Alias.make alias_conf.name ~dir in
|
||||||
let digest_path = Alias.file_with_digest_suffix alias ~digest in
|
let digest_path =
|
||||||
Alias.add_deps (SC.aliases sctx) alias [digest_path];
|
Alias.add_action_dep (SC.aliases sctx) alias
|
||||||
|
~action:alias_conf.action
|
||||||
|
~action_deps:alias_conf.deps in
|
||||||
let deps = SC.Deps.interpret sctx ~scope ~dir alias_conf.deps in
|
let deps = SC.Deps.interpret sctx ~scope ~dir alias_conf.deps in
|
||||||
SC.add_rule sctx
|
SC.add_rule sctx
|
||||||
~locks:(interpret_locks ~dir ~scope alias_conf.locks)
|
~locks:(interpret_locks ~dir ~scope alias_conf.locks)
|
||||||
|
|
|
@ -78,6 +78,11 @@ module List = struct
|
||||||
max acc (String.length (f x)))
|
max acc (String.length (f x)))
|
||||||
|
|
||||||
let longest l = longest_map l ~f:(fun x -> x)
|
let longest l = longest_map l ~f:(fun x -> x)
|
||||||
|
|
||||||
|
let rec last = function
|
||||||
|
| [] -> None
|
||||||
|
| [x] -> Some x
|
||||||
|
| _::xs -> last xs
|
||||||
end
|
end
|
||||||
|
|
||||||
module Hashtbl = struct
|
module Hashtbl = struct
|
||||||
|
|
|
@ -301,14 +301,12 @@ module Preprocess_map = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Lint = struct
|
module Lint = struct
|
||||||
type t = Pps of Preprocess.pps
|
type t = Preprocess_map.t
|
||||||
|
|
||||||
let t =
|
let t = Preprocess_map.t
|
||||||
sum
|
|
||||||
[ cstr "pps" (list Pp_or_flags.t @> nil) (fun l ->
|
let default = Preprocess_map.default
|
||||||
let pps, flags = Pp_or_flags.split l in
|
let no_lint = default
|
||||||
Pps { pps; flags })
|
|
||||||
]
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let field_oslu name =
|
let field_oslu name =
|
||||||
|
@ -442,6 +440,7 @@ module Buildable = struct
|
||||||
; libraries : Lib_dep.t list
|
; libraries : Lib_dep.t list
|
||||||
; preprocess : Preprocess_map.t
|
; preprocess : Preprocess_map.t
|
||||||
; preprocessor_deps : Dep_conf.t list
|
; preprocessor_deps : Dep_conf.t list
|
||||||
|
; lint : Preprocess_map.t
|
||||||
; flags : Ordered_set_lang.Unexpanded.t
|
; flags : Ordered_set_lang.Unexpanded.t
|
||||||
; ocamlc_flags : Ordered_set_lang.Unexpanded.t
|
; ocamlc_flags : Ordered_set_lang.Unexpanded.t
|
||||||
; ocamlopt_flags : Ordered_set_lang.Unexpanded.t
|
; ocamlopt_flags : Ordered_set_lang.Unexpanded.t
|
||||||
|
@ -456,8 +455,8 @@ module Buildable = struct
|
||||||
>>= fun preprocessor_deps ->
|
>>= fun preprocessor_deps ->
|
||||||
(* CR-someday jdimino: remove this. There are still a few Jane Street packages using
|
(* CR-someday jdimino: remove this. There are still a few Jane Street packages using
|
||||||
this *)
|
this *)
|
||||||
field_o "lint" (Per_module.t Lint.t)
|
field "lint" Lint.t ~default:Lint.default
|
||||||
>>= fun _lint ->
|
>>= fun lint ->
|
||||||
field "modules" (fun s -> Ordered_set_lang.(map (t s)) ~f:String.capitalize_ascii)
|
field "modules" (fun s -> Ordered_set_lang.(map (t s)) ~f:String.capitalize_ascii)
|
||||||
~default:Ordered_set_lang.standard
|
~default:Ordered_set_lang.standard
|
||||||
>>= fun modules ->
|
>>= fun modules ->
|
||||||
|
@ -470,6 +469,7 @@ module Buildable = struct
|
||||||
return
|
return
|
||||||
{ preprocess
|
{ preprocess
|
||||||
; preprocessor_deps
|
; preprocessor_deps
|
||||||
|
; lint
|
||||||
; modules
|
; modules
|
||||||
; libraries
|
; libraries
|
||||||
; flags
|
; flags
|
||||||
|
|
|
@ -57,6 +57,13 @@ module Preprocess_map : sig
|
||||||
val pps : t -> Pp.t list
|
val pps : t -> Pp.t list
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Lint : sig
|
||||||
|
type t = Preprocess_map.t
|
||||||
|
|
||||||
|
val no_lint : t
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
module Js_of_ocaml : sig
|
module Js_of_ocaml : sig
|
||||||
type t =
|
type t =
|
||||||
{ flags : Ordered_set_lang.Unexpanded.t
|
{ flags : Ordered_set_lang.Unexpanded.t
|
||||||
|
@ -108,6 +115,7 @@ module Buildable : sig
|
||||||
; libraries : Lib_dep.t list
|
; libraries : Lib_dep.t list
|
||||||
; preprocess : Preprocess_map.t
|
; preprocess : Preprocess_map.t
|
||||||
; preprocessor_deps : Dep_conf.t list
|
; preprocessor_deps : Dep_conf.t list
|
||||||
|
; lint : Lint.t
|
||||||
; flags : Ordered_set_lang.Unexpanded.t
|
; flags : Ordered_set_lang.Unexpanded.t
|
||||||
; ocamlc_flags : Ordered_set_lang.Unexpanded.t
|
; ocamlc_flags : Ordered_set_lang.Unexpanded.t
|
||||||
; ocamlopt_flags : Ordered_set_lang.Unexpanded.t
|
; ocamlopt_flags : Ordered_set_lang.Unexpanded.t
|
||||||
|
|
|
@ -54,3 +54,7 @@ let cmti_file t ~dir =
|
||||||
match t.intf with
|
match t.intf with
|
||||||
| None -> Path.relative dir (t.obj_name ^ ".cmt")
|
| None -> Path.relative dir (t.obj_name ^ ".cmt")
|
||||||
| Some _ -> Path.relative dir (t.obj_name ^ ".cmti")
|
| Some _ -> Path.relative dir (t.obj_name ^ ".cmti")
|
||||||
|
|
||||||
|
let iter t ~f =
|
||||||
|
f Ml_kind.Impl t.impl;
|
||||||
|
Option.iter t.intf ~f:(f Ml_kind.Intf)
|
||||||
|
|
|
@ -35,3 +35,5 @@ val odoc_file : t -> dir:Path.t -> Path.t
|
||||||
|
|
||||||
(** Either the .cmti, or .cmt if the module has no interface *)
|
(** Either the .cmti, or .cmt if the module has no interface *)
|
||||||
val cmti_file : t -> dir:Path.t -> Path.t
|
val cmti_file : t -> dir:Path.t -> Path.t
|
||||||
|
|
||||||
|
val iter : t -> f:(Ml_kind.t -> File.t -> unit) -> unit
|
||||||
|
|
|
@ -220,7 +220,10 @@ end
|
||||||
type t = string
|
type t = string
|
||||||
let compare = String.compare
|
let compare = String.compare
|
||||||
|
|
||||||
module Set = String_set
|
module Set = struct
|
||||||
|
include String_set
|
||||||
|
let sexp_of_t t = Sexp.To_sexp.(list string) (String_set.elements t)
|
||||||
|
end
|
||||||
module Map = String_map
|
module Map = String_map
|
||||||
|
|
||||||
module Kind = struct
|
module Kind = struct
|
||||||
|
|
|
@ -39,7 +39,10 @@ val sexp_of_t : t Sexp.To_sexp.t
|
||||||
val compare : t -> t -> int
|
val compare : t -> t -> int
|
||||||
(** a directory is smaller than its descendants *)
|
(** a directory is smaller than its descendants *)
|
||||||
|
|
||||||
module Set : Set.S with type elt = t
|
module Set : sig
|
||||||
|
include Set.S with type elt = t
|
||||||
|
val sexp_of_t : t Sexp.To_sexp.t
|
||||||
|
end
|
||||||
module Map : Map.S with type key = t
|
module Map : Map.S with type key = t
|
||||||
|
|
||||||
val kind : t -> Kind.t
|
val kind : t -> Kind.t
|
||||||
|
|
|
@ -887,53 +887,119 @@ module PP = struct
|
||||||
mli) in
|
mli) in
|
||||||
{ m with impl ; intf }
|
{ m with impl ; intf }
|
||||||
|
|
||||||
|
let lint_module sctx ~(source : Module.t) ~(ast : Module.t) ~dir
|
||||||
|
~dep_kind ~lint ~lib_name ~scope =
|
||||||
|
let alias = Alias.lint ~dir in
|
||||||
|
match Preprocess_map.find source.name lint with
|
||||||
|
| No_preprocessing -> ()
|
||||||
|
| Action action ->
|
||||||
|
let action = Action.U.Chdir (root_var, action) in
|
||||||
|
Module.iter source ~f:(fun _ (src : Module.File.t) ->
|
||||||
|
let digest_path =
|
||||||
|
Alias.add_action_dep
|
||||||
|
~action:(Some action)
|
||||||
|
~action_deps:[Dep_conf.File (String_with_vars.virt __POS__ src.name)]
|
||||||
|
(aliases sctx) alias in
|
||||||
|
let src = Path.relative dir src.name in
|
||||||
|
add_rule sctx
|
||||||
|
(Build.path src
|
||||||
|
>>^ (fun _ -> [src])
|
||||||
|
>>>
|
||||||
|
Build.progn
|
||||||
|
[ Action.run sctx
|
||||||
|
action
|
||||||
|
~dir
|
||||||
|
~dep_kind
|
||||||
|
~targets:(Static [])
|
||||||
|
~scope
|
||||||
|
; Build.create_file digest_path
|
||||||
|
])
|
||||||
|
)
|
||||||
|
| Pps { pps; flags } ->
|
||||||
|
let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in
|
||||||
|
Module.iter ast ~f:(fun kind src ->
|
||||||
|
let src_path = Path.relative dir src.name in
|
||||||
|
let args =
|
||||||
|
[ Arg_spec.As flags
|
||||||
|
; As (cookie_library_name lib_name)
|
||||||
|
; Ml_kind.ppx_driver_flag kind
|
||||||
|
; Dep src_path
|
||||||
|
] in
|
||||||
|
let args =
|
||||||
|
(* This hack is needed until -null is standard:
|
||||||
|
https://github.com/ocaml-ppx/ocaml-migrate-parsetree/issues/35 *)
|
||||||
|
match Option.map ~f:Pp.to_string (List.last pps) with
|
||||||
|
| Some "ppx_driver.runner" -> args @ [A "-null"]
|
||||||
|
| Some _ | None -> args in
|
||||||
|
let digest_path =
|
||||||
|
Alias.add_stamp_dep (aliases sctx) alias
|
||||||
|
~data:(
|
||||||
|
Sexp.To_sexp.(
|
||||||
|
triple Path.sexp_of_t string (pair (list string) Path.Set.sexp_of_t)
|
||||||
|
) (ppx_exe, src.name, Arg_spec.expand ~dir args ())
|
||||||
|
) in
|
||||||
|
add_rule sctx
|
||||||
|
(Build.progn
|
||||||
|
[ Build.run ~context:sctx.context (Ok ppx_exe) args
|
||||||
|
; Build.create_file digest_path
|
||||||
|
])
|
||||||
|
)
|
||||||
|
|
||||||
(* Generate rules to build the .pp files and return a new module map where all filenames
|
(* Generate rules to build the .pp files and return a new module map where all filenames
|
||||||
point to the .pp files *)
|
point to the .pp files *)
|
||||||
let pped_modules sctx ~dir ~dep_kind ~modules ~preprocess ~preprocessor_deps ~lib_name
|
let pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~lint ~preprocess
|
||||||
~scope =
|
~preprocessor_deps ~lib_name ~scope =
|
||||||
let preprocessor_deps =
|
let preprocessor_deps =
|
||||||
Build.memoize "preprocessor deps"
|
Build.memoize "preprocessor deps"
|
||||||
(Deps.interpret sctx ~scope ~dir preprocessor_deps)
|
(Deps.interpret sctx ~scope ~dir preprocessor_deps)
|
||||||
in
|
in
|
||||||
|
let lint_module = lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope in
|
||||||
String_map.map modules ~f:(fun (m : Module.t) ->
|
String_map.map modules ~f:(fun (m : Module.t) ->
|
||||||
match Preprocess_map.find m.name preprocess with
|
match Preprocess_map.find m.name preprocess with
|
||||||
| No_preprocessing -> setup_reason_rules sctx ~dir m
|
| No_preprocessing ->
|
||||||
| Action action ->
|
let ast = setup_reason_rules sctx ~dir m in
|
||||||
pped_module m ~dir ~f:(fun _kind src dst ->
|
lint_module ~ast ~source:m;
|
||||||
add_rule sctx
|
ast
|
||||||
(preprocessor_deps
|
| Action action ->
|
||||||
>>>
|
let ast =
|
||||||
Build.path src
|
pped_module m ~dir ~f:(fun _kind src dst ->
|
||||||
>>^ (fun _ -> [src])
|
add_rule sctx
|
||||||
>>>
|
(preprocessor_deps
|
||||||
Action.run sctx
|
>>>
|
||||||
(Redirect
|
Build.path src
|
||||||
(Stdout,
|
>>^ (fun _ -> [src])
|
||||||
target_var,
|
>>>
|
||||||
Chdir (root_var,
|
Action.run sctx
|
||||||
action)))
|
(Redirect
|
||||||
~dir
|
(Stdout,
|
||||||
~dep_kind
|
target_var,
|
||||||
~targets:(Static [dst])
|
Chdir (root_var,
|
||||||
~scope))
|
action)))
|
||||||
|> setup_reason_rules sctx ~dir
|
~dir
|
||||||
| Pps { pps; flags } ->
|
~dep_kind
|
||||||
let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in
|
~targets:(Static [dst])
|
||||||
let m = setup_reason_rules sctx ~dir m in
|
~scope))
|
||||||
pped_module m ~dir ~f:(fun kind src dst ->
|
|> setup_reason_rules sctx ~dir in
|
||||||
add_rule sctx
|
lint_module ~ast ~source:m;
|
||||||
(preprocessor_deps
|
ast
|
||||||
>>>
|
| Pps { pps; flags } ->
|
||||||
Build.run ~context:sctx.context
|
let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in
|
||||||
(Ok ppx_exe)
|
let ast = setup_reason_rules sctx ~dir m in
|
||||||
[ As flags
|
lint_module ~ast ~source:m;
|
||||||
; A "--dump-ast"
|
pped_module ast ~dir ~f:(fun kind src dst ->
|
||||||
; As (cookie_library_name lib_name)
|
add_rule sctx
|
||||||
; A "-o"; Target dst
|
(preprocessor_deps
|
||||||
; Ml_kind.ppx_driver_flag kind; Dep src
|
>>>
|
||||||
])
|
Build.run ~context:sctx.context
|
||||||
)
|
(Ok ppx_exe)
|
||||||
|
[ As flags
|
||||||
|
; A "--dump-ast"
|
||||||
|
; As (cookie_library_name lib_name)
|
||||||
|
; A "-o"; Target dst
|
||||||
|
; Ml_kind.ppx_driver_flag kind; Dep src
|
||||||
|
]))
|
||||||
)
|
)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let expand_and_eval_set t ~scope ~dir set ~standard =
|
let expand_and_eval_set t ~scope ~dir set ~standard =
|
||||||
|
|
|
@ -158,12 +158,14 @@ end
|
||||||
|
|
||||||
(** Preprocessing stuff *)
|
(** Preprocessing stuff *)
|
||||||
module PP : sig
|
module PP : sig
|
||||||
(** Setup pre-processing rules and return the list of pre-processed modules *)
|
(** Setup pre-processing and linting rules and return the list of
|
||||||
val pped_modules
|
pre-processed modules *)
|
||||||
|
val pp_and_lint_modules
|
||||||
: t
|
: t
|
||||||
-> dir:Path.t
|
-> dir:Path.t
|
||||||
-> dep_kind:Build.lib_dep_kind
|
-> dep_kind:Build.lib_dep_kind
|
||||||
-> modules:Module.t String_map.t
|
-> modules:Module.t String_map.t
|
||||||
|
-> lint:Preprocess_map.t
|
||||||
-> preprocess:Preprocess_map.t
|
-> preprocess:Preprocess_map.t
|
||||||
-> preprocessor_deps:Dep_conf.t list
|
-> preprocessor_deps:Dep_conf.t list
|
||||||
-> lib_name:string option
|
-> lib_name:string option
|
||||||
|
|
|
@ -49,6 +49,7 @@ let utop_of_libs (libs : Library.t list) =
|
||||||
(Lib_dep.direct "utop") :: (List.map libs ~f:(fun lib ->
|
(Lib_dep.direct "utop") :: (List.map libs ~f:(fun lib ->
|
||||||
Lib_dep.direct lib.Library.name))
|
Lib_dep.direct lib.Library.name))
|
||||||
; preprocess = Preprocess_map.no_preprocessing
|
; preprocess = Preprocess_map.no_preprocessing
|
||||||
|
; lint = Lint.no_lint
|
||||||
; preprocessor_deps = []
|
; preprocessor_deps = []
|
||||||
; flags = Ordered_set_lang.Unexpanded.standard
|
; flags = Ordered_set_lang.Unexpanded.standard
|
||||||
; ocamlc_flags = Ordered_set_lang.Unexpanded.standard
|
; ocamlc_flags = Ordered_set_lang.Unexpanded.standard
|
||||||
|
|
|
@ -7,6 +7,10 @@
|
||||||
((name rlib)
|
((name rlib)
|
||||||
(public_name rlib)
|
(public_name rlib)
|
||||||
(modules (bar cppome foo hello pped))
|
(modules (bar cppome foo hello pped))
|
||||||
|
(lint
|
||||||
|
(per_module
|
||||||
|
((pps (reasonppx (-lint true))) (hello cppome))
|
||||||
|
((action (run ./pp/reasononlypp.exe -lint ${<})) (foo bar pped))))
|
||||||
(preprocess
|
(preprocess
|
||||||
(per_module
|
(per_module
|
||||||
((pps (reasonppx)) (foo))
|
((pps (reasonppx)) (foo))
|
||||||
|
@ -16,6 +20,7 @@
|
||||||
(executable
|
(executable
|
||||||
((name rbin)
|
((name rbin)
|
||||||
(modules (rbin))
|
(modules (rbin))
|
||||||
|
(lint (action (run ./pp/reasononlypp.exe -lint ${<})))
|
||||||
(preprocess (action (run ./pp/reasononlypp.exe ${<})))
|
(preprocess (action (run ./pp/reasononlypp.exe ${<})))
|
||||||
(libraries (rlib))))
|
(libraries (rlib))))
|
||||||
|
|
||||||
|
@ -28,4 +33,4 @@
|
||||||
(alias
|
(alias
|
||||||
((name runtest)
|
((name runtest)
|
||||||
(deps (rbin.exe))
|
(deps (rbin.exe))
|
||||||
(action (run ${<}))))
|
(action (run ${<}))))
|
||||||
|
|
|
@ -1,15 +1,52 @@
|
||||||
|
let lint = ref false
|
||||||
|
let fname = ref None
|
||||||
|
let usage =
|
||||||
|
Printf.sprintf "%s [-lint] file" (Filename.basename Sys.executable_name)
|
||||||
|
let anon s =
|
||||||
|
match !fname with
|
||||||
|
| None -> fname := Some s
|
||||||
|
| Some _ -> raise (Arg.Bad "file must only be given once")
|
||||||
|
|
||||||
|
let is_ascii s =
|
||||||
|
try
|
||||||
|
for i=0 to String.length s - 1 do
|
||||||
|
if Char.code (s.[i]) > 127 then raise Exit
|
||||||
|
done;
|
||||||
|
true
|
||||||
|
with Exit ->
|
||||||
|
false
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
let fname = Sys.argv.(1) in
|
Arg.parse
|
||||||
|
["-lint", Arg.Set lint, "lint instead of preprocessing"
|
||||||
|
] anon usage;
|
||||||
|
let fname =
|
||||||
|
match !fname with
|
||||||
|
| None -> raise (Arg.Bad "file must be provided")
|
||||||
|
| Some f -> f in
|
||||||
|
|
||||||
if Filename.check_suffix fname ".re"
|
if Filename.check_suffix fname ".re"
|
||||||
|| Filename.check_suffix fname ".rei" then (
|
|| Filename.check_suffix fname ".rei" then (
|
||||||
|
if !lint && (Filename.check_suffix fname ".pp.re"
|
||||||
|
|| Filename.check_suffix fname ".pp.rei") then (
|
||||||
|
Format.eprintf "reason linter doesn't accept preprocessed file %s" fname;
|
||||||
|
);
|
||||||
let ch = open_in fname in
|
let ch = open_in fname in
|
||||||
let rec loop () =
|
let rec loop () =
|
||||||
match input_line ch with
|
match input_line ch with
|
||||||
| exception End_of_file -> ()
|
| exception End_of_file -> ()
|
||||||
| line -> print_endline line; loop () in
|
| line when is_ascii line ->
|
||||||
|
if not !lint then (
|
||||||
|
print_endline line
|
||||||
|
);
|
||||||
|
loop ()
|
||||||
|
| _ ->
|
||||||
|
Format.eprintf "%s isn't source code@.%!" fname;
|
||||||
|
exit 1
|
||||||
|
in
|
||||||
loop ();
|
loop ();
|
||||||
close_in ch
|
close_in ch;
|
||||||
|
exit 0
|
||||||
) else (
|
) else (
|
||||||
Format.eprintf "%s is not a reason source@.%!" fname;
|
Format.eprintf "%s is not a reason source@.%!" fname;
|
||||||
exit 1
|
exit 1
|
||||||
|
|
|
@ -3,4 +3,4 @@ open Rlib;
|
||||||
Cppome.run();
|
Cppome.run();
|
||||||
Hello.run();
|
Hello.run();
|
||||||
Bar.run();
|
Bar.run();
|
||||||
Foo.run();
|
Foo.run();
|
||||||
|
|
Loading…
Reference in New Issue