Updated the type checker in a more precise way

1 files changed, 138 insertions, 83 deletions

diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml
index b0d14ec..6e28ae0 100644
--- a/lib/syntax/type_of.ml
+++ b/lib/syntax/type_of.ml
@@ -1,61 +1,97 @@
 open StdLabels
 
 module Helper = struct
-  type t = Integer | Bool | String | Any
+  type type_of =
+    | Integer  (** A numeric value *)
+    | Bool  (** A boolean, not a real type  *)
+    | String  (** String value *)
+    | NumericString
+        [@printer fun fmt _ -> Format.pp_print_string fmt "Integer"]
+        (** String containing a numeric value *)
   [@@deriving show { with_path = false }]
 
+  type t = Variable of type_of | Raw of type_of
   type argument_repr = { pos : S.pos; t : t }
 
-  type dyn_type = t -> t
-  (** Dynamic type is a type unknown during the code.
+  module DynType = struct
+    type nonrec t = t -> t
+    (** Dynamic type is a type unknown during the code.
 
       For example, the equality operator accept either Integer or String, but
       we expect that both sides of the equality uses the same type.*)
 
-  (** Build a new dynamic type *)
-  let dyn_type : unit -> dyn_type =
-   fun () ->
-    let stored = ref None in
-    fun t ->
-      match !stored with
-      | None ->
-          stored := Some t;
-          t
-      | Some t -> t
+    (** Build a new dynamic type *)
+    let t : unit -> t =
+     fun () ->
+      let stored = ref None in
+      fun t ->
+        match !stored with
+        | None ->
+            stored := Some t;
+            t
+        | Some t -> t
+  end
 
   (** Declare an argument for a function. 
 
  - Either we already know the type and we just have to compare.
  - Either the type shall constrained by another one 
  - Or we have a variable number of arguments. *)
-  type argument = Fixed of t | Dynamic of dyn_type | Variable of argument
+  type argument =
+    | Fixed of type_of
+    | Dynamic of DynType.t
+    | Variable of argument
 
   let compare :
       ?strict:bool ->
       ?level:Report.level ->
-      t ->
+      type_of ->
       argument_repr ->
       Report.t list ->
       Report.t list =
    fun ?(strict = false) ?(level = Report.Warn) expected actual report ->
     let equal =
       match (expected, actual.t) with
-      | _, Any -> true
-      | Any, _ -> true
-      | String, String -> true
-      | Integer, Integer -> true
-      | Bool, Bool -> true
-      | Bool, Integer when not strict -> true
-      | Integer, Bool -> true
-      | String, Integer when not strict -> true
-      | String, Bool when not strict -> true
+      (* Strict equality for this ones, always true *)
+      | String, Variable String
+      | String, Raw String
+      | String, Raw NumericString
+      | String, Variable NumericString
+      | Integer, Variable Integer
+      | Integer, Raw Integer
+      | NumericString, Raw NumericString
+      | NumericString, Variable NumericString
+      | Bool, Raw Bool
+      | Bool, Variable Bool
+      (* Also include the conversion between bool and integer *)
+      | Integer, Raw Bool
+      | Integer, Variable Bool
+      (* The type NumericString can be used as a generic type in input *)
+      | _, Variable NumericString
+      | NumericString, Raw String
+      | NumericString, Variable String
+      | NumericString, Raw Integer
+      | NumericString, Variable Integer
+      (* A numeric type can be used at any place *)
+      | String, Raw Integer ->
+          true
+      | Bool, Variable Integer when not strict -> true
+      | Bool, Raw Integer when not strict -> true
+      | String, Variable Integer when not strict -> true
+      | String, Raw Bool when not strict -> true
+      | String, Variable Bool when not strict -> true
+      | Integer, Variable String when not strict -> true
+      (* Explicit rejected cases  *)
+      | Integer, Raw NumericString when not strict -> true
+      | Integer, Raw String -> false
       | _, _ -> false
     in
     if equal then report
     else
+      let result_type = match actual.t with Variable v -> v | Raw r -> r in
       let message =
-        Format.asprintf "The type %a is expected but got %a" pp expected pp
-          actual.t
+        Format.asprintf "The type %a is expected but got %a" pp_type_of expected
+          pp_type_of result_type
       in
       Report.message level actual.pos message :: report
 
@@ -70,7 +106,7 @@ module Helper = struct
     match expected with
     | Fixed t -> compare ~level t param report
     | Dynamic d ->
-        let type_ = d param.t in
+        let type_ = match d param.t with Raw r -> r | Variable v -> v in
         compare ~strict ~level type_ param report
     | Variable c -> compare_parameter ~level c param report
 
@@ -121,8 +157,8 @@ module Expression = struct
    fun var report ->
     let empty = false in
     match var.name.[0] with
-    | '$' -> ({ result = String; pos = var.pos; empty }, report)
-    | _ -> ({ result = Integer; pos = var.pos; empty }, report)
+    | '$' -> ({ result = Variable String; pos = var.pos; empty }, report)
+    | _ -> ({ result = Variable Integer; pos = var.pos; empty }, report)
 
   let integer : S.pos -> string -> t S.repr =
    fun pos value report ->
@@ -135,12 +171,17 @@ module Expression = struct
       | None -> (false, Report.error pos "Invalid integer value" :: report)
     in
 
-    ({ result = Integer; pos; empty }, report)
+    ({ result = Raw Integer; pos; empty }, report)
 
   let literal : S.pos -> string -> t S.repr =
    fun pos value report ->
     let empty = String.equal String.empty value in
-    ({ result = String; pos; empty }, report)
+    let type_of =
+      match int_of_string_opt value with
+      | Some _ -> Helper.NumericString
+      | None -> Helper.String
+    in
+    ({ result = Raw type_of; pos; empty }, report)
 
   let function_ : S.pos -> T.function_ -> t S.repr list -> t S.repr =
    fun pos function_ params _acc ->
@@ -154,83 +195,84 @@ module Expression = struct
           (arg :: types, report))
     in
     let types = List.rev types
-    and default = { result = Any; pos; empty = false } in
+    and default = { result = Variable NumericString; pos; empty = false } in
 
     match function_ with
-    | Arrcomp | Arrpos | Arrsize | Countobj | Desc | Dyneval | Func | Getobj
-    | Instr | Isplay ->
-        ({ default with result = Integer }, report)
-    | Desc' | Dyneval' | Func' | Getobj' ->
-        ({ default with result = String }, report)
+    | Arrcomp | Arrpos | Arrsize | Countobj | Desc | Dyneval | Getobj | Instr
+    | Isplay ->
+        ({ default with result = Variable Integer }, report)
+    | Desc' | Dyneval' | Getobj' ->
+        ({ default with result = Variable String }, report)
+    | Func | Func' -> ({ default with result = Variable NumericString }, report)
     | Iif | Iif' ->
-        let d = Helper.dyn_type () in
+        let d = Helper.DynType.t () in
         let expected = Helper.[ Fixed Bool; Dynamic d; Dynamic d ] in
         let report = Helper.compare_args pos expected types report in
         (* Extract the type for the expression *)
-        let result = d Helper.Bool in
+        let result = d (Raw Helper.Bool) in
         ({ result; pos; empty = false }, report)
     | Input | Input' ->
         (* Input should check the result if the variable is a num and raise a
            message in this case.*)
         let expected = Helper.[ Fixed String ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = String; pos; empty = false }, report)
+        ({ result = Variable NumericString; pos; empty = false }, report)
     | Isnum ->
         let expected = Helper.[ Fixed String ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = Bool; pos; empty = false }, report)
+        ({ result = Raw Bool; pos; empty = false }, report)
     | Lcase | Lcase' | Ucase | Ucase' ->
         let expected = Helper.[ Fixed String ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = String; pos; empty = false }, report)
+        ({ result = Raw String; pos; empty = false }, report)
     | Len ->
-        let expected = Helper.[ Fixed Any ] in
+        let expected = Helper.[ Fixed NumericString ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = Integer; pos; empty = false }, report)
+        ({ result = Raw Integer; pos; empty = false }, report)
     | Loc ->
         let expected = Helper.[ Fixed String ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = Bool; pos; empty = false }, report)
+        ({ result = Variable Bool; pos; empty = false }, report)
     | Max | Max' | Min | Min' ->
-        let d = Helper.dyn_type () in
+        let d = Helper.DynType.t () in
         (* All the arguments must have the same type *)
         let expected = Helper.[ Variable (Dynamic d) ] in
         let report = Helper.compare_args pos expected types report in
-        let result = d Helper.Bool in
+        let result = d (Raw Helper.Bool) in
         ({ result; pos; empty = false }, report)
     | Mid | Mid' ->
         let expected = Helper.[ Fixed String; Variable (Fixed Integer) ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = String; pos; empty = false }, report)
-    | Msecscount -> ({ result = Integer; pos; empty = false }, report)
+        ({ result = Variable String; pos; empty = false }, report)
+    | Msecscount -> ({ result = Raw Integer; pos; empty = false }, report)
     | Rand ->
         let expected = Helper.[ Variable (Fixed Integer) ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = Integer; pos; empty = false }, report)
-    | Replace -> ({ result = Integer; pos; empty = false }, report)
-    | Replace' -> ({ result = String; pos; empty = false }, report)
-    | Rgb -> ({ result = Integer; pos; empty = false }, report)
+        ({ result = Raw Integer; pos; empty = false }, report)
+    | Replace -> ({ result = Variable String; pos; empty = false }, report)
+    | Replace' -> ({ result = Variable String; pos; empty = false }, report)
+    | Rgb -> ({ result = Raw Integer; pos; empty = false }, report)
     | Qspver | Qspver' | Rnd ->
         (* No arg *)
         let report = Helper.compare_args pos [] types report in
-        ({ result = Integer; pos; empty = false }, report)
-    | Selact -> ({ result = Integer; pos; empty = false }, report)
-    | Stattxt -> ({ result = Integer; pos; empty = false }, report)
-    | Stattxt' -> ({ result = String; pos; empty = false }, report)
+        ({ result = Raw Integer; pos; empty = false }, report)
+    | Selact -> ({ result = Variable String; pos; empty = false }, report)
+    | Stattxt -> ({ result = Variable String; pos; empty = false }, report)
+    | Stattxt' -> ({ result = Variable String; pos; empty = false }, report)
     | Str | Str' ->
         let expected = Helper.[ Variable (Fixed Integer) ] in
         let report = Helper.compare_args pos expected types report in
-        ({ default with result = String }, report)
-    | Strcomp -> ({ result = Integer; pos; empty = false }, report)
-    | Strfind -> ({ result = Integer; pos; empty = false }, report)
-    | Strfind' -> ({ result = String; pos; empty = false }, report)
-    | Strpos -> ({ result = Integer; pos; empty = false }, report)
-    | Trim -> ({ result = Integer; pos; empty = false }, report)
-    | Trim' -> ({ result = String; pos; empty = false }, report)
+        ({ default with result = Raw String }, report)
+    | Strcomp -> ({ result = Raw Bool; pos; empty = false }, report)
+    | Strfind -> ({ result = Variable String; pos; empty = false }, report)
+    | Strfind' -> ({ result = Variable String; pos; empty = false }, report)
+    | Strpos -> ({ result = Raw Integer; pos; empty = false }, report)
+    | Trim -> ({ result = Variable String; pos; empty = false }, report)
+    | Trim' -> ({ result = Variable String; pos; empty = false }, report)
     | Val ->
-        let expected = Helper.[ Fixed Any ] in
+        let expected = Helper.[ Fixed NumericString ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = Integer; pos; empty = false }, report)
+        ({ result = Raw Integer; pos; empty = false }, report)
 
   (** Unary operator like [-123] or [+'Text']*)
   let uoperator : S.pos -> T.uoperator -> t S.repr -> t S.repr =
@@ -242,7 +284,7 @@ module Expression = struct
         let types = [ arg_of_repr t ] in
         let expected = Helper.[ Fixed Integer ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = Integer; pos; empty = false }, report)
+        ({ result = Raw Integer; pos; empty = false }, report)
 
   let boperator : S.pos -> T.boperator -> t S.repr -> t S.repr -> t S.repr =
    fun pos operator t1 t2 report ->
@@ -251,40 +293,46 @@ module Expression = struct
     let types = [ arg_of_repr t1; arg_of_repr t2 ] in
     match operator with
     | T.Plus ->
-        (* Operation over number *)
-        let d = Helper.(dyn_type ()) in
-        let expected = Helper.[ Dynamic d; Dynamic d ] in
+        let d = Helper.DynType.t () in
+        (* Remove the empty elements *)
+        let types =
+          List.filter_map [ t1; t2 ] ~f:(fun t ->
+              (* TODO could be added in the logs *)
+              match t.empty with true -> None | false -> Some (arg_of_repr t))
+        in
+        let expected = List.map types ~f:(fun _ -> Helper.Dynamic d) in
+
         let report = Helper.compare_args pos expected types report in
-        let result = d Helper.Integer in
+        let result = d Helper.(Variable Integer) in
         ({ result; pos; empty = false }, report)
     | T.Eq | T.Neq ->
         (* If the expression is '' or 0, we accept the comparaison as if
             instead of raising a warning *)
         if t1.empty || t2.empty then
-          ({ result = Bool; pos; empty = false }, report)
+          ({ result = Raw Bool; pos; empty = false }, report)
         else
-          let d = Helper.(Dynamic (dyn_type ())) in
+          let d = Helper.(Dynamic (DynType.t ())) in
           let expected = [ d; d ] in
           let report =
             Helper.compare_args ~strict:true pos expected (List.rev types)
               report
           in
-          ({ result = Bool; pos; empty = false }, report)
+          ({ result = Raw Bool; pos; empty = false }, report)
     | Lt | Gte | Lte | Gt ->
-        let d = Helper.(Dynamic (dyn_type ())) in
+        let d = Helper.(Dynamic (DynType.t ())) in
         let expected = [ d; d ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = Bool; pos; empty = false }, report)
+        ({ result = Raw Bool; pos; empty = false }, report)
     | T.Mod | T.Minus | T.Product | T.Div ->
         (* Operation over number *)
         let expected = Helper.[ Fixed Integer; Fixed Integer ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = Integer; pos; empty = false }, report)
+        ({ result = Raw Integer; pos; empty = false }, report)
     | T.And | T.Or ->
         (* Operation over booleans *)
         let expected = Helper.[ Fixed Bool; Fixed Bool ] in
         let report = Helper.compare_args pos expected types report in
-        ({ result = Bool; pos; empty = false }, report)
+        ({ result = Raw Bool; pos; empty = false }, report)
 end
 
 module Instruction = struct
@@ -360,17 +408,24 @@ module Instruction = struct
     let right_expression, report = expression report in
     match right_expression.empty with
     | true -> ((), report)
-    | false ->
+    | false -> (
         let expr1, report = Expression.ident variable report in
         let op1 = Expression.arg_of_repr expr1 in
         let op2 = Expression.arg_of_repr right_expression in
 
-        let d = Helper.dyn_type () in
+        let d = Helper.DynType.t () in
         (* Every part of the assignation should be the same type *)
         let expected = Helper.[ Dynamic d; Dynamic d ] in
-        ( (),
-          Helper.compare_args ~level:Report.Debug pos expected [ op1; op2 ]
-            report )
+
+        match
+          Helper.compare_args ~strict:false ~level:Report.Error pos expected
+            [ op1; op2 ] []
+        with
+        | [] ->
+            ( (),
+              Helper.compare_args ~strict:true ~level:Report.Debug pos expected
+                [ op1; op2 ] report )
+        | reports -> ((), reports @ report))
 end
 
 module Location = struct