Added dependencies system between the modules in the checksHEADmaster

7 files changed, 123 insertions, 90 deletions

diff --git a/lib/syntax/S.ml b/lib/syntax/S.ml
index a3c74ca..04490af 100644
--- a/lib/syntax/S.ml
+++ b/lib/syntax/S.ml
@@ -29,6 +29,9 @@ type ('a, 'b) variable = { pos : 'a; name : string; index : 'b option }
 
 type ('a, 'b) clause = pos * 'a * 'b list
 
+type extract_context = { f : 'a. 'a Type.Id.t -> 'a option } [@@unboxed]
+(** Extract the given value from the context *)
+
 (** {1 Checker Signature} *)
 
 (** Represent the evaluation over an expression *)
@@ -40,22 +43,22 @@ module type Expression = sig
   (** External type used outside of the module *)
 
   val v : t -> t'
-  val ident : (pos, t) variable -> t
+  val ident : ctx:extract_context -> (pos, t) variable -> t
 
   (*
         Basic values, text, number…
    *)
 
-  val integer : pos -> string -> t
-  val literal : pos -> t T.literal list -> t
+  val integer : ctx:extract_context -> pos -> string -> t
+  val literal : ctx:extract_context -> pos -> t T.literal list -> t
 
-  val function_ : pos -> T.function_ -> t list -> t
+  val function_ : ctx:extract_context -> pos -> T.function_ -> t list -> t
   (** Call a function. The functions list is hardcoded in lib/lexer.mll *)
 
-  val uoperator : pos -> T.uoperator -> t -> t
+  val uoperator : ctx:extract_context -> pos -> T.uoperator -> t -> t
   (** Unary operator like [-123] or [+'Text']*)
 
-  val boperator : pos -> T.boperator -> t -> t -> t
+  val boperator : ctx:extract_context -> pos -> T.boperator -> t -> t -> t
   (** Binary operator, for a comparaison, or an operation *)
 end
 
@@ -108,41 +111,6 @@ module type Location = sig
   val location : context -> pos -> instruction list -> t
 end
 
-(** {1 Unified module used by the parser} *)
-
-module type Analyzer = sig
-  val identifier : string
-  (** Identifier for the module *)
-
-  val description : string
-  (** Short description*)
-
-  val active : bool ref
-  (** Is the test active or not *)
-
-  val is_global : bool
-  (** Declare the checker as global. It requires to run over the whole file and
-      will be disabled if the application only check a single location.
-
-      Also, the test will be disabled if a syntax error is reported during the
-      parsing, because this tell that I haven’t been able to analyse the whole
-      source code. *)
-
-  type context
-  (** Context used to keep information during the whole test *)
-
-  val initialize : unit -> context
-  (** Initialize the context before starting to parse the content *)
-
-  module Expression : Expression
-  module Instruction : Instruction with type expression := Expression.t'
-
-  module Location :
-    Location with type instruction := Instruction.t' and type context := context
-
-  val finalize : context -> (string * Report.t) list
-end
-
 (** Helper module used in order to convert elements from the differents
     representation levels.
 
diff --git a/lib/syntax/analyzer.ml b/lib/syntax/analyzer.ml
new file mode 100644
index 0000000..22c1696
--- /dev/null
+++ b/lib/syntax/analyzer.ml
@@ -0,0 +1,43 @@
+module type T = sig
+  type ex
+  (** The type is not given, but we do not have much choice. Because of
+      recursive definition, the type is left blank here, but constraint will be
+      defined later, and this type shall be a [ex] *)
+
+  val depends : ex list
+  (** Dependencies are module required to be executed before. The result for
+      them can be accessed with the ctx argument given in the functions *)
+
+  val identifier : string
+  (** Identifier for the module *)
+
+  val description : string
+  (** Short description*)
+
+  val active : bool ref
+  (** Is the test active or not *)
+
+  val is_global : bool
+  (** Declare the checker as global. It requires to run over the whole file and
+      will be disabled if the application only check a single location.
+
+      Also, the test will be disabled if a syntax error is reported during the
+      parsing, because this tell that I haven’t been able to analyse the whole
+      source code. *)
+
+  type context
+  (** Context used to keep information during the whole test *)
+
+  val initialize : unit -> context
+  (** Initialize the context before starting to parse the content *)
+
+  module Expression : S.Expression
+  module Instruction : S.Instruction with type expression := Expression.t'
+
+  module Location :
+    S.Location
+      with type instruction := Instruction.t'
+       and type context := context
+
+  val finalize : context -> (string * Report.t) list
+end
diff --git a/lib/syntax/dune b/lib/syntax/dune
index 9832809..4bc26be 100644
--- a/lib/syntax/dune
+++ b/lib/syntax/dune
@@ -1,8 +1,4 @@
 (library
  (name qsp_syntax)
- 
- (preprocess (pps 
-   ppx_deriving.show 
-   ppx_deriving.enum
-   ppx_deriving.ord
-   ppx_deriving.eq )))
+ (preprocess
+  (pps ppx_deriving.show ppx_deriving.enum ppx_deriving.ord ppx_deriving.eq)))
diff --git a/lib/syntax/catalog.ml b/lib/syntax/identifier.ml
index 5ad0bbd..422171c 100644
--- a/lib/syntax/catalog.ml
+++ b/lib/syntax/identifier.ml
@@ -1,13 +1,14 @@
-type ex =
+type t =
   | E : {
       module_ :
-        (module S.Analyzer
+        (module Analyzer.T
            with type Expression.t = 'a
             and type Expression.t' = 'b
             and type Instruction.t = 'c
             and type Instruction.t' = 'd
             and type Location.t = 'e
-            and type context = 'f);
+            and type context = 'f
+            and type ex = t);
       expr_witness : 'a Type.Id.t;
       expr' : 'b Type.Id.t;
       instr_witness : 'c Type.Id.t;
@@ -15,21 +16,27 @@ type ex =
       location_witness : 'e Type.Id.t;
       context : 'f Type.Id.t;
     }
-      -> ex  (** Type of check to apply *)
+      -> t  (** Type of check to apply *)
+
+let get_module : t -> (module Analyzer.T) =
+ fun (E { module_; _ }) -> (module_ :> (module Analyzer.T))
 
 let build :
-    ?location_id:'a Type.Id.t ->
-    ?context_id:'b Type.Id.t ->
-    (module S.Analyzer
-       with type Expression.t = _
+    ?expression_id:'a Type.Id.t ->
+    ?location_id:'b Type.Id.t ->
+    ?context_id:'c Type.Id.t ->
+    (module Analyzer.T
+       with type Expression.t = 'a
         and type Expression.t' = _
         and type Instruction.t = _
         and type Instruction.t' = _
-        and type Location.t = 'a
-        and type context = 'b) ->
-    ex =
- fun ?location_id ?context_id module_ ->
-  let expr_witness = Type.Id.make ()
+        and type Location.t = 'b
+        and type context = 'c
+        and type ex = t) ->
+    t =
+ fun ?expression_id ?location_id ?context_id module_ ->
+  let expr_witness =
+    match expression_id with None -> Type.Id.make () | Some v -> v
   and expr' = Type.Id.make ()
   and instr_witness = Type.Id.make ()
   and instr' = Type.Id.make ()
diff --git a/lib/syntax/catalog.mli b/lib/syntax/identifier.mli
index a386d4a..4c6387b 100644
--- a/lib/syntax/catalog.mli
+++ b/lib/syntax/identifier.mli
@@ -1,13 +1,14 @@
-type ex =
+type t =
   | E : {
       module_ :
-        (module S.Analyzer
+        (module Analyzer.T
            with type Expression.t = 'a
             and type Expression.t' = 'b
             and type Instruction.t = 'c
             and type Instruction.t' = 'd
             and type Location.t = 'e
-            and type context = 'f);
+            and type context = 'f
+            and type ex = t);
       expr_witness : 'a Type.Id.t;
       expr' : 'b Type.Id.t;
       instr_witness : 'c Type.Id.t;
@@ -15,18 +16,22 @@ type ex =
       location_witness : 'e Type.Id.t;
       context : 'f Type.Id.t;
     }
-      -> ex  (** Type of check to apply *)
+      -> t  (** Type of check to apply *)
 
 val build :
-  ?location_id:'a Type.Id.t ->
-  ?context_id:'b Type.Id.t ->
-  (module S.Analyzer
-     with type Expression.t = _
+  ?expression_id:'a Type.Id.t ->
+  ?location_id:'b Type.Id.t ->
+  ?context_id:'c Type.Id.t ->
+  (module Analyzer.T
+     with type Expression.t = 'a
       and type Expression.t' = _
       and type Instruction.t = _
       and type Instruction.t' = _
-      and type Location.t = 'a
-      and type context = 'b) ->
-  ex
+      and type Location.t = 'b
+      and type context = 'c
+      and type ex = t) ->
+  t
 (** Build a new check from a module following S.Analyzer signature. ypeid Return
     the result type which hold the final result value, and checker itself. *)
+
+val get_module : t -> (module Analyzer.T)
diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml
index 0074df8..c3edcdc 100644
--- a/lib/syntax/tree.ml
+++ b/lib/syntax/tree.ml
@@ -7,9 +7,12 @@ let active = ref true
 
 type context = unit
 
+let depends = []
 let initialize = Fun.id
 let finalize () = []
 
+type ex = Identifier.t
+
 module Ast = struct
   type 'a literal = 'a T.literal = Text of string | Expression of 'a
   [@@deriving eq, show]
@@ -88,24 +91,36 @@ end = struct
         Hashtbl.hash (f pos, name, List.map ~f:(hash f) args)
 
   let v : t -> t' = fun t -> t
-  let integer : S.pos -> string -> t = fun pos i -> Ast.Integer (pos, i)
-
-  let literal : S.pos -> t T.literal list -> t =
-   fun pos l -> Ast.Literal (pos, l)
-
-  let function_ : S.pos -> T.function_ -> t list -> t =
-   fun pos name args -> Ast.Function (pos, name, args)
-
-  let uoperator : S.pos -> T.uoperator -> t -> t =
-   fun pos op expression -> Ast.Op (pos, op, expression)
 
-  let boperator : S.pos -> T.boperator -> t -> t -> t =
-   fun pos op op1 op2 ->
+  let integer : ctx:S.extract_context -> S.pos -> string -> t =
+   fun ~ctx pos i ->
+    ignore ctx;
+    Ast.Integer (pos, i)
+
+  let literal : ctx:S.extract_context -> S.pos -> t T.literal list -> t =
+   fun ~ctx pos l ->
+    ignore ctx;
+    Ast.Literal (pos, l)
+
+  let function_ : ctx:S.extract_context -> S.pos -> T.function_ -> t list -> t =
+   fun ~ctx pos name args ->
+    ignore ctx;
+    Ast.Function (pos, name, args)
+
+  let uoperator : ctx:S.extract_context -> S.pos -> T.uoperator -> t -> t =
+   fun ~ctx pos op expression ->
+    ignore ctx;
+    Ast.Op (pos, op, expression)
+
+  let boperator : ctx:S.extract_context -> S.pos -> T.boperator -> t -> t -> t =
+   fun ~ctx pos op op1 op2 ->
+    ignore ctx;
     let op1 = op1 and op2 = op2 in
     Ast.BinaryOp (pos, op, op1, op2)
 
-  let ident : (S.pos, t) S.variable -> t =
-   fun { pos; name; index } ->
+  let ident : ctx:S.extract_context -> (S.pos, t) S.variable -> t =
+   fun ~ctx { pos; name; index } ->
+    ignore ctx;
     let index = Option.map (fun i -> i) index in
     Ast.Ident { pos; name; index }
 end
diff --git a/lib/syntax/tree.mli b/lib/syntax/tree.mli
index 9ed442b..097a7ac 100644
--- a/lib/syntax/tree.mli
+++ b/lib/syntax/tree.mli
@@ -1,9 +1,7 @@
-(** 
-    Implementation for S.Analyzer for building a complete Ast.
+(** Implementation for S.Analyzer for building a complete Ast.
 
     Used in the unit test in order to check if the grammar is interpreted as
-    expected, not really usefull over a big qsp.
- *)
+    expected, not really usefull over a big qsp. *)
 
 (** This module is the result of the evaluation. *)
 module Ast : sig
@@ -53,8 +51,9 @@ module Expression : sig
 end
 
 include
-  S.Analyzer
+  Analyzer.T
     with module Expression := Expression
      and type Instruction.t' = S.pos Ast.statement
      and type Location.t = S.pos * S.pos Ast.statement list
      and type context = unit
+     and type ex = Identifier.t