diff options
author | Chimrod <> | 2023-10-28 22:17:24 +0200 |
---|---|---|
committer | Chimrod <> | 2023-11-02 11:06:12 +0100 |
commit | 77ae152ece4efbf8dde983c03bd995c982522bfd (patch) | |
tree | b6427477b66042f766e58148441166b83984ddbb | |
parent | dd060261e35fcb8a57f03b01dbe84ab772a2a199 (diff) |
Updated the interface
-rw-r--r-- | lib/qparser/qsp_expression.mly | 6 | ||||
-rw-r--r-- | lib/qparser/tokens.mly | 1 | ||||
-rw-r--r-- | lib/syntax/S.ml | 2 | ||||
-rw-r--r-- | lib/syntax/check.ml | 18 | ||||
-rw-r--r-- | lib/syntax/default.ml | 2 | ||||
-rw-r--r-- | lib/syntax/t.ml | 2 | ||||
-rw-r--r-- | lib/syntax/tree.ml | 9 | ||||
-rw-r--r-- | lib/syntax/tree.mli | 5 | ||||
-rw-r--r-- | lib/syntax/type_of.ml | 35 | ||||
-rw-r--r-- | test/syntax.ml | 121 | ||||
-rw-r--r-- | 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 {| |