aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/checks/check.ml (renamed from lib/syntax/check.ml)68
-rw-r--r--lib/checks/check.mli (renamed from lib/syntax/check.mli)26
-rw-r--r--lib/checks/compose.ml (renamed from lib/syntax/compose.ml)2
-rw-r--r--lib/checks/dead_end.ml (renamed from lib/syntax/dead_end.ml)3
-rw-r--r--lib/checks/dead_end.mli (renamed from lib/syntax/dead_end.mli)2
-rw-r--r--lib/checks/default.ml (renamed from lib/syntax/default.ml)4
-rw-r--r--lib/checks/dune9
-rw-r--r--lib/checks/dup_test.ml (renamed from lib/syntax/dup_test.ml)4
-rw-r--r--lib/checks/dup_test.mli1
-rw-r--r--lib/checks/get_type.ml (renamed from lib/syntax/get_type.ml)3
-rw-r--r--lib/checks/locations.ml (renamed from lib/syntax/locations.ml)3
-rw-r--r--lib/checks/nested_strings.ml (renamed from lib/syntax/nested_strings.ml)3
-rw-r--r--lib/checks/nested_strings.mli1
-rw-r--r--lib/checks/type_of.ml (renamed from lib/syntax/type_of.ml)3
-rw-r--r--lib/checks/type_of.mli (renamed from lib/syntax/type_of.mli)2
-rw-r--r--lib/checks/write_only.ml (renamed from lib/syntax/write_only.ml)3
-rw-r--r--lib/syntax/dup_test.mli1
-rw-r--r--lib/syntax/nested_strings.mli1
18 files changed, 98 insertions, 41 deletions
diff --git a/lib/syntax/check.ml b/lib/checks/check.ml
index b642945..76d5c34 100644
--- a/lib/syntax/check.ml
+++ b/lib/checks/check.ml
@@ -13,7 +13,7 @@ let get : type a. a Id.t -> result -> a option =
type t =
| E : {
module_ :
- (module S.Analyzer
+ (module Qsp_syntax.S.Analyzer
with type Expression.t = 'a
and type Expression.t' = 'b
and type Instruction.t = 'c
@@ -30,7 +30,7 @@ type t =
-> t
let build :
- (module S.Analyzer
+ (module Qsp_syntax.S.Analyzer
with type Expression.t = _
and type Expression.t' = _
and type Instruction.t = _
@@ -59,8 +59,8 @@ let build :
in
(location_witness, t)
-let get_module : t -> (module S.Analyzer) =
- fun (E { module_; _ }) -> (module_ :> (module S.Analyzer))
+let get_module : t -> (module Qsp_syntax.S.Analyzer) =
+ fun (E { module_; _ }) -> (module_ :> (module Qsp_syntax.S.Analyzer))
module type App = sig
val t : t array
@@ -100,7 +100,7 @@ module Make (A : App) = struct
let value = S.initialize () in
R { value; witness = context })
- let finalize : result Array.t -> (string * Report.t) list =
+ let finalize : result Array.t -> (string * Qsp_syntax.Report.t) list =
fun context_array ->
let _, report =
Array.fold_left A.t ~init:(0, [])
@@ -115,31 +115,32 @@ module Make (A : App) = struct
(* Global variable for the whole module *)
let len = Array.length A.t
- module Expression : S.Expression with type t' = result array = struct
+ module Expression : Qsp_syntax.S.Expression with type t' = result array =
+ struct
type t = result array
type t' = result array
- let literal : S.pos -> t T.literal list -> t =
+ let literal : Qsp_syntax.S.pos -> t Qsp_syntax.T.literal list -> t =
fun pos values ->
Array.mapi A.t ~f:(fun i (E { module_ = (module S); expr_witness; _ }) ->
(* Map every values to the Checker *)
let values' =
List.map values
~f:
- (T.map_litteral ~f:(fun expr ->
+ (Qsp_syntax.T.map_litteral ~f:(fun expr ->
Option.get (get expr_witness (Array.get expr i))))
in
let value = S.Expression.literal pos values' in
R { value; witness = expr_witness })
- let integer : S.pos -> string -> t =
+ let integer : Qsp_syntax.S.pos -> string -> t =
fun pos value ->
Array.map A.t ~f:(fun (E { module_ = (module S); expr_witness; _ }) ->
let value = S.Expression.integer pos value in
R { value; witness = expr_witness })
(** Unary operator like [-123] or [+'Text']*)
- let uoperator : S.pos -> T.uoperator -> t -> t =
+ let uoperator : Qsp_syntax.S.pos -> Qsp_syntax.T.uoperator -> t -> t =
fun pos op values ->
(* Evaluate the nested expression *)
let results = values in
@@ -167,7 +168,7 @@ module Make (A : App) = struct
(** Basically the same as uoperator, but operate over two operands instead
of a single one. *)
- let boperator : S.pos -> T.boperator -> t -> t -> t =
+ let boperator : Qsp_syntax.S.pos -> Qsp_syntax.T.boperator -> t -> t -> t =
fun pos op expr1 expr2 ->
Array.init len ~f:(fun i ->
let (E { module_ = (module S); expr_witness; _ }) = Array.get A.t i in
@@ -181,7 +182,7 @@ module Make (A : App) = struct
| _ -> failwith "Does not match")
(** Call a function. The functions list is hardcoded in lib/lexer.mll *)
- let function_ : S.pos -> T.function_ -> t list -> t =
+ let function_ : Qsp_syntax.S.pos -> Qsp_syntax.T.function_ -> t list -> t =
fun pos func args ->
Array.init len ~f:(fun i ->
let (E { module_ = (module S); expr_witness; _ }) = Array.get A.t i in
@@ -190,8 +191,8 @@ module Make (A : App) = struct
let value = S.Expression.function_ pos func args_i in
R { witness = expr_witness; value })
- let ident : (S.pos, t) S.variable -> t =
- fun { pos : S.pos; name : string; index : t option } ->
+ let ident : (Qsp_syntax.S.pos, t) Qsp_syntax.S.variable -> t =
+ fun { pos : Qsp_syntax.S.pos; name : string; index : t option } ->
Array.init len ~f:(fun i ->
let (E { module_ = (module S); expr_witness; _ }) = Array.get A.t i in
@@ -226,20 +227,20 @@ module Make (A : App) = struct
end
module Instruction :
- S.Instruction
+ Qsp_syntax.S.Instruction
with type expression = Expression.t'
and type t' = result array = struct
type expression = Expression.t'
type t = result array
type t' = result array
- let location : S.pos -> string -> t =
+ let location : Qsp_syntax.S.pos -> string -> t =
fun pos label ->
Array.map A.t ~f:(fun (E { module_ = (module S); instr_witness; _ }) ->
let value = S.Instruction.location pos label in
R { value; witness = instr_witness })
- let comment : S.pos -> t =
+ let comment : Qsp_syntax.S.pos -> t =
fun pos ->
Array.map A.t ~f:(fun (E { module_ = (module S); instr_witness; _ }) ->
let value = S.Instruction.comment pos in
@@ -256,7 +257,8 @@ module Make (A : App) = struct
let value = S.Instruction.expression value in
R { value; witness = instr_witness })
- let call : S.pos -> T.keywords -> expression list -> t =
+ let call : Qsp_syntax.S.pos -> Qsp_syntax.T.keywords -> expression list -> t
+ =
fun pos keyword args ->
(* The arguments are given like an array of array. Each expression is
actually the list of each expression in the differents modules. *)
@@ -270,7 +272,7 @@ module Make (A : App) = struct
let value = S.Instruction.call pos keyword values in
R { witness = instr_witness; value })
- let act : S.pos -> label:expression -> t list -> t =
+ let act : Qsp_syntax.S.pos -> label:expression -> t list -> t =
fun pos ~label instructions ->
Array.init len ~f:(fun i ->
let (E { module_ = (module S); instr_witness; expr'; _ }) =
@@ -289,9 +291,9 @@ module Make (A : App) = struct
(* I think it’s one of the longest module I’ve ever written in OCaml… *)
let assign :
- S.pos ->
- (S.pos, expression) S.variable ->
- T.assignation_operator ->
+ Qsp_syntax.S.pos ->
+ (Qsp_syntax.S.pos, expression) Qsp_syntax.S.variable ->
+ Qsp_syntax.T.assignation_operator ->
expression ->
t =
fun pos { pos = var_pos; name; index } op expression ->
@@ -306,7 +308,9 @@ module Make (A : App) = struct
Option.get (get expr' (Array.get expression i)))
index
in
- let variable = S.{ pos = var_pos; name; index = index_i } in
+ let variable =
+ Qsp_syntax.S.{ pos = var_pos; name; index = index_i }
+ in
match get expr' (Array.get expression i) with
| None -> failwith "Does not match"
@@ -320,8 +324,8 @@ module Make (A : App) = struct
int ->
a Id.t ->
b Id.t ->
- S.pos * result array * result array list ->
- (b, a) S.clause =
+ Qsp_syntax.S.pos * result array * result array list ->
+ (b, a) Qsp_syntax.S.clause =
fun i instr_witness expr' clause ->
let pos_clause, expr_clause, ts = clause in
match get expr' (Array.get expr_clause i) with
@@ -333,10 +337,10 @@ module Make (A : App) = struct
clause
let if_ :
- S.pos ->
- (expression, t) S.clause ->
- elifs:(expression, t) S.clause list ->
- else_:(S.pos * t list) option ->
+ Qsp_syntax.S.pos ->
+ (expression, t) Qsp_syntax.S.clause ->
+ elifs:(expression, t) Qsp_syntax.S.clause list ->
+ else_:(Qsp_syntax.S.pos * t list) option ->
t =
fun pos clause ~elifs ~else_ ->
(* First, apply the report for all the instructions *)
@@ -381,14 +385,14 @@ module Make (A : App) = struct
end
module Location :
- S.Location
+ Qsp_syntax.S.Location
with type t = result array
and type instruction = Instruction.t'
and type context := context = struct
type instruction = Instruction.t'
type t = result array
- let location : context -> S.pos -> instruction list -> t =
+ let location : context -> Qsp_syntax.S.pos -> instruction list -> t =
fun local_context pos args ->
ignore pos;
@@ -410,7 +414,7 @@ module Make (A : App) = struct
in
result
- let v : t -> Report.t list =
+ let v : t -> Qsp_syntax.Report.t list =
fun args ->
let report = ref [] in
let () =
diff --git a/lib/syntax/check.mli b/lib/checks/check.mli
index 7db719d..321b67b 100644
--- a/lib/syntax/check.mli
+++ b/lib/checks/check.mli
@@ -19,11 +19,27 @@ module Id : sig
(** The type created on-the-fly. *)
end
-type t
-(** Type of check to apply *)
+type t =
+ | E : {
+ module_ :
+ (module Qsp_syntax.S.Analyzer
+ 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);
+ expr_witness : 'a Id.t;
+ expr' : 'b Id.t;
+ instr_witness : 'c Id.t;
+ instr' : 'd Id.t;
+ location_witness : 'e Id.t;
+ context : 'f Id.t;
+ }
+ -> t (** Type of check to apply *)
val build :
- (module S.Analyzer
+ (module Qsp_syntax.S.Analyzer
with type Expression.t = _
and type Expression.t' = _
and type Instruction.t = _
@@ -36,7 +52,7 @@ ypeid
Return the result type which hold the final result value, and checker
itself. *)
-val get_module : t -> (module S.Analyzer)
+val get_module : t -> (module Qsp_syntax.S.Analyzer)
type result
@@ -48,6 +64,6 @@ val get : 'a Id.t -> result -> 'a option
module Make (A : sig
val t : t array
end) : sig
- include S.Analyzer with type Location.t = result array
+ include Qsp_syntax.S.Analyzer with type Location.t = result array
end
[@@warning "-67"]
diff --git a/lib/syntax/compose.ml b/lib/checks/compose.ml
index 8c92ed0..4517755 100644
--- a/lib/syntax/compose.ml
+++ b/lib/checks/compose.ml
@@ -1,6 +1,8 @@
(** Build a module with the result from another one module *)
open StdLabels
+module S = Qsp_syntax.S
+module T = Qsp_syntax.T
(** Make a module lazy *)
module Lazier (E : S.Expression) :
diff --git a/lib/syntax/dead_end.ml b/lib/checks/dead_end.ml
index c0dbc58..629a966 100644
--- a/lib/syntax/dead_end.ml
+++ b/lib/checks/dead_end.ml
@@ -1,4 +1,7 @@
open StdLabels
+module S = Qsp_syntax.S
+module T = Qsp_syntax.T
+module Report = Qsp_syntax.Report
let identifier = "dead_end"
let description = "Check for dead end in the code"
diff --git a/lib/syntax/dead_end.mli b/lib/checks/dead_end.mli
index 451fe58..d8fe7d6 100644
--- a/lib/syntax/dead_end.mli
+++ b/lib/checks/dead_end.mli
@@ -3,4 +3,4 @@
A dead end is a state where the user does not have any action.
*)
-include S.Analyzer
+include Qsp_syntax.S.Analyzer
diff --git a/lib/syntax/default.ml b/lib/checks/default.ml
index d345401..a2b53f6 100644
--- a/lib/syntax/default.ml
+++ b/lib/checks/default.ml
@@ -3,6 +3,10 @@
This module is expected to be used when you only need to implement an analyze
over a limited part of the whole syntax. *)
+module S = Qsp_syntax.S
+module T = Qsp_syntax.T
+module Report = Qsp_syntax.Report
+
module type T = sig
type t
diff --git a/lib/checks/dune b/lib/checks/dune
new file mode 100644
index 0000000..d7db2f3
--- /dev/null
+++ b/lib/checks/dune
@@ -0,0 +1,9 @@
+(library
+ (name qsp_checks)
+ (libraries
+ qsp_syntax
+ )
+
+ (preprocess (pps
+ ppx_deriving.show ppx_deriving.enum
+ ppx_deriving.eq )))
diff --git a/lib/syntax/dup_test.ml b/lib/checks/dup_test.ml
index 20faa56..e392445 100644
--- a/lib/syntax/dup_test.ml
+++ b/lib/checks/dup_test.ml
@@ -6,6 +6,10 @@
*)
open StdLabels
+module S = Qsp_syntax.S
+module T = Qsp_syntax.T
+module Report = Qsp_syntax.Report
+module Tree = Qsp_syntax.Tree
let identifier = "duplicate_test"
let description = "Check for duplicate tests"
diff --git a/lib/checks/dup_test.mli b/lib/checks/dup_test.mli
new file mode 100644
index 0000000..6446c67
--- /dev/null
+++ b/lib/checks/dup_test.mli
@@ -0,0 +1 @@
+include Qsp_syntax.S.Analyzer
diff --git a/lib/syntax/get_type.ml b/lib/checks/get_type.ml
index b22f53c..b34dc17 100644
--- a/lib/syntax/get_type.ml
+++ b/lib/checks/get_type.ml
@@ -1,4 +1,7 @@
open StdLabels
+module S = Qsp_syntax.S
+module T = Qsp_syntax.T
+module Report = Qsp_syntax.Report
type type_of =
| Integer (** A numeric value *)
diff --git a/lib/syntax/locations.ml b/lib/checks/locations.ml
index 17f33bd..8ee6ffa 100644
--- a/lib/syntax/locations.ml
+++ b/lib/checks/locations.ml
@@ -1,4 +1,7 @@
open StdLabels
+module S = Qsp_syntax.S
+module T = Qsp_syntax.T
+module Report = Qsp_syntax.Report
module IgnoreCaseString = struct
type t = string
diff --git a/lib/syntax/nested_strings.ml b/lib/checks/nested_strings.ml
index dee7af0..e4ffb68 100644
--- a/lib/syntax/nested_strings.ml
+++ b/lib/checks/nested_strings.ml
@@ -1,4 +1,7 @@
open StdLabels
+module S = Qsp_syntax.S
+module T = Qsp_syntax.T
+module Report = Qsp_syntax.Report
let identifier = "escaped_string"
let description = "Check for unnecessary use of expression encoded in string"
diff --git a/lib/checks/nested_strings.mli b/lib/checks/nested_strings.mli
new file mode 100644
index 0000000..6446c67
--- /dev/null
+++ b/lib/checks/nested_strings.mli
@@ -0,0 +1 @@
+include Qsp_syntax.S.Analyzer
diff --git a/lib/syntax/type_of.ml b/lib/checks/type_of.ml
index 97b7f91..70ae324 100644
--- a/lib/syntax/type_of.ml
+++ b/lib/checks/type_of.ml
@@ -1,4 +1,7 @@
open StdLabels
+module S = Qsp_syntax.S
+module T = Qsp_syntax.T
+module Report = Qsp_syntax.Report
let identifier = "type_check"
let description = "Ensure all the expression are correctly typed"
diff --git a/lib/syntax/type_of.mli b/lib/checks/type_of.mli
index 551f9ac..de0f8f9 100644
--- a/lib/syntax/type_of.mli
+++ b/lib/checks/type_of.mli
@@ -1,4 +1,4 @@
-include S.Analyzer
+include Qsp_syntax.S.Analyzer
(** The module [type_of] populate the report with differents inconsistency
errors in the types.
diff --git a/lib/syntax/write_only.ml b/lib/checks/write_only.ml
index ec2e368..8363703 100644
--- a/lib/syntax/write_only.ml
+++ b/lib/checks/write_only.ml
@@ -1,6 +1,9 @@
(** Check all the write_only variables *)
open StdLabels
+module S = Qsp_syntax.S
+module T = Qsp_syntax.T
+module Report = Qsp_syntax.Report
(** Identifier for the module *)
let identifier = "write_only"
diff --git a/lib/syntax/dup_test.mli b/lib/syntax/dup_test.mli
deleted file mode 100644
index 38e3a1b..0000000
--- a/lib/syntax/dup_test.mli
+++ /dev/null
@@ -1 +0,0 @@
-include S.Analyzer
diff --git a/lib/syntax/nested_strings.mli b/lib/syntax/nested_strings.mli
deleted file mode 100644
index 38e3a1b..0000000
--- a/lib/syntax/nested_strings.mli
+++ /dev/null
@@ -1 +0,0 @@
-include S.Analyzer