Better type handling

lib/syntax/get_type.ml

@@ -15,6 +15,10 @@ type t' = t
 let v = Fun.id
 let get_type : t -> type_of = function Raw r -> r | Variable r -> r
 
+let map : t -> type_of -> t =
+ fun t type_of ->
+  match t with Raw _ -> Raw type_of | Variable _ -> Variable type_of
+
 let get_nature : t -> t -> type_of -> t =
  fun t1 t2 type_of ->
   match (t1, t2) with
@@ -31,11 +35,33 @@ let ident : (S.pos, 'any) S.variable -> t =
 let literal : S.pos -> t T.literal list -> t =
  fun pos values ->
   ignore pos;
-  let init = Raw NumericString in
-  List.fold_left values ~init ~f:(fun state -> function
-    | T.Text t -> (
-        match int_of_string_opt t with Some _ -> state | None -> Raw String)
-    | T.Expression t -> t)
+  let init = None in
+  let typed =
+    List.fold_left values ~init ~f:(fun state -> function
+      | T.Text t -> (
+          (* Tranform the type, but keep the information is it’s a raw data
+             or a variable one *)
+          let nature = Option.value ~default:(Raw Integer) state in
+          match (Option.map get_type state, int_of_string_opt t) with
+          | None, Some _
+          | Some Integer, Some _
+          | Some NumericString, Some _
+          | Some Bool, Some _ ->
+              Some (map nature NumericString)
+          | _, _ ->
+              if String.equal "" t then
+                (* If the text is empty, ignore it *)
+                state
+              else Some (map nature String))
+      | T.Expression t -> (
+          let nature = Option.value ~default:(Raw Integer) state in
+          match (Option.map get_type state, get_type t) with
+          | None, Integer | Some NumericString, Integer ->
+              Some (get_nature nature t NumericString)
+          | _ -> Some (map nature String)))
+  in
+  let result = Option.value ~default:(Raw String) typed in
+  result
 
 let uoperator : S.pos -> T.uoperator -> t -> t =
  fun pos operator t ->

lib/syntax/type_of.ml

@@ -190,16 +190,19 @@ module TypedExpression = struct
       =
    fun pos values type_of ->
     ignore type_of;
-    let init = ({ pos; empty = true }, []) in
-    let result =
-      List.fold_left values ~init ~f:(fun (_, report) -> function
+    let init = (true, []) in
+    let empty, report =
+      List.fold_left values ~init ~f:(fun (was_empty, report) -> function
         | T.Text t ->
-            let empty = String.equal t String.empty in
-            ({ pos; empty }, report)
-        | T.Expression t -> snd t)
+            let empty_text = String.equal t String.empty in
+            let empty = was_empty && empty_text in
+            (empty, report)
+        | T.Expression (_, t) ->
+            let empty = was_empty && (fst t).empty in
+            let report = List.rev_append (snd t) (snd init) in
+            (empty, report))
     in
-
-    result
+    ({ pos; empty }, report)
 
   let function_ :
       S.pos ->
@@ -334,23 +337,21 @@ module TypedExpression = struct
     | T.Eq | T.Neq | Lt | Gte | Lte | Gt ->
         (* If the expression is '' or 0, we accept the comparaison as if
             instead of raising a warning *)
-        if t1.empty || t2.empty then ({ pos; empty = false }, report)
-        else
-          let d = Helper.(Dynamic (DynType.t ())) in
-          let expected = [ d; d ] in
-          (* Compare and report as error if the types are incompatible. If no
-             error is reported, try in strict mode, and report as a warning. *)
-          let report =
-            match
-              Helper.compare_args ~level:Error pos expected (List.rev types)
+        let d = Helper.(Dynamic (DynType.t ())) in
+        let expected = [ d; d ] in
+        (* Compare and report as error if the types are incompatible. If no
+           error is reported, try in strict mode, and report as a warning. *)
+        let report =
+          match
+            Helper.compare_args ~level:Error pos expected (List.rev types)
+              report
+          with
+          | [] ->
+              Helper.compare_args ~strict:true pos expected (List.rev types)
                 report
-            with
-            | [] ->
-                Helper.compare_args ~strict:true pos expected (List.rev types)
-                  report
-            | report -> report
-          in
-          ({ pos; empty = false }, report)
+          | report -> report
+        in
+        ({ pos; empty = false }, report)
     | T.Mod | T.Minus | T.Product | T.Div ->
         (* Operation over number *)
         let expected = Helper.[ Fixed Integer; Fixed Integer ] in
@@ -448,6 +449,7 @@ module Instruction = struct
     let report' = Option.map snd variable.index |> Option.value ~default:[] in
 
     let report = List.rev_append report' report in
+
     match
       ( right_expression.empty,
         op,

test/get_type.ml

@@ -36,10 +36,44 @@ let concat_text () =
   let msg = "Concatenate" in
   Alcotest.(check' type_of ~msg ~expected ~actual)
 
+let literal_1 () =
+  let actual =
+    Get_type.literal _position [ T.Expression (Get_type.Raw Integer) ]
+  and expected = Get_type.(Raw NumericString) in
+  let msg = "" in
+  Alcotest.(check' type_of ~msg ~expected ~actual)
+
+let literal_2 () =
+  let actual =
+    Get_type.literal _position
+      Get_type.[ T.Text "1"; T.Expression (Raw Integer) ]
+  and expected = Get_type.(Raw NumericString) in
+  let msg = "" in
+  Alcotest.(check' type_of ~msg ~expected ~actual)
+
+let literal_3 () =
+  let actual =
+    Get_type.literal _position
+      Get_type.[ T.Text "b"; T.Expression (Raw Integer) ]
+  and expected = Get_type.(Raw String) in
+  let msg = "" in
+  Alcotest.(check' type_of ~msg ~expected ~actual)
+
+let literal_4 () =
+  let actual =
+    Get_type.literal _position [ T.Expression (Get_type.Variable Integer) ]
+  and expected = Get_type.(Variable NumericString) in
+  let msg = "" in
+  Alcotest.(check' type_of ~msg ~expected ~actual)
+
 let test =
   ( "Type expression",
     [
       Alcotest.test_case "int + int" `Quick add_number;
       Alcotest.test_case "'int' + int" `Quick add_literal_number;
       Alcotest.test_case "str + int" `Quick concat_text;
+      Alcotest.test_case "<<int>>" `Quick literal_1;
+      Alcotest.test_case "1<<int>>" `Quick literal_2;
+      Alcotest.test_case "b<<int>>" `Quick literal_3;
+      Alcotest.test_case "<<$int>>" `Quick literal_4;
     ] )

test/type_of.ml

@@ -22,25 +22,26 @@ let message' level =
       };
   ]
 
+let integer_as_string =
+  [
+    Qsp_syntax.Report.
+      {
+        level = Warn;
+        loc = _position;
+        message = "The type Integer is expected but got Integer as String";
+      };
+  ]
+
 let _test_instruction : string -> Qsp_syntax.Report.t list -> unit =
   Check._test_instruction
 
 let type_mismatch () = _test_instruction {|abc = 'ABC'|} (message Error)
 let assign_int_str () = _test_instruction {|$abc = 123|} (message Warn)
 let type_mismatch2 () = _test_instruction {|abc[''] = $Var|} (message Warn)
+let type_conversion () = _test_instruction {|abc = '123'|} integer_as_string
 
-let type_conversion () =
-  _test_instruction {|abc = '123'|}
-    [
-      {
-        level = Warn;
-        loc = _position;
-        message = "The type Integer is expected but got Integer as String";
-      };
-    ]
-
-(** This expression is not considered as a string *)
-let type_conversion' () = _test_instruction {|abc = '<<123>>'|} []
+let type_conversion' () =
+  _test_instruction {|abc = '<<123>>'|} integer_as_string
 
 let type_comparaison () = _test_instruction {|(abc = '123')|} []
 let type_comparaison_eq () = _test_instruction {|($abc = 123)|} (message Warn)