Skip to content

Commit 1e690fd

Browse files
StevendeoStevendeo
committed
Un peu de reformulation
1 parent ba3afd3 commit 1e690fd

6 files changed

Lines changed: 92 additions & 58 deletions

File tree

‎src/mlang/m_ir/mir_number.ml‎

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,8 @@ module type NumberInterface = sig
7676
val compare : ?epsilon:float -> Com.comp_op -> t -> t -> bool
7777
end
7878

79-
module MakeComparable (N : NumberInterfaceNoCompare) : NumberInterface = struct
79+
module MakeComparable (N : NumberInterfaceNoCompare) :
80+
NumberInterface with type t = N.t = struct
8081
include N
8182

8283
let compare ?(epsilon = !Config.comparison_error_margin) op i1 i2 =
@@ -91,7 +92,8 @@ module MakeComparable (N : NumberInterfaceNoCompare) : NumberInterface = struct
9192
| Neq -> abs (i1 -. i2) >=. epsilon
9293
end
9394

94-
module RegularFloatNumber : NumberInterface = MakeComparable (struct
95+
module RegularFloatNumber : NumberInterface with type t = float =
96+
MakeComparable (struct
9597
type t = float
9698

9799
let format_t fmt f = Format.fprintf fmt "%f" f
@@ -172,7 +174,8 @@ let mpfr_ceil (x : Mpfrf.t) : Mpfrf.t =
172174
ignore (Mpfr.ceil out x);
173175
Mpfrf.of_mpfr out
174176

175-
module MPFRNumber : NumberInterface = MakeComparable (struct
177+
module MPFRNumber : NumberInterface with type t = Mpfrf.t =
178+
MakeComparable (struct
176179
type t = Mpfrf.t
177180

178181
let rounding : Mpfr.round = Near
@@ -349,7 +352,8 @@ module IntervalNumber : NumberInterface = MakeComparable (struct
349352
let is_nan_or_inf x = not (Mpfrf.number_p x.down && Mpfrf.number_p x.up)
350353
end)
351354

352-
module RationalNumber : NumberInterface = MakeComparable (struct
355+
module RationalNumber : NumberInterface with type t = Mpqf.t =
356+
MakeComparable (struct
353357
type t = Mpqf.t
354358

355359
let format_t fmt f = Mpqf.print fmt f
@@ -421,7 +425,7 @@ end)
421425

422426
module BigIntFixedPointNumber (P : sig
423427
val scaling_factor_bits : int ref
424-
end) : NumberInterface = MakeComparable (struct
428+
end) : NumberInterface with type t = Mpzf.t = MakeComparable (struct
425429
type t = Mpzf.t
426430

427431
let precision_modulo () =

‎src/mlang/m_ir/mir_number.mli‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -72,18 +72,18 @@ module type NumberInterface = sig
7272
of the current configuration. *)
7373
end
7474

75-
module RegularFloatNumber : NumberInterface
75+
module RegularFloatNumber : NumberInterface with type t = float
7676

7777
val mpfr_floor : Mpfrf.t -> Mpfrf.t
7878

79-
module MPFRNumber : NumberInterface
79+
module MPFRNumber : NumberInterface with type t = Mpfrf.t
8080

8181
module IntervalNumber : NumberInterface
8282

83-
module RationalNumber : NumberInterface
83+
module RationalNumber : NumberInterface with type t = Mpqf.t
8484

8585
module BigIntFixedPointNumber : functor
8686
(P : sig
8787
val scaling_factor_bits : int ref
8888
end)
89-
-> NumberInterface
89+
-> NumberInterface with type t = Mpzf.t

‎src/mlang/mir_interpreter/eval.ml‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,37 @@ exception Stop_instruction of Com.stop_kind
2121

2222
let exit_on_rte = ref true
2323

24+
module type S = sig
25+
type custom_float
26+
27+
type nonrec ctx = custom_float ctx
28+
29+
exception InternalRuntimeError of run_error * ctx
30+
31+
(** {2 M Evaluation} *)
32+
33+
val evaluate_expr :
34+
ctx -> M_ir.Mir.expression Pos.marked -> custom_float value
35+
(** Evaluates an expression. *)
36+
37+
val evaluate_program : ctx -> unit
38+
(** Evaluates a whole program. Proper initialisation of inputs and events
39+
is required before calling this function (through [update_ctx_with_inputs]
40+
and [update_ctx_with_events]. *)
41+
42+
(** {2 Helpers} *)
43+
44+
(** These helpers are here for compatibility with {!module: Context}. *)
45+
46+
val literal_to_value : Com.literal -> custom_float value
47+
48+
val value_to_literal : custom_float value -> Com.literal
49+
50+
val literal_event_to_value_event :
51+
(Com.literal, Com.Var.t) Com.event_value ->
52+
(custom_float value, Com.Var.t) Com.event_value
53+
end
54+
2455
module Make (N : Mir_number.NumberInterface) (RF : Mir_roundops.RoundOpsFunctor) :
2556
S with type custom_float = N.t = struct
2657
(* Careful : this behavior mimics the one imposed by the original Mlang

‎src/mlang/mir_interpreter/eval.mli‎

Lines changed: 47 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -2,50 +2,80 @@
22

33
val exit_on_rte : bool ref
44

5+
module type S = sig
6+
type custom_float
7+
8+
type ctx = custom_float Types.ctx
9+
10+
exception InternalRuntimeError of Types.run_error * ctx
11+
12+
(** {2 M Evaluation} *)
13+
14+
val evaluate_expr :
15+
ctx -> M_ir.Mir.expression Pos.marked -> custom_float Types.value
16+
(** Evaluates an expression. *)
17+
18+
val evaluate_program : ctx -> unit
19+
(** Evaluates a whole program. Proper initialisation of inputs and events
20+
is required before calling this function (through [update_ctx_with_inputs]
21+
and [update_ctx_with_events]. *)
22+
23+
(** {2 Helpers} *)
24+
25+
(** These helpers are here for compatibility with {!module: Context}. *)
26+
27+
val literal_to_value : M_ir.Com.literal -> custom_float Types.value
28+
29+
val value_to_literal : custom_float Types.value -> M_ir.Com.literal
30+
31+
val literal_event_to_value_event :
32+
(M_ir.Com.literal, M_ir.Com.Var.t) M_ir.Com.event_value ->
33+
(custom_float Types.value, M_ir.Com.Var.t) M_ir.Com.event_value
34+
end
35+
536
(** {2 Engine builder} *)
637

738
(** Builds an intepretation engine from a number interface
839
({!module: M_ir.Mir_number}) and a rounding strategy
940
({!module: M_ir.Mir_roundops}). *)
1041
module Make
1142
(N : M_ir.Mir_number.NumberInterface)
12-
(RF : M_ir.Mir_roundops.RoundOpsFunctor) :
13-
Types.S with type custom_float = N.t
43+
(RF : M_ir.Mir_roundops.RoundOpsFunctor) : S with type custom_float = N.t
1444

1545
(** {2 Engines} *)
1646

1747
(** These modules are instanes of Make with modules defined in
1848
{!module: M_ir.Mir_number} and {!module: M_ir.Mir_roundops}. *)
1949

20-
module FloatDefInterp : Types.S
50+
module FloatDefInterp : S with type custom_float = float
2151

22-
module FloatMultInterp : Types.S
52+
module FloatMultInterp : S with type custom_float = float
2353

24-
module FloatMfInterp : Types.S
54+
module FloatMfInterp : S with type custom_float = float
2555

26-
module MPFRDefInterp : Types.S
56+
module MPFRDefInterp : S with type custom_float = Mpfrf.t
2757

28-
module MPFRMultInterp : Types.S
58+
module MPFRMultInterp : S with type custom_float = Mpfrf.t
2959

30-
module MPFRMfInterp : Types.S
60+
module MPFRMfInterp : S with type custom_float = Mpfrf.t
3161

32-
module BigIntDefInterp : Types.S
62+
module BigIntDefInterp : S with type custom_float = Mpzf.t
3363

34-
module BigIntMultInterp : Types.S
64+
module BigIntMultInterp : S with type custom_float = Mpzf.t
3565

36-
module BigIntMfInterp : Types.S
66+
module BigIntMfInterp : S with type custom_float = Mpzf.t
3767

38-
module IntvDefInterp : Types.S
68+
module IntvDefInterp : S
3969

40-
module IntvMultInterp : Types.S
70+
module IntvMultInterp : S
4171

42-
module IntvMfInterp : Types.S
72+
module IntvMfInterp : S
4373

44-
module RatDefInterp : Types.S
74+
module RatDefInterp : S with type custom_float = Mpqf.t
4575

46-
module RatMultInterp : Types.S
76+
module RatMultInterp : S with type custom_float = Mpqf.t
4777

48-
module RatMfInterp : Types.S
78+
module RatMfInterp : S with type custom_float = Mpqf.t
4979

5080
val evaluate_program :
5181
p:M_ir.Mir.program ->

‎src/mlang/mir_interpreter/functions.mli‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
module Make
22
(N : M_ir.Mir_number.NumberInterface)
3-
(R : M_ir.Mir_roundops.RoundOpsInterface with type t = N.t) : sig
3+
(_ : M_ir.Mir_roundops.RoundOpsInterface with type t = N.t) : sig
44
val arr : N.t Types.value -> N.t Types.value
55

66
val inf : N.t Types.value -> N.t Types.value

‎src/mlang/mir_interpreter/types.ml‎

Lines changed: 0 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -60,34 +60,3 @@ type run_error =
6060
(string * (string option * Pos.t) list * (unit -> unit) option)
6161

6262
exception RuntimeError of run_error
63-
64-
module type S = sig
65-
type custom_float
66-
67-
type nonrec ctx = custom_float ctx
68-
69-
exception InternalRuntimeError of run_error * ctx
70-
71-
(** {2 M Evaluation} *)
72-
73-
val evaluate_expr :
74-
ctx -> M_ir.Mir.expression Pos.marked -> custom_float value
75-
(** Evaluates an expression. *)
76-
77-
val evaluate_program : ctx -> unit
78-
(** Evaluates a whole program. Proper initialisation of inputs and events
79-
is required before calling this function (through [update_ctx_with_inputs]
80-
and [update_ctx_with_events]. *)
81-
82-
(** {2 Helpers} *)
83-
84-
(** These helpers are here for compatibility with {!module: Context}. *)
85-
86-
val literal_to_value : Com.literal -> custom_float value
87-
88-
val value_to_literal : custom_float value -> Com.literal
89-
90-
val literal_event_to_value_event :
91-
(Com.literal, Com.Var.t) Com.event_value ->
92-
(custom_float value, Com.Var.t) Com.event_value
93-
end

0 commit comments

Comments
 (0)