aboutsummaryrefslogtreecommitdiff
path: root/lib/syntax/check.ml
diff options
context:
space:
mode:
authorChimrod <>2024-02-04 10:37:04 +0100
committerChimrod <>2024-02-08 14:12:45 +0100
commit6fd720c07e3e361932e01bfbdbe4637c8f610649 (patch)
tree26f983295d8674a08fc9367aaac820c0ace675bc /lib/syntax/check.ml
parent35ef1827a216a1deb6d15f916ff197b0c75bc83e (diff)
Added a general context for each test
Diffstat (limited to 'lib/syntax/check.ml')
-rw-r--r--lib/syntax/check.ml60
1 files changed, 44 insertions, 16 deletions
diff --git a/lib/syntax/check.ml b/lib/syntax/check.ml
index 6737e80..a5db091 100644
--- a/lib/syntax/check.ml
+++ b/lib/syntax/check.ml
@@ -55,12 +55,14 @@ type t =
and type Expression.t' = 'b
and type Instruction.t = 'c
and type Instruction.t' = 'd
- and type Location.t = 'e);
+ and type Location.t = 'e
+ and type context = 'f);
expr_witness : 'a Id.typeid;
expr' : 'b Id.typeid;
instr_witness : 'c Id.typeid;
instr' : 'd Id.typeid;
location_witness : 'e Id.typeid;
+ context : 'f Id.typeid;
}
-> t
@@ -70,16 +72,27 @@ let build :
and type Expression.t' = _
and type Instruction.t = _
and type Instruction.t' = _
- and type Location.t = 'a) ->
+ and type Location.t = 'a
+ and type context = _) ->
'a Id.typeid * t =
fun module_ ->
let expr_witness = Id.newtype ()
and expr' = Id.newtype ()
and instr_witness = Id.newtype ()
and instr' = Id.newtype ()
- and location_witness = Id.newtype () in
+ and location_witness = Id.newtype ()
+ and context = Id.newtype () in
let t =
- E { module_; expr_witness; expr'; instr_witness; instr'; location_witness }
+ E
+ {
+ module_;
+ expr_witness;
+ expr';
+ instr_witness;
+ instr';
+ location_witness;
+ context;
+ }
in
(location_witness, t)
@@ -112,6 +125,17 @@ module Make (A : App) = struct
let description = "Internal module"
let active = ref false
+ type context = result Array.t
+ (** We associate each context from the differents test in an array. The
+ context for this module is a sort of context of contexts *)
+
+ (** Initialize each test, and keep the result in the context. *)
+ let initialize : unit -> context =
+ fun () ->
+ Array.map A.t ~f:(fun (E { module_ = (module S); context; _ }) ->
+ let value = S.initialize () in
+ R { value; witness = context })
+
(* Global variable for the whole module *)
let len = Array.length A.t
@@ -127,9 +151,7 @@ module Make (A : App) = struct
List.map values
~f:
(T.map_litteral ~f:(fun expr ->
- match get expr_witness (Array.get expr i) with
- | None -> failwith "Does not match"
- | Some value -> value))
+ Option.get (get expr_witness (Array.get expr i))))
in
let value = S.Expression.literal pos values' in
R { value; witness = expr_witness })
@@ -305,9 +327,7 @@ module Make (A : App) = struct
let index_i =
Option.map
(fun expression ->
- match get expr' (Array.get expression i) with
- | None -> failwith "Does not match"
- | Some value -> value)
+ Option.get (get expr' (Array.get expression i)))
index
in
let variable = S.{ pos = var_pos; name; index = index_i } in
@@ -385,23 +405,31 @@ module Make (A : App) = struct
end
module Location :
- S.Location with type t = result array and type instruction = Instruction.t' =
- struct
+ 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 : S.pos -> instruction list -> t =
- fun pos args ->
+ let location : context -> S.pos -> instruction list -> t =
+ fun local_context pos args ->
ignore pos;
let result =
Array.init len ~f:(fun i ->
- let (E { module_ = (module A); instr'; location_witness; _ }) =
+ let (E
+ { module_ = (module A); instr'; location_witness; context; _ })
+ =
Array.get A.t i
in
+ let local_context =
+ Option.get (get context (Array.get local_context i))
+ in
+
let instructions = List.rev (Helper.expr_i args instr' i).values in
- let value = A.Location.location pos instructions in
+ let value = A.Location.location local_context pos instructions in
R { value; witness = location_witness })
in
result