From 77ae152ece4efbf8dde983c03bd995c982522bfd Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Sat, 28 Oct 2023 22:17:24 +0200
Subject: Updated the interface

---
 lib/qparser/qsp_expression.mly |   6 +-
 lib/qparser/tokens.mly         |   1 +
 lib/syntax/S.ml                |   2 +-
 lib/syntax/check.ml            |  18 ++++--
 lib/syntax/default.ml          |   2 +-
 lib/syntax/t.ml                |   2 +
 lib/syntax/tree.ml             |   9 ++-
 lib/syntax/tree.mli            |   5 +-
 lib/syntax/type_of.ml          |  35 +++++++++---
 test/syntax.ml                 | 121 ++++++++++++++++++++++++++++++-----------
 test/syntax_error.ml           |   6 +-
 11 files changed, 156 insertions(+), 51 deletions(-)

diff --git a/lib/qparser/qsp_expression.mly b/lib/qparser/qsp_expression.mly
index b470a88..9375701 100644
--- a/lib/qparser/qsp_expression.mly
+++ b/lib/qparser/qsp_expression.mly
@@ -34,7 +34,7 @@
       op = binary_operator 
       expr2 = expression 
       { Analyzer.Expression.boperator $loc op expr1 expr2 }
-    | v = delimited(TEXT_MARKER, LITERAL, TEXT_MARKER)
+    | v = delimited(TEXT_MARKER, literal*, TEXT_MARKER)
       { Analyzer.Expression.literal $loc v }
     | i = INTEGER  { Analyzer.Expression.integer $loc i }
     | v = variable { Analyzer.Expression.ident v }
@@ -44,6 +44,10 @@
     {
         (Analyzer.Expression.function_ $loc k arg)
     }
+literal:
+    | v = LITERAL { Qsp_syntax.T.Text v }
+    | e = delimited(ENTER_EMBED, expression*, LEAVE_EMBED) 
+      { Qsp_syntax.T.Expression e }
 
 unary_operator:
     | OBJ
diff --git a/lib/qparser/tokens.mly b/lib/qparser/tokens.mly
index 6b218ed..6612351 100644
--- a/lib/qparser/tokens.mly
+++ b/lib/qparser/tokens.mly
@@ -25,6 +25,7 @@
 %token <string>LITERAL
 %token <string>INTEGER
 %token TEXT_MARKER
+%token ENTER_EMBED LEAVE_EMBED
 
 %token COMMENT
 
diff --git a/lib/syntax/S.ml b/lib/syntax/S.ml
index 108dac9..f7c3ebe 100644
--- a/lib/syntax/S.ml
+++ b/lib/syntax/S.ml
@@ -40,7 +40,7 @@ module type Expression = sig
    *)
 
   val integer : pos -> string -> t
-  val literal : pos -> string -> t
+  val literal : pos -> t T.literal list -> t
 
   val function_ : pos -> T.function_ -> t list -> t
   (** Call a function. The functions list is hardcoded in lib/lexer.mll *)
diff --git a/lib/syntax/check.ml b/lib/syntax/check.ml
index 7db3286..2528914 100644
--- a/lib/syntax/check.ml
+++ b/lib/syntax/check.ml
@@ -112,10 +112,20 @@ module Make (A : App) = struct
     type t = result array
     type t' = result array
 
-    let literal : S.pos -> string -> t =
-     fun pos value ->
-      Array.map A.t ~f:(fun (E { module_ = (module S); expr_witness; _ }) ->
-          let value = S.Expression.literal pos value in
+    let literal : S.pos -> t T.literal list -> t =
+     fun pos values ->
+      Array.mapi A.t ~f:(fun i (E { module_ = (module S); expr_witness; _ }) ->
+          (* Map every values to the Checker *)
+          let values' =
+            List.map values ~f:(function
+              | T.Text t -> T.Text t
+              | T.Expression e ->
+                  let exprs =
+                    List.rev (Helper.expr_i e expr_witness i).values
+                  in
+                  T.Expression exprs)
+          in
+          let value = S.Expression.literal pos values' in
           R { value; witness = expr_witness })
 
     let integer : S.pos -> string -> t =
diff --git a/lib/syntax/default.ml b/lib/syntax/default.ml
index 45e7c14..9e9a8ef 100644
--- a/lib/syntax/default.ml
+++ b/lib/syntax/default.ml
@@ -24,7 +24,7 @@ module Expression (T' : T) = struct
    *)
 
   let integer : S.pos -> string -> T'.t = fun _ _ -> T'.default
-  let literal : S.pos -> string -> T'.t = fun _ _ -> T'.default
+  let literal : S.pos -> T'.t T.literal list -> T'.t = fun _ _ -> T'.default
 
   (** Call a function. The functions list is hardcoded in lib/lexer.mll *)
   let function_ : S.pos -> T.function_ -> T'.t list -> T'.t =
diff --git a/lib/syntax/t.ml b/lib/syntax/t.ml
index bf31253..ade5e11 100644
--- a/lib/syntax/t.ml
+++ b/lib/syntax/t.ml
@@ -2,6 +2,8 @@
     This module contains the basic operators used in the QSP syntax.
  *)
 
+type 'a literal = Text of string | Expression of 'a list
+
 type boperator =
   | Eq
   | Neq
diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml
index d4af905..34baae0 100644
--- a/lib/syntax/tree.ml
+++ b/lib/syntax/tree.ml
@@ -1,12 +1,15 @@
 open StdLabels
 
 module Ast = struct
+  type 'a literal = 'a T.literal = Text of string | Expression of 'a list
+  [@@deriving eq, show]
+
   type 'a variable = { pos : 'a; name : string; index : 'a expression option }
   [@@deriving eq, show]
 
   and 'a expression =
     | Integer of 'a * string
-    | Literal of 'a * string
+    | Literal of 'a * 'a expression literal list
     | Ident of 'a variable
     | BinaryOp of 'a * T.boperator * 'a expression * 'a expression
     | Op of 'a * T.uoperator * 'a expression
@@ -38,7 +41,9 @@ module Expression : S.Expression with type t' = S.pos Ast.expression = struct
 
   let v : t -> t' = fun t -> t
   let integer : S.pos -> string -> t = fun pos i -> Ast.Integer (pos, i)
-  let literal : S.pos -> string -> t = fun pos l -> Ast.Literal (pos, l)
+
+  let literal : S.pos -> t T.literal list -> t =
+   fun pos l -> Ast.Literal (pos, l)
 
   let function_ : S.pos -> T.function_ -> t list -> t =
    fun pos name args -> Ast.Function (pos, name, args)
diff --git a/lib/syntax/tree.mli b/lib/syntax/tree.mli
index 84e5d1b..0032f03 100644
--- a/lib/syntax/tree.mli
+++ b/lib/syntax/tree.mli
@@ -7,6 +7,9 @@
 
 (** This module is the result of the evaluation. *)
 module Ast : sig
+  type 'a literal = 'a T.literal = Text of string | Expression of 'a list
+  [@@deriving eq, show]
+
   type 'a variable = { pos : 'a; name : string; index : 'a expression option }
   [@@deriving eq, show]
   (** A variable, used both in an expression (reference) or in a statement
@@ -14,7 +17,7 @@ module Ast : sig
 
   and 'a expression =
     | Integer of 'a * string
-    | Literal of 'a * string
+    | Literal of 'a * 'a expression literal list
     | Ident of 'a variable
     | BinaryOp of 'a * T.boperator * 'a expression * 'a expression
     | Op of 'a * T.uoperator * 'a expression
diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml
index d0bf31d..ce04872 100644
--- a/lib/syntax/type_of.ml
+++ b/lib/syntax/type_of.ml
@@ -184,15 +184,34 @@ module Expression = struct
 
     ({ result = Raw Integer; pos; empty }, report)
 
-  let literal : S.pos -> string -> t =
-   fun pos value ->
-    let empty = String.equal String.empty value in
-    let type_of =
-      match int_of_string_opt value with
-      | Some _ -> Helper.NumericString
-      | None -> Helper.String
+  let literal : S.pos -> t T.literal list -> t =
+   fun pos values ->
+    let init = ({ result = Raw Helper.NumericString; pos; empty = true }, []) in
+    let result =
+      List.fold_left values ~init ~f:(fun (state, report) -> function
+        | T.Text t ->
+            let empty = String.equal t String.empty in
+            let type_of =
+              match int_of_string_opt t with
+              | Some _ -> state.result
+              | None -> Raw Helper.String
+            in
+            ({ result = type_of; pos; empty }, report)
+        | T.Expression t ->
+            (* Report the warning bottom top *)
+            let result, r =
+              List.fold_left t ~init:(None, [])
+                ~f:(fun (_, report) (result, r) ->
+                  let report = List.rev_append r report in
+                  (Some { result = result.result; pos; empty = false }, report))
+            in
+            let default = { result = Raw Helper.String; pos; empty = true } in
+            let result = Option.value result ~default in
+
+            (result, r))
     in
-    ({ result = Raw type_of; pos; empty }, [])
+
+    result
 
   let function_ : S.pos -> T.function_ -> t list -> t =
    fun pos function_ params ->
diff --git a/test/syntax.ml b/test/syntax.ml
index a49bd1c..432ca8d 100644
--- a/test/syntax.ml
+++ b/test/syntax.ml
@@ -2,6 +2,7 @@ module Tree = Qsp_syntax.Tree
 module Ast = Tree.Ast
 module Check = Qsp_syntax.Check
 module S = Qsp_syntax.S
+module T = Qsp_syntax.T
 
 let location_id, e1 = Check.build (module Tree)
 
@@ -78,7 +79,10 @@ let test_numeric_expression () =
 
 let test_negative_numeric_expression () =
   _test_instruction "-123"
-    [ Expression (Op (_position, Neg, Integer (_position, "123"))) ]
+    [
+      Tree.Ast.Expression
+        (Tree.Ast.Op (_position, T.Neg, Tree.Ast.Integer (_position, "123")));
+    ]
 
 let test_negative_numeric_expression2 () =
   let index = None in
@@ -113,18 +117,25 @@ let test_let_literal () =
   let index = None in
   let var = { Ast.pos = _position; name = "VALUE"; index } in
   _test_instruction "let value = '123'"
-    Ast.[ Declaration (_position, var, Eq', Literal (_position, "123")) ]
+    Ast.
+      [
+        Declaration (_position, var, Eq', Literal (_position, [ T.Text "123" ]));
+      ]
 
 let test_set_array_append () =
   let var = { Ast.pos = _position; name = "$VALUE"; index = None } in
   _test_instruction "set $value[] = ''"
-    Ast.[ Declaration (_position, var, Eq', Literal (_position, "")) ]
+    Ast.
+      [ Declaration (_position, var, Eq', Literal (_position, [ T.Text "" ])) ]
 
 let test_direct_assignation () =
   let index = None in
   let var = { Ast.pos = _position; name = "VALUE"; index } in
   _test_instruction "value = '123'"
-    Ast.[ Declaration (_position, var, Eq', Literal (_position, "123")) ]
+    Ast.
+      [
+        Declaration (_position, var, Eq', Literal (_position, [ T.Text "123" ]));
+      ]
 
 let test_command_assignation () =
   let index = None in
@@ -137,7 +148,9 @@ let test_command_assignation () =
             st_1,
             Eq',
             Function
-              (_position, Input, [ Literal (_position, "Enter the amount") ]) );
+              ( _position,
+                Input,
+                [ Literal (_position, [ T.Text "Enter the amount" ]) ] ) );
       ]
 
 let test_assignation2 () =
@@ -155,7 +168,8 @@ $a = '123'
 }|}
     Ast.
       [
-        Declaration (_position, var, Eq', Literal (_position, "\n$a = '123'\n"));
+        Declaration
+          (_position, var, Eq', Literal (_position, [ T.Text "\n$a = '123'\n" ]));
       ]
 
 let test_nested_literal () =
@@ -172,7 +186,7 @@ let test_nested_literal () =
         ( _position,
           { Ast.pos = _position; name = "VALUE"; index = None },
           Qsp_syntax.T.Eq',
-          Ast.Literal (_position, "\n\n      {\n\n      }\n") );
+          Ast.Literal (_position, [ T.Text "\n\n      {\n\n      }\n" ]) );
     ]
 
 let test_concat_literal () =
@@ -181,16 +195,21 @@ let test_concat_literal () =
   +'456'
 |}
     [
-      Ast.Expression (Ast.Literal (_position, "123"));
+      Ast.Expression (Ast.Literal (_position, [ T.Text "123" ]));
       Ast.Expression
-        (Ast.Op (_position, Qsp_syntax.T.Add, Ast.Literal (_position, "456")));
+        (Ast.Op
+           ( _position,
+             Qsp_syntax.T.Add,
+             Ast.Literal (_position, [ T.Text "456" ]) ));
     ]
 
 let test_literal () =
-  _test_instruction "'123'" [ Expression (Literal (_position, "123")) ]
+  _test_instruction "'123'"
+    [ Expression (Literal (_position, [ T.Text "123" ])) ]
 
 let test_qutoted_literal () =
-  _test_instruction "'12''3'" [ Expression (Literal (_position, "12'3")) ]
+  _test_instruction "'12''3'"
+    [ Expression (Literal (_position, [ T.Text "12'3" ])) ]
 
 let test_multiline1 () =
   let content = {|
@@ -263,7 +282,11 @@ let test_plus_litt () =
     [
       Ast.(
         Expression
-          (BinaryOp (_position, Plus, Literal (_position, "five"), Ident pears)));
+          (BinaryOp
+             ( _position,
+               Plus,
+               Literal (_position, [ T.Text "five" ]),
+               Ident pears )));
     ]
 
 let test_concat () =
@@ -285,7 +308,7 @@ $firstName + ' ' + $lastName
                      name = "$FIRSTNAME";
                      index = None;
                    },
-                 Tree.Ast.Literal (_position, " ") ),
+                 Tree.Ast.Literal (_position, [ T.Text " " ]) ),
              Tree.Ast.Ident
                { Tree.Ast.pos = _position; name = "$LASTNAME"; index = None } ));
     ]
@@ -341,7 +364,9 @@ let test_comment6 () =
      initialized"
     [
       Ast.Call
-        (_position, Qsp_syntax.T.Gosub, [ Ast.Literal (_position, "stat") ]);
+        ( _position,
+          Qsp_syntax.T.Gosub,
+          [ Ast.Literal (_position, [ T.Text "stat" ]) ] );
       Ast.Comment _position;
     ]
 
@@ -382,8 +407,10 @@ let test_precedence2 () =
 let test_if () =
   let index = Some Ast.(Integer (_position, "0")) in
   let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
-  and expr1 = Ast.(Literal (_position, "blockA"))
-  and expr2 = Ast.(Expression (Literal (_position, "You are in block A"))) in
+  and expr1 = Ast.(Literal (_position, [ T.Text "blockA" ]))
+  and expr2 =
+    Ast.(Expression (Literal (_position, [ T.Text "You are in block A" ])))
+  in
   _test_instruction {| if $ARGS[0] = 'blockA':
   'You are in block A'
 end |}
@@ -401,8 +428,10 @@ end |}
 let test_if2 () =
   let index = Some Ast.(Integer (_position, "0")) in
   let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
-  and expr1 = Ast.(Literal (_position, "blockA"))
-  and expr2 = Ast.(Expression (Literal (_position, "You are in block A"))) in
+  and expr1 = Ast.(Literal (_position, [ T.Text "blockA" ]))
+  and expr2 =
+    Ast.(Expression (Literal (_position, [ T.Text "You are in block A" ])))
+  in
   _test_instruction {| if $ARGS[0] = 'blockA':
   'You are in block A'
 end if|}
@@ -531,13 +560,13 @@ let test_if_inline_act () =
                 Ast.Act
                   {
                     loc = _position;
-                    label = Ast.Literal (_position, "go");
+                    label = Ast.Literal (_position, [ T.Text "go" ]);
                     statements =
                       [
                         Ast.Call
                           ( _position,
                             Qsp_syntax.T.Goto,
-                            [ Ast.Literal (_position, "go") ] );
+                            [ Ast.Literal (_position, [ T.Text "go" ]) ] );
                       ];
                   };
               ] );
@@ -559,13 +588,13 @@ let test_if_inline_act2 () =
                 Ast.Act
                   {
                     loc = _position;
-                    label = Ast.Literal (_position, "go");
+                    label = Ast.Literal (_position, [ T.Text "go" ]);
                     statements =
                       [
                         Ast.Call
                           ( _position,
                             Qsp_syntax.T.Goto,
-                            [ Ast.Literal (_position, "go") ] );
+                            [ Ast.Literal (_position, [ T.Text "go" ]) ] );
                         Ast.Comment _position;
                       ];
                   };
@@ -578,8 +607,9 @@ let test_if_inline_act2 () =
 let test_precedence3 () =
   let index = Some Ast.(Integer (_position, "0")) in
   let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
-  and expr1 = Ast.(Literal (_position, "blockA"))
-  and expr2 = Ast.(Expression (Literal (_position, "You are in block A")))
+  and expr1 = Ast.(Literal (_position, [ T.Text "blockA" ]))
+  and expr2 =
+    Ast.(Expression (Literal (_position, [ T.Text "You are in block A" ])))
   and expr3 = Ast.(Expression (Integer (_position, "0"))) in
   _test_instruction {| if $ARGS[0] = 'blockA': 'You are in block A' & 0|}
     Ast.
@@ -599,7 +629,11 @@ let test_precedence3 () =
 let test_gs () =
   _test_instruction "gs '123'"
     [
-      Ast.(Call (_position, Qsp_syntax.T.Gosub, [ Literal (_position, "123") ]));
+      Ast.(
+        Call
+          ( _position,
+            Qsp_syntax.T.Gosub,
+            [ Literal (_position, [ T.Text "123" ]) ] ));
     ]
 
 let test_gt () =
@@ -615,7 +649,10 @@ let test_gt () =
 let test_nl () =
   _test_instruction "*NL 'It'"
     [
-      Ast.Call (_position, Qsp_syntax.T.Nl', [ Ast.Literal (_position, "It") ]);
+      Ast.Call
+        ( _position,
+          Qsp_syntax.T.Nl',
+          [ Ast.Literal (_position, [ T.Text "It" ]) ] );
     ]
 
 let test_function () =
@@ -693,7 +730,8 @@ let test_dyneval () =
   _test_instruction "dyneval ''"
     [
       Ast.Expression
-        (Ast.Function (_position, Dyneval, [ Ast.Literal (_position, "") ]));
+        (Ast.Function
+           (_position, Dyneval, [ Ast.Literal (_position, [ T.Text "" ]) ]));
     ]
 
 (** The parens after input are considered as arguments for the function, not a
@@ -709,8 +747,10 @@ let test_input () =
            ( _position,
              Eq,
              Tree.Ast.Function
-               (_position, Input, [ Tree.Ast.Literal (_position, "") ]),
-             Tree.Ast.Literal (_position, "") ));
+               ( _position,
+                 Input,
+                 [ Tree.Ast.Literal (_position, [ T.Text "" ]) ] ),
+             Tree.Ast.Literal (_position, [ T.Text "" ]) ));
     ]
 
 let test_mutiple_inline_ifs () =
@@ -762,7 +802,7 @@ let test_precedence7 () =
                  Plus,
                  Tree.Ast.Integer (_position, "1"),
                  Tree.Ast.Integer (_position, "1") ),
-             Tree.Ast.Literal (_position, "") ));
+             Tree.Ast.Literal (_position, [ T.Text "" ]) ));
     ]
 
 let test_precedence8 () =
@@ -791,8 +831,24 @@ let nested_string () =
       Tree.Ast.Expression
         (Tree.Ast.Literal
            ( _position,
-             {|<a href="exec: dynamic 'killvar''$zapis'',<<jur_temp>>">Delete</a>|}
-           ));
+             [
+               T.Text
+                 {|<a href="exec: dynamic 'killvar''$zapis'',<<jur_temp>>">Delete</a>|};
+             ] ));
+    ]
+
+(** Test showing the - should be considered as an operator and cannot be 
+    aggregated inside the integer value. *)
+let minus_operator () =
+  _test_instruction {|day-7|}
+    [
+      Tree.Ast.Expression
+        (Tree.Ast.BinaryOp
+           ( _position,
+             T.Minus,
+             Tree.Ast.Ident
+               { Tree.Ast.pos = _position; name = "DAY"; index = None },
+             Tree.Ast.Integer (_position, "7") ));
     ]
 
 let test =
@@ -860,4 +916,5 @@ let test =
       Alcotest.test_case "Precedence7" `Quick test_precedence7;
       Alcotest.test_case "Precedence8" `Quick test_precedence8;
       Alcotest.test_case "Nested string" `Quick nested_string;
+      Alcotest.test_case "Nested string" `Quick minus_operator;
     ] )
diff --git a/test/syntax_error.ml b/test/syntax_error.ml
index 08de384..b56d3f2 100644
--- a/test/syntax_error.ml
+++ b/test/syntax_error.ml
@@ -106,7 +106,11 @@ let missing_operand () =
 
 let unknow_function () =
   _test_instruction "a = ran(1, 2)"
-    { level = Error; loc = _position; message = "Unexpected expression here." }
+    {
+      level = Error;
+      loc = _position;
+      message = "Missing separator between instructions";
+    }
 
 let inline_elif () =
   _test_instruction {|
-- 
cgit v1.2.3