More documentation

Author: Stevendeo

src/mlang/mir_interpreter/context.ml

@@ -232,7 +232,7 @@ let empty_ctx ?inputs ?events (p : M_ir.Mir.program) : 'a ctx =
   Option.iter (update_ctx_with_events res) events;
   res
 
-module Make (N : M_ir.Mir_number.NumberInterface) = struct
+module Make (N : Number.S) = struct
   let get_var_space (ctx : N.t ctx) (m_sp_opt : Com.var_space) =
     let i_sp =
       match m_sp_opt with None -> ctx.ctx_var_space | Some (_, i_sp) -> i_sp

src/mlang/mir_interpreter/context.mli

@@ -111,5 +111,4 @@ val empty_ctx :
     the context of [p] (for example, with variables declared in [p]. Parameters
     [inputs] and [events] are required for interpreting the whole program. *)
 
-module Make (N : M_ir.Mir_number.NumberInterface) :
-  S with type custom_float := N.t
+module Make (N : Number.S) : S with type custom_float := N.t

src/mlang/mir_interpreter/eval.ml

@@ -52,15 +52,13 @@ module type S = sig
     (custom_float value, Com.Var.t) Com.event_value
 end
 
-module Make (N : Mir_number.NumberInterface) (RF : Mir_roundops.RoundOpsFunctor) :
-  S with type custom_float = N.t = struct
+module Make (N : Types.Number) : S with type custom_float = N.t = struct
   (* Careful : this behavior mimics the one imposed by the original Mlang
      compiler... *)
 
-  module R = RF (N)
-  module Funs = Functions.Make (N) (R)
+  module Funs = Functions.Make (N)
   module C = Context.Make (N)
-  module Print = Print.Make (N) (C)
+  module Print = Print.Make (N)
 
   type custom_float = N.t
 
@@ -72,7 +70,7 @@ module Make (N : Mir_number.NumberInterface) (RF : Mir_roundops.RoundOpsFunctor)
 
   exception BlockingError
 
-  let roundf (x : N.t) = R.roundf x
+  let roundf (x : N.t) = N.roundf x
 
   let literal_to_value (l : Com.literal) : value =
     match l with
@@ -312,8 +310,14 @@ module Make (N : Mir_number.NumberInterface) (RF : Mir_roundops.RoundOpsFunctor)
       (fun (arg : Com.Var.t Com.print_arg Pos.marked) ->
         match Pos.unmark arg with
         | PrintString s -> Print.string pctx s
-        | PrintAccess (info, m_a) ->
-            Print.access ~eval:evaluate_expr pctx info (Pos.unmark m_a)
+        | PrintAccess (info, m_a) -> (
+            match
+              C.get_access_var ~eval:evaluate_expr pctx.ctx (Pos.unmark m_a)
+            with
+            | None -> ()
+            | Some (vsd, var, _) ->
+                let _, v, _ = C.get_var pctx.ctx None var in
+                Print.access pctx info vsd v)
         | PrintIndent e -> Print.indent pctx (evaluate_expr pctx.ctx e)
         | PrintExpr (e, mi, ma) ->
             Print.value pctx mi ma (evaluate_expr pctx.ctx e))
@@ -789,61 +793,21 @@ module Make (N : Mir_number.NumberInterface) (RF : Mir_roundops.RoundOpsFunctor)
     | Stop_instruction SKTarget -> (* May not be caught by anything else *) ()
 end
 
-module BigIntPrecision = struct
-  let scaling_factor_bits = ref 64
-end
-
-module MainframeLongSize = struct
-  let max_long = ref Int64.max_int
-end
-
-module FloatDefInterp =
-  Make (Mir_number.RegularFloatNumber) (Mir_roundops.DefaultRoundOps)
-module FloatMultInterp =
-  Make (Mir_number.RegularFloatNumber) (Mir_roundops.MultiRoundOps)
-module FloatMfInterp =
-  Make
-    (Mir_number.RegularFloatNumber)
-    (Mir_roundops.MainframeRoundOps (MainframeLongSize))
-module MPFRDefInterp =
-  Make (Mir_number.MPFRNumber) (Mir_roundops.DefaultRoundOps)
-module MPFRMultInterp =
-  Make (Mir_number.MPFRNumber) (Mir_roundops.MultiRoundOps)
-module MPFRMfInterp =
-  Make
-    (Mir_number.MPFRNumber)
-    (Mir_roundops.MainframeRoundOps (MainframeLongSize))
-module BigIntDefInterp =
-  Make
-    (Mir_number.BigIntFixedPointNumber
-       (BigIntPrecision))
-       (Mir_roundops.DefaultRoundOps)
-module BigIntMultInterp =
-  Make
-    (Mir_number.BigIntFixedPointNumber
-       (BigIntPrecision))
-       (Mir_roundops.MultiRoundOps)
-module BigIntMfInterp =
-  Make
-    (Mir_number.BigIntFixedPointNumber
-       (BigIntPrecision))
-       (Mir_roundops.MainframeRoundOps (MainframeLongSize))
-module IntvDefInterp =
-  Make (Mir_number.IntervalNumber) (Mir_roundops.DefaultRoundOps)
-module IntvMultInterp =
-  Make (Mir_number.IntervalNumber) (Mir_roundops.MultiRoundOps)
-module IntvMfInterp =
-  Make
-    (Mir_number.IntervalNumber)
-    (Mir_roundops.MainframeRoundOps (MainframeLongSize))
-module RatDefInterp =
-  Make (Mir_number.RationalNumber) (Mir_roundops.DefaultRoundOps)
-module RatMultInterp =
-  Make (Mir_number.RationalNumber) (Mir_roundops.MultiRoundOps)
-module RatMfInterp =
-  Make
-    (Mir_number.RationalNumber)
-    (Mir_roundops.MainframeRoundOps (MainframeLongSize))
+module FloatDefInterp = Make (Number.FloatDef)
+module FloatMultInterp = Make (Number.FloatMult)
+module FloatMfInterp = Make (Number.FloatMf)
+module MPFRDefInterp = Make (Number.MPFRDef)
+module MPFRMultInterp = Make (Number.MPFRMult)
+module MPFRMfInterp = Make (Number.MPFRMf)
+module BigIntDefInterp = Make (Number.BigIntDef)
+module BigIntMultInterp = Make (Number.BigIntMult)
+module BigIntMfInterp = Make (Number.BigIntMf)
+module IntvDefInterp = Make (Number.IntvDef)
+module IntvMultInterp = Make (Number.IntvMult)
+module IntvMfInterp = Make (Number.IntvMf)
+module RatDefInterp = Make (Number.RatDef)
+module RatMultInterp = Make (Number.RatMult)
+module RatMfInterp = Make (Number.RatMf)
 
 let get_interp (sort : Config.value_sort) (roundops : Config.round_ops) :
     (module S) =
@@ -864,31 +828,11 @@ let get_interp (sort : Config.value_sort) (roundops : Config.round_ops) :
   | Rational, ROMulti -> (module RatMultInterp)
   | Rational, ROMainframe _ -> (module RatMfInterp)
 
-let prepare_interp (sort : Config.value_sort) (roundops : Config.round_ops) :
-    unit =
-  begin
-    match sort with
-    | MPFR prec -> Mpfr.set_default_prec prec
-    | BigInt prec -> BigIntPrecision.scaling_factor_bits := prec
-    | Interval -> Mpfr.set_default_prec 64
-    | _ -> ()
-  end;
-  match roundops with
-  | ROMainframe long_size ->
-      let max_long =
-        if long_size = 32 then Int64.of_int32 Int32.max_int
-        else if long_size = 64 then Int64.max_int
-        else assert false
-        (* checked when parsing command line *)
-      in
-      MainframeLongSize.max_long := max_long
-  | _ -> ()
-
 let evaluate_program ~(p : Mir.program) ~(inputs : Com.literal Com.Var.Map.t)
     ~(events : (Com.literal, Com.Var.t) Com.event_value StrMap.t list)
     ~(sort : Config.value_sort) ~(round_ops : Config.round_ops) :
     Com.literal Com.Var.Map.t * Com.Error.Set.t =
-  prepare_interp sort round_ops;
+  Number.setup_precision sort round_ops;
   let module Interp = (val get_interp sort round_ops : S) in
   let ctx =
     let inputs = Com.Var.Map.map Interp.literal_to_value inputs in

src/mlang/mir_interpreter/eval.mli

@@ -62,56 +62,54 @@ end
 (** Builds an intepretation engine from a number interface
     ({!module: M_ir.Mir_number}) and a rounding strategy
     ({!module: M_ir.Mir_roundops}). *)
-module Make
-    (N : M_ir.Mir_number.NumberInterface)
-    (RF : M_ir.Mir_roundops.RoundOpsFunctor) : S with type custom_float = N.t
+module Make (N : Number.S) : S with type custom_float = N.t
 
 (** {2 Engines} *)
 
 (** These modules are instanes of Make with modules defined in
     {!module: M_ir.Mir_number} and {!module: M_ir.Mir_roundops}. *)
 
-(** Float with default rounding strategy. *)
 module FloatDefInterp : S with type custom_float = float
+(** Float with default rounding strategy. *)
 
-(** Float with multithread rounding strategy. *)
 module FloatMultInterp : S with type custom_float = float
+(** Float with multithread rounding strategy. *)
 
-(** Float with mainframe rounding strategy. *)
 module FloatMfInterp : S with type custom_float = float
+(** Float with mainframe rounding strategy. *)
 
-(** Multiple-precision floating-point with default rounding strategy. *)
 module MPFRDefInterp : S with type custom_float = Mpfrf.t
+(** Multiple-precision floating-point with default rounding strategy. *)
 
-(** Multiple-precision floating-point with multithread rounding strategy. *)
 module MPFRMultInterp : S with type custom_float = Mpfrf.t
+(** Multiple-precision floating-point with multithread rounding strategy. *)
 
-(** Multiple-precision floating-point with mainframe rounding strategy. *)
 module MPFRMfInterp : S with type custom_float = Mpfrf.t
+(** Multiple-precision floating-point with mainframe rounding strategy. *)
 
-(** Multiple precision integer arithmetic with default rounding strategy. *)
 module BigIntDefInterp : S with type custom_float = Mpzf.t
+(** Multiple precision integer arithmetic with default rounding strategy. *)
 
-(** Multiple precision integer arithmetic with multihtread rounding strategy. *)
 module BigIntMultInterp : S with type custom_float = Mpzf.t
+(** Multiple precision integer arithmetic with multihtread rounding strategy. *)
 
-(** Multiple precision integer arithmetic with mainframe rounding strategy. *)
 module BigIntMfInterp : S with type custom_float = Mpzf.t
+(** Multiple precision integer arithmetic with mainframe rounding strategy. *)
 
-(** Multiple-precision floating-point intervals with default rounding strategy. *)
 module IntvDefInterp : S with type custom_float = M_ir.Mir_number.interval
+(** Multiple-precision floating-point intervals with default rounding strategy. *)
 
-(** Multiple-precision floating-point intervals with multithread rounding strategy. *)
 module IntvMultInterp : S with type custom_float = M_ir.Mir_number.interval
+(** Multiple-precision floating-point intervals with multithread rounding strategy. *)
 
-(** Multiple-precision floating-point intervals with mainframe rounding strategy. *)
 module IntvMfInterp : S with type custom_float = M_ir.Mir_number.interval
+(** Multiple-precision floating-point intervals with mainframe rounding strategy. *)
 
-(** Multiple-precision rationals with default rounding strategy. *)
 module RatDefInterp : S with type custom_float = Mpqf.t
+(** Multiple-precision rationals with default rounding strategy. *)
 
-(** Multiple-precision rationals with multithread rounding strategy. *)
 module RatMultInterp : S with type custom_float = Mpqf.t
+(** Multiple-precision rationals with multithread rounding strategy. *)
 
-(** Multiple-precision rationals with mainframe rounding strategy. *)
 module RatMfInterp : S with type custom_float = Mpqf.t
+(** Multiple-precision rationals with mainframe rounding strategy. *)

src/mlang/mir_interpreter/functions.ml

@@ -1,21 +1,17 @@
 (* TODO: move functions here *)
-open M_ir
 open Types
 
-module Make
-    (N : Mir_number.NumberInterface)
-    (R : Mir_roundops.RoundOpsInterface with type t = N.t) =
-struct
+module Make (N : Types.Number) = struct
   let false_value () = Number (N.zero ())
 
   let true_value () = Number (N.one ())
 
   let arr = function
-    | Number x -> Number (R.roundf x)
+    | Number x -> Number (N.roundf x)
     | Undefined -> Undefined (*nope:Float 0.*)
 
   let inf = function
-    | Number x -> Number (R.truncatef x)
+    | Number x -> Number (N.truncatef x)
     | Undefined -> Undefined
 
   let present = function Undefined -> false_value () | _ -> true_value ()
@@ -44,7 +40,7 @@ struct
     | Undefined, _ -> Undefined
     | Number n, _ when N.is_zero n -> Undefined
     | Number f, `Table l ->
-        let nb = Int64.to_int @@ N.to_int @@ R.roundf f in
+        let nb = Int64.to_int @@ N.to_int @@ N.roundf f in
         let rec loop res cpt = function
           | [] -> res
           | _ when cpt >= nb -> res

src/mlang/mir_interpreter/functions.mli

@@ -1,24 +1,43 @@
-module Make
-    (N : M_ir.Mir_number.NumberInterface)
-    (_ : M_ir.Mir_roundops.RoundOpsInterface with type t = N.t) : sig
+(** Implementation of several function calls as described in
+    {{:../../../../../fonctions.html#valeurs}the functions documentation}.
+
+    Note: the interpreter implementation is supposed to be the legitimate
+    specification. If there are inconsistencies between the documentation
+    or the C code and the actual behavior of the interprer, the interpreter
+    is the reference. *)
+
+module Make (N : Types.Number) : sig
   val arr : N.t Types.value -> N.t Types.value
+  (** Implements the 'arr' call (rounding). *)
 
   val inf : N.t Types.value -> N.t Types.value
+  (** Implements the 'inf' call (truncate). *)
 
   val present : 'a Types.value -> N.t Types.value
+  (** Implements the 'present' call that checks if the value xis not equal to
+      undefined. *)
 
   val supzero : N.t Types.value -> N.t Types.value
+  (** Implements the 'supzero' call, which returns undefined for strictly negative
+      values or the argument otherwise. *)
 
   val abs : N.t Types.value -> N.t Types.value
+  (** Implements the 'abs' call, calculating the absolute value of its
+      argument. *)
 
   val min : N.t Types.value -> N.t Types.value -> N.t Types.value
+  (** Implements the 'min' call, returning the minimum between two values. *)
 
   val max : N.t Types.value -> N.t Types.value -> N.t Types.value
+  (** Implements the 'max' call, returning the maximum between two values. *)
 
   val multimax :
     N.t Types.value ->
     [ `Table of N.t Types.value list | `Var of N.t Types.value ] ->
     N.t Types.value
+  (** Implements the 'multimax' call, returning the max value of a subtable. *)
 
   val nb_events : 'a Types.ctx -> N.t Types.value
+  (** Implements the 'nb_events' call, returning the number of currently defined
+    events. *)
 end