Extract ControlSpecC to file module to allow dependency cycle breaking

Author: sim642

src/framework/analyses.ml

@@ -328,63 +328,6 @@ struct
 end
 
 
-(** Reference to top-level Control Spec context first-class module. *)
-let control_spec_c: (module Printable.S) ref =
-  let module Failwith = Printable.Failwith (
-    struct
-      let message = "uninitialized control_spec_c"
-    end
-    )
-  in
-  ref (module Failwith: Printable.S)
-
-(** Top-level Control Spec context as static module, which delegates to {!control_spec_c}.
-    This allows using top-level context values inside individual analyses. *)
-module ControlSpecC: Printable.S =
-struct
-  type t = Obj.t (** represents [(val !control_spec_c).t] *)
-
-  (* The extra level of indirection allows calls to this static module to go to a dynamic first-class module. *)
-
-  let name () =
-    let module C = (val !control_spec_c) in
-    C.name ()
-
-  let equal x y =
-    let module C = (val !control_spec_c) in
-    C.equal (Obj.obj x) (Obj.obj y)
-  let compare x y =
-    let module C = (val !control_spec_c) in
-    C.compare (Obj.obj x) (Obj.obj y)
-  let hash x =
-    let module C = (val !control_spec_c) in
-    C.hash (Obj.obj x)
-  let tag x =
-    let module C = (val !control_spec_c) in
-    C.tag (Obj.obj x)
-
-  let show x =
-    let module C = (val !control_spec_c) in
-    C.show (Obj.obj x)
-  let pretty () x =
-    let module C = (val !control_spec_c) in
-    C.pretty () (Obj.obj x)
-  let printXml f x =
-    let module C = (val !control_spec_c) in
-    C.printXml f (Obj.obj x)
-  let to_yojson x =
-    let module C = (val !control_spec_c) in
-    C.to_yojson (Obj.obj x)
-
-  let arbitrary () =
-    let module C = (val !control_spec_c) in
-    QCheck.map ~rev:Obj.obj Obj.repr (C.arbitrary ())
-  let relift x =
-    let module C = (val !control_spec_c) in
-    Obj.repr (C.relift (Obj.obj x))
-end
-
-
 (* Experiment to reduce the number of arguments on transfer functions and allow
    sub-analyses. The list sub contains the current local states of analyses in
    the same order as written in the dependencies list (in MCP).

src/framework/control.ml

@@ -34,7 +34,7 @@ let spec_module: (module Spec) Lazy.t = lazy (
             |> lift (get_bool "ana.widen.tokens") (module WideningTokens.Lifter)
           ) in
   GobConfig.building_spec := false;
-  Analyses.control_spec_c := (module S1.C);
+  ControlSpecC.control_spec_c := (module S1.C);
   (module S1)
 )
 

src/framework/controlSpecC.ml

@@ -0,0 +1,49 @@
+module Failwith = Printable.Failwith (
+  struct
+    let message = "uninitialized control_spec_c"
+  end
+  )
+
+let control_spec_c: (module Printable.S) ref = ref (module Failwith: Printable.S)
+
+
+type t = Obj.t (** represents [(val !control_spec_c).t] *)
+
+(* The extra level of indirection allows calls to this static module to go to a dynamic first-class module. *)
+
+let name () =
+  let module C = (val !control_spec_c) in
+  C.name ()
+
+let equal x y =
+  let module C = (val !control_spec_c) in
+  C.equal (Obj.obj x) (Obj.obj y)
+let compare x y =
+  let module C = (val !control_spec_c) in
+  C.compare (Obj.obj x) (Obj.obj y)
+let hash x =
+  let module C = (val !control_spec_c) in
+  C.hash (Obj.obj x)
+let tag x =
+  let module C = (val !control_spec_c) in
+  C.tag (Obj.obj x)
+
+let show x =
+  let module C = (val !control_spec_c) in
+  C.show (Obj.obj x)
+let pretty () x =
+  let module C = (val !control_spec_c) in
+  C.pretty () (Obj.obj x)
+let printXml f x =
+  let module C = (val !control_spec_c) in
+  C.printXml f (Obj.obj x)
+let to_yojson x =
+  let module C = (val !control_spec_c) in
+  C.to_yojson (Obj.obj x)
+
+let arbitrary () =
+  let module C = (val !control_spec_c) in
+  QCheck.map ~rev:Obj.obj Obj.repr (C.arbitrary ())
+let relift x =
+  let module C = (val !control_spec_c) in
+  Obj.repr (C.relift (Obj.obj x))

src/framework/controlSpecC.mli

@@ -0,0 +1,6 @@
+(** Top-level Control Spec context as static module, which delegates to {!control_spec_c}.
+    This allows using top-level context values inside individual analyses. *)
+include Printable.S
+
+(** Reference to top-level Control Spec context first-class module. *)
+val control_spec_c: (module Printable.S) ref