aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChimrod <>2023-10-28 22:17:24 +0200
committerChimrod <>2023-11-02 11:06:12 +0100
commit77ae152ece4efbf8dde983c03bd995c982522bfd (patch)
treeb6427477b66042f766e58148441166b83984ddbb
parentdd060261e35fcb8a57f03b01dbe84ab772a2a199 (diff)
Updated the interface
-rw-r--r--lib/qparser/qsp_expression.mly6
-rw-r--r--lib/qparser/tokens.mly1
-rw-r--r--lib/syntax/S.ml2
-rw-r--r--lib/syntax/check.ml18
-rw-r--r--lib/syntax/default.ml2
-rw-r--r--lib/syntax/t.ml2
-rw-r--r--lib/syntax/tree.ml9
-rw-r--r--lib/syntax/tree.mli5
-rw-r--r--lib/syntax/type_of.ml35
-rw-r--r--test/syntax.ml121
-rw-r--r--test/syntax_error.ml6
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 {|