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

@@ -142,26 +142,23 @@ end
 
 module TypeBuilder = Compose.Expression (Get_type)
 
-type t' = { result : Get_type.t Lazy.t; pos : S.pos; empty : bool }
+type t' = { result : Get_type.t Lazy.t; pos : S.pos }
 
 let arg_of_repr : Get_type.t Lazy.t -> S.pos -> Helper.argument_repr =
  fun type_of pos -> { pos; t = Lazy.force type_of }
 
 module TypedExpression = struct
   type nonrec t' = t' * Report.t list
-  type state = { pos : S.pos; empty : bool }
+  type state = { pos : S.pos }
   type t = state * Report.t list
 
   let v : Get_type.t Lazy.t * t -> t' =
-   fun (type_of, (t, r)) ->
-    ({ result = type_of; pos = t.pos; empty = t.empty }, r)
+   fun (type_of, (t, r)) -> ({ result = type_of; pos = t.pos }, r)
 
   (** The variable has type string when starting with a '$' *)
   let ident :
       (S.pos, Get_type.t Lazy.t * t) S.variable -> Get_type.t Lazy.t -> t =
    fun var _type_of ->
-    let empty = false in
-
     (* Extract the error from the index *)
     let report =
       match var.index with
@@ -170,36 +167,35 @@ module TypedExpression = struct
           let _, r = expr in
           r
     in
-    ({ pos = var.pos; empty }, report)
+    ({ pos = var.pos }, report)
 
   let integer : S.pos -> string -> Get_type.t Lazy.t -> t =
    fun pos value _type_of ->
     let int_value = int_of_string_opt value in
 
-    let empty, report =
+    let report =
       match int_value with
-      | Some 0 -> (true, [])
-      | Some _ -> (false, [])
-      | None -> (false, Report.error pos "Invalid integer value" :: [])
+      | Some 0 -> []
+      | Some _ -> []
+      | None -> Report.error pos "Invalid integer value" :: []
     in
 
-    ({ pos; empty }, report)
+    ({ pos }, report)
 
   let literal :
       S.pos -> (Get_type.t Lazy.t * t) T.literal list -> Get_type.t Lazy.t -> t
       =
    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
-        | T.Text t ->
-            let empty = String.equal t String.empty in
-            ({ pos; empty }, report)
-        | T.Expression t -> snd t)
+    let init = [] in
+    let report =
+      List.fold_left values ~init ~f:(fun report -> function
+        | T.Text _ -> report
+        | T.Expression (_, t) ->
+            let report = List.rev_append (snd t) report in
+            report)
     in
-
-    result
+    ({ pos }, report)
 
   let function_ :
       S.pos ->
@@ -219,7 +215,7 @@ module TypedExpression = struct
           let arg = arg_of_repr type_of t.pos in
           (arg :: types, r @ report))
     in
-    let types = List.rev types and default = { pos; empty = false } in
+    let types = List.rev types and default = { pos } in
 
     match function_ with
     | Arrcomp | Arrpos | Arrsize | Countobj | Desc | Dyneval | Getobj | Instr
@@ -232,7 +228,7 @@ module TypedExpression = struct
         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 *)
-        ({ pos; empty = false }, report)
+        ({ pos }, report)
     | Input | Input' ->
         (* Input should check the result if the variable is a num and raise a
            message in this case.*)
@@ -260,7 +256,7 @@ module TypedExpression = struct
         (* 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
-        ({ pos; empty = false }, report)
+        ({ pos }, report)
     | Mid | Mid' ->
         let expected = Helper.[ Fixed String; Variable (Fixed Integer) ] in
         let report = Helper.compare_args pos expected types report in
@@ -305,7 +301,7 @@ module TypedExpression = struct
         let types = [ arg_of_repr type_of t.pos ] in
         let expected = Helper.[ Fixed Integer ] in
         let report = Helper.compare_args pos expected types report in
-        ({ pos; empty = false }, report)
+        ({ pos }, report)
 
   let boperator :
       S.pos ->
@@ -330,37 +326,35 @@ module TypedExpression = struct
 
            When concatenating, it’s allowed to add an integer and a number.
         *)
-        ({ pos; empty = false }, report)
+        ({ pos }, report)
     | 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 }, 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
-        ({ pos; empty = false }, report)
+        ({ pos }, 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
-        ({ pos; empty = false }, report)
+        ({ pos }, report)
 end
 
 module Expression = TypeBuilder.Make (TypedExpression)
@@ -448,13 +442,9 @@ 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,
-        Get_type.get_type (Lazy.force right_expression.result) )
-    with
-    | true, _, _ -> report
-    | _, T.Eq', Get_type.(Integer) ->
+
+    match (op, Get_type.get_type (Lazy.force right_expression.result)) with
+    | T.Eq', Get_type.Integer ->
         (* Assigning an intger is allowed in a string variable, but raise a
            warning. *)
         let var_type = Lazy.from_val (Get_type.ident variable) in
@@ -462,7 +452,7 @@ module Instruction = struct
         let expected = Helper.[ Fixed Integer ] in
         Helper.compare_args ~strict:true ~level:Report.Warn pos expected [ op1 ]
           report
-    | false, _, _ -> (
+    | _, _ -> (
         let var_type = Lazy.from_val (Get_type.ident variable) in
         let op1 = arg_of_repr var_type variable.pos in
         let op2 = arg_of_repr right_expression.result right_expression.pos in

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)