Skip to content
This repository was archived by the owner on Jan 30, 2026. It is now read-only.

Commit ba3afd3

Browse files
StevendeoStevendeo
committed
Ajout du module Print
1 parent fe0dca6 commit ba3afd3

5 files changed

Lines changed: 544 additions & 309 deletions

File tree

‎src/mlang/mir_interpreter/context.ml‎

Lines changed: 272 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,100 @@
11
open Types
22

3+
module type S = sig
4+
type custom_float
5+
6+
val get_var_space :
7+
custom_float Types.ctx -> M_ir.Com.var_space -> M_ir.Com.variable_space
8+
9+
val get_var :
10+
custom_float Types.ctx ->
11+
M_ir.Com.var_space ->
12+
M_ir.Com.Var.t ->
13+
M_ir.Com.variable_space * M_ir.Com.Var.t * int
14+
15+
val get_var_tab :
16+
custom_float Types.ctx -> M_ir.Com.Var.t -> int -> M_ir.Com.Var.t
17+
18+
val get_var_value_org :
19+
custom_float Types.ctx ->
20+
M_ir.Com.variable_space ->
21+
M_ir.Com.Var.t ->
22+
int ->
23+
custom_float Types.value
24+
25+
val get_var_value :
26+
custom_float Types.ctx ->
27+
M_ir.Com.var_space ->
28+
M_ir.Com.Var.t ->
29+
custom_float Types.value
30+
31+
val get_var_value_tab :
32+
custom_float Types.ctx ->
33+
M_ir.Com.var_space ->
34+
M_ir.Com.Var.t ->
35+
int ->
36+
custom_float Types.value
37+
38+
val set_var_ref :
39+
custom_float Types.ctx ->
40+
M_ir.Com.Var.t ->
41+
M_ir.Com.variable_space ->
42+
M_ir.Com.Var.t ->
43+
int ->
44+
unit
45+
46+
val get_access_value :
47+
eval:
48+
(custom_float Types.ctx ->
49+
M_ir.Com.Var.t M_ir.Com.m_expression ->
50+
custom_float Types.value) ->
51+
custom_float Types.ctx ->
52+
M_ir.Com.Var.t M_ir.Com.access ->
53+
custom_float Types.value
54+
55+
val get_access_var :
56+
eval:
57+
(custom_float Types.ctx ->
58+
M_ir.Com.Var.t M_ir.Com.m_expression ->
59+
custom_float Types.value) ->
60+
custom_float Types.ctx ->
61+
M_ir.Com.Var.t M_ir.Com.access ->
62+
(M_ir.Com.variable_space * M_ir.Com.Var.t * int) option
63+
64+
val set_var_value_org :
65+
custom_float Types.ctx ->
66+
M_ir.Com.variable_space ->
67+
M_ir.Com.Var.t ->
68+
int ->
69+
custom_float Types.value ->
70+
unit
71+
72+
val set_var_value :
73+
custom_float Types.ctx ->
74+
M_ir.Com.var_space ->
75+
M_ir.Com.Var.t ->
76+
custom_float Types.value ->
77+
unit
78+
79+
val set_var_value_tab :
80+
custom_float Types.ctx ->
81+
M_ir.Com.var_space ->
82+
M_ir.Com.Var.t ->
83+
int ->
84+
custom_float Types.value ->
85+
unit
86+
87+
val set_access :
88+
eval:
89+
(custom_float Types.ctx ->
90+
M_ir.Com.Var.t M_ir.Com.m_expression ->
91+
custom_float Types.value) ->
92+
custom_float Types.ctx ->
93+
M_ir.Com.Var.t M_ir.Com.access ->
94+
custom_float Types.value ->
95+
unit
96+
end
97+
398
let update_ctx_with_inputs (ctx : 'a ctx)
499
(value_inputs : 'a value Com.Var.Map.t) : unit =
5100
(* let value_inputs = *)
@@ -136,3 +231,180 @@ let empty_ctx ?inputs ?events (p : M_ir.Mir.program) : 'a ctx =
136231
Option.iter (update_ctx_with_inputs res) inputs;
137232
Option.iter (update_ctx_with_events res) events;
138233
res
234+
235+
module Make (N : M_ir.Mir_number.NumberInterface) = struct
236+
let get_var_space (ctx : N.t ctx) (m_sp_opt : Com.var_space) =
237+
let i_sp =
238+
match m_sp_opt with None -> ctx.ctx_var_space | Some (_, i_sp) -> i_sp
239+
in
240+
IntMap.find i_sp ctx.ctx_prog.program_var_spaces_idx
241+
242+
let get_var (ctx : N.t ctx) (m_sp_opt : Com.var_space) (var : Com.Var.t) :
243+
Com.variable_space * Com.Var.t * int =
244+
match var.scope with
245+
| Com.Var.Tgv _ -> (get_var_space ctx m_sp_opt, var, 0)
246+
| Com.Var.Temp _ -> (get_var_space ctx None, var, ctx.ctx_tmps_org)
247+
| Com.Var.Ref ->
248+
let rv = ctx.ctx_ref.(ctx.ctx_ref_org + Com.Var.loc_idx var) in
249+
let vsd =
250+
match m_sp_opt with
251+
| None -> rv.var_space
252+
| _ -> get_var_space ctx m_sp_opt
253+
in
254+
(vsd, rv.ref_var, rv.org)
255+
256+
let get_var_tab (ctx : N.t ctx) (var : Com.Var.t) (i : int) : Com.Var.t =
257+
match Com.Var.get_table var with
258+
| Some _ -> ctx.ctx_tab_map.(Com.Var.loc_tab_idx var + 1 + i)
259+
| None -> assert false
260+
261+
let get_var_value_org (ctx : N.t ctx) (vsd : Com.variable_space)
262+
(var : Com.Var.t) (vorg : int) : N.t value =
263+
let vi = Com.Var.loc_idx var in
264+
match var.scope with
265+
| Com.Var.Tgv _ ->
266+
let var_space = ctx.ctx_var_spaces.(vsd.vs_id) in
267+
let var_tab =
268+
match Com.Var.cat_var_loc var with
269+
| LocInput -> var_space.input
270+
| LocComputed -> var_space.computed
271+
| LocBase -> var_space.base
272+
in
273+
if Array.length var_tab > 0 then var_tab.(vi) else Undefined
274+
| Com.Var.Temp _ -> ctx.ctx_tmps.(vorg + vi).value
275+
| Com.Var.Ref -> assert false
276+
277+
let get_var_value (ctx : N.t ctx) (m_sp_opt : Com.var_space) (v : Com.Var.t) :
278+
N.t value =
279+
let vsd, var, vorg = get_var ctx m_sp_opt v in
280+
let var = if Com.Var.is_table var then get_var_tab ctx var 0 else var in
281+
get_var_value_org ctx vsd var vorg
282+
283+
let get_var_value_tab (ctx : N.t ctx) (m_sp_opt : Com.var_space)
284+
(v : Com.Var.t) (i : int) : N.t value =
285+
let vsd, var, vorg = get_var ctx m_sp_opt v in
286+
if i < 0 then Number (N.zero ())
287+
else if Com.Var.size var <= i then Undefined
288+
else if Com.Var.is_table var then
289+
let var_i = get_var_tab ctx var i in
290+
get_var_value_org ctx vsd var_i vorg
291+
else get_var_value_org ctx vsd var vorg
292+
293+
let set_var_ref (ctx : N.t ctx) (var : Com.Var.t)
294+
(var_space : Com.variable_space) (ref_var : Com.Var.t) (org : int) : unit
295+
=
296+
match var.loc with
297+
| LocRef (_, i) ->
298+
ctx.ctx_ref.(ctx.ctx_ref_org + i).var <- var;
299+
ctx.ctx_ref.(ctx.ctx_ref_org + i).var_space <- var_space;
300+
ctx.ctx_ref.(ctx.ctx_ref_org + i).ref_var <- ref_var;
301+
ctx.ctx_ref.(ctx.ctx_ref_org + i).org <- org
302+
| _ -> assert false
303+
304+
let rec get_access_value ~eval ctx access =
305+
match access with
306+
| Com.VarAccess (m_sp_opt, v) -> get_var_value ctx m_sp_opt v
307+
| Com.TabAccess ((m_sp_opt, v), m_idx) -> (
308+
match eval ctx m_idx with
309+
| Number z ->
310+
let i = Int64.to_int @@ N.to_int z in
311+
get_var_value_tab ctx m_sp_opt v i
312+
| Undefined -> Undefined)
313+
| Com.FieldAccess (m_sp_opt, e, _, j) -> (
314+
match eval ctx e with
315+
| Number z ->
316+
let i = Int64.to_int @@ N.to_int z in
317+
let events = List.hd ctx.ctx_events in
318+
if 0 <= i && i < Array.length events then
319+
match events.(i).(j) with
320+
| Com.Numeric n -> n
321+
| Com.RefVar v -> get_var_value ctx m_sp_opt v
322+
else Undefined
323+
| Undefined -> Undefined)
324+
325+
and get_access_var ~eval ctx access =
326+
match access with
327+
| Com.VarAccess (m_sp_opt, v) ->
328+
let vsd, v, vorg = get_var ctx m_sp_opt v in
329+
Some (vsd, v, vorg)
330+
| Com.TabAccess ((m_sp_opt, m_v), m_i) -> (
331+
match eval ctx m_i with
332+
| Number z ->
333+
let vsd, v, vorg = get_var ctx m_sp_opt m_v in
334+
let i = Int64.to_int @@ N.to_int z in
335+
if 0 <= i && i < Com.Var.size v then
336+
if Com.Var.is_table v then
337+
let v_i = get_var_tab ctx v i in
338+
Some (vsd, v_i, vorg)
339+
else Some (vsd, v, vorg)
340+
else None
341+
| Undefined -> None)
342+
| Com.FieldAccess (m_sp_opt, m_e, _, j) -> (
343+
match eval ctx m_e with
344+
| Number z ->
345+
let i = Int64.to_int @@ N.to_int z in
346+
let events = List.hd ctx.ctx_events in
347+
if 0 <= i && i < Array.length events then
348+
match events.(i).(j) with
349+
| Com.RefVar v ->
350+
let vsd, var, vorg = get_var ctx m_sp_opt v in
351+
Some (vsd, var, vorg)
352+
| Com.Numeric _ -> None
353+
else None
354+
| _ -> None)
355+
356+
and set_var_value_org (ctx : N.t ctx) (vsd : Com.variable_space)
357+
(var : Com.Var.t) (vorg : int) (value : N.t value) : unit =
358+
let vi = Com.Var.loc_idx var in
359+
match var.scope with
360+
| Com.Var.Tgv _ ->
361+
let var_space = ctx.ctx_var_spaces.(vsd.vs_id) in
362+
let var_tab =
363+
match Com.Var.cat_var_loc var with
364+
| LocInput -> var_space.input
365+
| LocComputed -> var_space.computed
366+
| LocBase -> var_space.base
367+
in
368+
if Array.length var_tab > 0 then var_tab.(vi) <- value
369+
| Com.Var.Temp _ -> ctx.ctx_tmps.(vorg + vi).value <- value
370+
| Com.Var.Ref -> assert false
371+
372+
and set_var_value (ctx : N.t ctx) (m_sp_opt : Com.var_space) (var : Com.Var.t)
373+
(value : N.t value) : unit =
374+
let vsd, v, vorg = get_var ctx m_sp_opt var in
375+
if Com.Var.is_table v then
376+
for i = 0 to Com.Var.size v - 1 do
377+
let v_i = get_var_tab ctx v i in
378+
set_var_value_org ctx vsd v_i vorg value
379+
done
380+
else set_var_value_org ctx vsd v vorg value
381+
382+
and set_var_value_tab (ctx : N.t ctx) (m_sp_opt : Com.var_space)
383+
(v : Com.Var.t) (i : int) (value : N.t value) : unit =
384+
let vsd, var, vorg = get_var ctx m_sp_opt v in
385+
if 0 <= i && i < Com.Var.size var then
386+
if Com.Var.is_table var then
387+
let var_i = get_var_tab ctx var i in
388+
set_var_value_org ctx vsd var_i vorg value
389+
else set_var_value_org ctx vsd var vorg value
390+
391+
and set_access ~eval ctx access value =
392+
match access with
393+
| Com.VarAccess (m_sp_opt, v) -> set_var_value ctx m_sp_opt v value
394+
| Com.TabAccess ((m_sp_opt, v), m_idx) -> (
395+
match eval ctx m_idx with
396+
| Number z ->
397+
let i = Int64.to_int @@ N.to_int z in
398+
set_var_value_tab ctx m_sp_opt v i value
399+
| Undefined -> ())
400+
| Com.FieldAccess (m_sp_opt, e, _, j) -> (
401+
match eval ctx e with
402+
| Number z -> (
403+
let i = Int64.to_int @@ N.to_int z in
404+
let events = List.hd ctx.ctx_events in
405+
if 0 <= i && i < Array.length events then
406+
match events.(i).(j) with
407+
| Com.Numeric _ -> events.(i).(j) <- Com.Numeric value
408+
| Com.RefVar v -> set_var_value ctx m_sp_opt v value)
409+
| Undefined -> ())
410+
end

‎src/mlang/mir_interpreter/context.mli‎

Lines changed: 107 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,107 @@
1+
module type S = sig
2+
type custom_float
3+
4+
val get_var_space :
5+
custom_float Types.ctx -> M_ir.Com.var_space -> M_ir.Com.variable_space
6+
(** Returns the variable space of a given variable. *)
7+
8+
val get_var :
9+
custom_float Types.ctx ->
10+
M_ir.Com.var_space ->
11+
M_ir.Com.Var.t ->
12+
M_ir.Com.variable_space * M_ir.Com.Var.t * int
13+
(** Returns the variable identifier and its space, with an offset integer.
14+
This offset integer is 0 for TGV variables
15+
*)
16+
17+
val get_var_tab :
18+
custom_float Types.ctx -> M_ir.Com.Var.t -> int -> M_ir.Com.Var.t
19+
(** [get_var_tab ctx vs v i]
20+
Each cell of a table is a separate variable. This function
21+
returns the variable representing the cell [i] in table [v].
22+
Fails if the variable in argument is not a table. *)
23+
24+
val get_var_value_org :
25+
custom_float Types.ctx ->
26+
M_ir.Com.variable_space ->
27+
M_ir.Com.Var.t ->
28+
int ->
29+
custom_float Types.value
30+
(** *)
31+
32+
val get_var_value :
33+
custom_float Types.ctx ->
34+
M_ir.Com.var_space ->
35+
M_ir.Com.Var.t ->
36+
custom_float Types.value
37+
38+
val get_var_value_tab :
39+
custom_float Types.ctx ->
40+
M_ir.Com.var_space ->
41+
M_ir.Com.Var.t ->
42+
int ->
43+
custom_float Types.value
44+
45+
val set_var_ref :
46+
custom_float Types.ctx ->
47+
M_ir.Com.Var.t ->
48+
M_ir.Com.variable_space ->
49+
M_ir.Com.Var.t ->
50+
int ->
51+
unit
52+
53+
val get_access_value :
54+
eval:
55+
(custom_float Types.ctx ->
56+
M_ir.Com.Var.t M_ir.Com.m_expression ->
57+
custom_float Types.value) ->
58+
custom_float Types.ctx ->
59+
M_ir.Com.Var.t M_ir.Com.access ->
60+
custom_float Types.value
61+
62+
val get_access_var :
63+
eval:
64+
(custom_float Types.ctx ->
65+
M_ir.Com.Var.t M_ir.Com.m_expression ->
66+
custom_float Types.value) ->
67+
custom_float Types.ctx ->
68+
M_ir.Com.Var.t M_ir.Com.access ->
69+
(M_ir.Com.variable_space * M_ir.Com.Var.t * int) option
70+
71+
val set_var_value_org :
72+
custom_float Types.ctx ->
73+
M_ir.Com.variable_space ->
74+
M_ir.Com.Var.t ->
75+
int ->
76+
custom_float Types.value ->
77+
unit
78+
79+
val set_var_value :
80+
custom_float Types.ctx ->
81+
M_ir.Com.var_space ->
82+
M_ir.Com.Var.t ->
83+
custom_float Types.value ->
84+
unit
85+
86+
val set_var_value_tab :
87+
custom_float Types.ctx ->
88+
M_ir.Com.var_space ->
89+
M_ir.Com.Var.t ->
90+
int ->
91+
custom_float Types.value ->
92+
unit
93+
94+
val set_access :
95+
eval:
96+
(custom_float Types.ctx ->
97+
M_ir.Com.Var.t M_ir.Com.m_expression ->
98+
custom_float Types.value) ->
99+
custom_float Types.ctx ->
100+
M_ir.Com.Var.t M_ir.Com.access ->
101+
custom_float Types.value ->
102+
unit
103+
end
104+
1105
val empty_ctx :
2106
?inputs:'a Types.value M_ir.Com.Var.Map.t ->
3107
?events:('a Types.value, M_ir.Com.Var.t) M_ir.Com.event_value StrMap.t list ->
@@ -9,3 +113,6 @@ val empty_ctx :
9113
the context of [p] (for example, with variables declared in [p].
10114
Parameters [inputs] and [events] are required for interpreting the whole
11115
program. *)
116+
117+
module Make (N : M_ir.Mir_number.NumberInterface) :
118+
S with type custom_float := N.t

0 commit comments

Comments
 (0)