diff options
author | Chimrod <> | 2023-11-13 10:12:42 +0100 |
---|---|---|
committer | Chimrod <> | 2023-11-13 11:54:49 +0100 |
commit | 4ec7f0b73f8aa43eccf387bdec55fc464d809896 (patch) | |
tree | 9cf31bee4b23e4d48bdbd33bee49f2c25a6334a7 | |
parent | 0d5bcaea3370697822675d9f8d25bca34c02505e (diff) |
Simplified the representation of expressions in strings
-rw-r--r-- | lib/qparser/qsp_expression.mly | 4 | ||||
-rw-r--r-- | lib/syntax/check.ml | 23 | ||||
-rw-r--r-- | lib/syntax/get_type.ml | 10 | ||||
-rw-r--r-- | lib/syntax/nested_strings.ml | 2 | ||||
-rw-r--r-- | lib/syntax/t.ml | 8 | ||||
-rw-r--r-- | lib/syntax/tree.ml | 2 | ||||
-rw-r--r-- | lib/syntax/tree.mli | 2 | ||||
-rw-r--r-- | lib/syntax/type_of.ml | 15 | ||||
-rw-r--r-- | test/literals.ml | 38 | ||||
-rw-r--r-- | test/syntax_error.ml | 6 |
10 files changed, 34 insertions, 76 deletions
diff --git a/lib/qparser/qsp_expression.mly b/lib/qparser/qsp_expression.mly index 9375701..1e0988f 100644 --- a/lib/qparser/qsp_expression.mly +++ b/lib/qparser/qsp_expression.mly @@ -46,8 +46,8 @@ } literal: | v = LITERAL { Qsp_syntax.T.Text v } - | e = delimited(ENTER_EMBED, expression*, LEAVE_EMBED) - { Qsp_syntax.T.Expression e } + | e = delimited(ENTER_EMBED, expression, LEAVE_EMBED) + { Qsp_syntax.T.Expression e } unary_operator: | OBJ diff --git a/lib/syntax/check.ml b/lib/syntax/check.ml index c5dfe74..6737e80 100644 --- a/lib/syntax/check.ml +++ b/lib/syntax/check.ml @@ -124,13 +124,12 @@ module Make (A : App) = struct 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) + List.map values + ~f: + (T.map_litteral ~f:(fun expr -> + match get expr_witness (Array.get expr i) with + | None -> failwith "Does not match" + | Some value -> value)) in let value = S.Expression.literal pos values' in R { value; witness = expr_witness }) @@ -320,15 +319,6 @@ module Make (A : App) = struct R { value; witness = instr_witness }) - (** Helper function used to prepare the clauses *) - let map_clause : (expression, t) S.clause -> S.pos * Expression.t' * t list - = - fun clause -> - let clause_pos, expression, t = clause in - let expression = expression in - let clause = (clause_pos, expression, t) in - clause - let rebuild_clause : type a b. int -> @@ -354,7 +344,6 @@ module Make (A : App) = struct t = fun pos clause ~elifs ~else_ -> (* First, apply the report for all the instructions *) - let clause = map_clause clause and elifs = List.map elifs ~f:map_clause in let else_ = match else_ with | None -> None diff --git a/lib/syntax/get_type.ml b/lib/syntax/get_type.ml index 4aecb01..2bd12bb 100644 --- a/lib/syntax/get_type.ml +++ b/lib/syntax/get_type.ml @@ -35,15 +35,7 @@ let literal : S.pos -> t T.literal list -> t = 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 -> - (* Report the warning bottom top *) - let result = - List.fold_left t ~init:None ~f:(fun _ result -> Some result) - in - let default = Raw String in - let result = Option.value result ~default in - - result) + | T.Expression t -> t) let uoperator : S.pos -> T.uoperator -> t -> t = fun pos operator t -> diff --git a/lib/syntax/nested_strings.ml b/lib/syntax/nested_strings.ml index 7e49ace..4dd5c81 100644 --- a/lib/syntax/nested_strings.ml +++ b/lib/syntax/nested_strings.ml @@ -21,7 +21,7 @@ module Expression = TypeBuilder.Make (struct = fun pos content _type_of -> match content with - | [ T.Expression [ (t', _) ]; T.Text "" ] -> ( + | [ T.Expression (t', _); T.Text "" ] -> ( match Get_type.get_type (Lazy.force t') with | Get_type.Integer -> [] | _ -> diff --git a/lib/syntax/t.ml b/lib/syntax/t.ml index 38ad5b0..c50d2e2 100644 --- a/lib/syntax/t.ml +++ b/lib/syntax/t.ml @@ -2,14 +2,10 @@ This module contains the basic operators used in the QSP syntax. *) -open StdLabels - -type 'a literal = Text of string | Expression of 'a list +type 'a literal = Text of string | Expression of 'a let map_litteral : f:('a -> 'b) -> 'a literal -> 'b literal = - fun ~f -> function - | Text t -> Text t - | Expression e -> Expression (List.map ~f e) + fun ~f -> function Text t -> Text t | Expression e -> Expression (f e) type boperator = | Eq diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml index 6f99bbd..21238a6 100644 --- a/lib/syntax/tree.ml +++ b/lib/syntax/tree.ml @@ -5,7 +5,7 @@ let description = "Build the AST" let active = ref true module Ast = struct - type 'a literal = 'a T.literal = Text of string | Expression of 'a list + type 'a literal = 'a T.literal = Text of string | Expression of 'a [@@deriving eq, show] type 'a variable = { pos : 'a; name : string; index : 'a expression option } diff --git a/lib/syntax/tree.mli b/lib/syntax/tree.mli index 0032f03..c5506e7 100644 --- a/lib/syntax/tree.mli +++ b/lib/syntax/tree.mli @@ -7,7 +7,7 @@ (** This module is the result of the evaluation. *) module Ast : sig - type 'a literal = 'a T.literal = Text of string | Expression of 'a list + type 'a literal = 'a T.literal = Text of string | Expression of 'a [@@deriving eq, show] type 'a variable = { pos : 'a; name : string; index : 'a expression option } diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml index c532a96..d132162 100644 --- a/lib/syntax/type_of.ml +++ b/lib/syntax/type_of.ml @@ -191,20 +191,7 @@ module TypedExpression = struct | T.Text t -> let empty = String.equal t String.empty in ({ pos; empty }, report) - | T.Expression (t : (Get_type.t Lazy.t * t) list) -> - (* Report the warning bottom top *) - let result, r = - List.fold_left t ~init:(None, []) - ~f:(fun (_, report) (type_of, t) -> - ignore type_of; - let r = snd t in - let report = List.rev_append r report in - (Some { pos; empty = false }, report)) - in - let default = { pos; empty = true } in - let result = Option.value result ~default in - - (result, r)) + | T.Expression t -> snd t) in result diff --git a/test/literals.ml b/test/literals.ml index 6070f86..8f5a56e 100644 --- a/test/literals.ml +++ b/test/literals.ml @@ -13,7 +13,7 @@ let result = (Tree.Ast.Literal ( _position, [ - T.Expression [ Tree.Ast.Literal (_position, [ T.Text "key" ]) ]; + T.Expression (Tree.Ast.Literal (_position, [ T.Text "key" ])); T.Text ""; ] )); ] @@ -71,25 +71,23 @@ let expression () = ( _position, [ T.Expression - [ - Tree.Ast.Function - ( _position, - T.Iif, - [ - Tree.Ast.BinaryOp - ( _position, - T.Eq, - Tree.Ast.Ident - { - Tree.Ast.pos = _position; - name = "VAR"; - index = None; - }, - Tree.Ast.Integer (_position, "0") ); - Tree.Ast.Integer (_position, "1"); - Tree.Ast.Integer (_position, "0"); - ] ); - ]; + (Tree.Ast.Function + ( _position, + T.Iif, + [ + Tree.Ast.BinaryOp + ( _position, + T.Eq, + Tree.Ast.Ident + { + Tree.Ast.pos = _position; + name = "VAR"; + index = None; + }, + Tree.Ast.Integer (_position, "0") ); + Tree.Ast.Integer (_position, "1"); + Tree.Ast.Integer (_position, "0"); + ] )); T.Text ""; ] )); ] diff --git a/test/syntax_error.ml b/test/syntax_error.ml index b56d3f2..08de384 100644 --- a/test/syntax_error.ml +++ b/test/syntax_error.ml @@ -106,11 +106,7 @@ let missing_operand () = let unknow_function () = _test_instruction "a = ran(1, 2)" - { - level = Error; - loc = _position; - message = "Missing separator between instructions"; - } + { level = Error; loc = _position; message = "Unexpected expression here." } let inline_elif () = _test_instruction {| |