1 files changed, 81 insertions, 0 deletions
diff --git a/ocaml-binary-annot/ocamlbuild/fda.ml b/ocaml-binary-annot/ocamlbuild/fda.ml
new file mode 100644
index 0000000000..4d4bbac027
--- /dev/null
+++ b/ocaml-binary-annot/ocamlbuild/fda.ml
@@ -0,0 +1,81 @@
+(***********************************************************************)
+(*                             ocamlbuild                              *)
+(*                                                                     *)
+(*  Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
+(*                                                                     *)
+(*  Copyright 2007 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+
+(* Original author: Berke Durak *)
+(* FDA *)
+
+open Log
+open Hygiene
+;;
+
+exception Exit_hygiene_failed
+;;
+
+let laws =
+  [
+    { law_name = "Leftover Ocaml compilation files";
+      law_rules = [Not ".cmo"; Not ".cmi"; Not ".cmx"; Not ".cma"; Not ".cmxa"];
+      law_penalty = Fail };
+    { law_name = "Leftover Ocaml type annotation files";
+      law_rules = [Not ".annot"];
+      law_penalty = Warn };
+    { law_name = "Leftover object files";
+      law_rules = [Not ".o"; Not ".a"; Not ".so"; Not ".obj"; Not ".lib"; Not ".dll"];
+      law_penalty = Fail };
+    { law_name = "Leftover ocamlyacc-generated files";
+      law_rules = [Implies_not(".mly",".ml"); Implies_not(".mly",".mli")];
+      law_penalty = Fail };
+    { law_name = "Leftover ocamllex-generated files";
+      law_rules = [Implies_not(".mll",".ml")];
+      law_penalty = Fail };
+    { law_name = "Leftover dependency files";
+      law_rules = [Not ".ml.depends"; Not ".mli.depends"];
+      law_penalty = Fail }
+  ]
+
+let inspect entry =
+  dprintf 5 "Doing sanity checks";
+  let evil = ref false in
+  match Hygiene.check
+    ?sanitize:
+      begin
+        if !Options.sanitize then
+          Some(Pathname.concat !Options.build_dir !Options.sanitization_script)
+        else
+          None
+      end
+      laws entry
+  with
+  | [] -> ()
+  | stuff ->
+    List.iter
+      begin fun (law, msgs) ->
+        Printf.printf "%s: %s:\n"
+          (match law.law_penalty with
+           | Warn -> "Warning"
+           | Fail ->
+               if not !evil then
+                 begin
+                   Printf.printf "IMPORTANT: I cannot work with leftover compiled files.\n%!";
+                   evil := true
+                 end;
+              "ERROR")
+          law.law_name;
+        List.iter
+          begin fun msg ->
+            Printf.printf "  %s\n" msg
+          end
+          msgs
+      end
+      stuff;
+    if !evil then raise Exit_hygiene_failed;
+;;