diff options
author | Chimrod <> | 2023-11-08 16:30:02 +0100 |
---|---|---|
committer | Chimrod <> | 2023-11-09 13:12:45 +0100 |
commit | ebf072326e2315ace952c80dbc442198c44faf7d (patch) | |
tree | 7f527035eb0627d634768246a0d14e1821d1bdc4 /lib/syntax | |
parent | 1e182dca2972fbd29e50f611dbf12eb28d6cdd95 (diff) |
Added a way to compose a test with another one
Diffstat (limited to 'lib/syntax')
-rw-r--r-- | lib/syntax/compose.ml | 73 | ||||
-rw-r--r-- | lib/syntax/get_type.ml | 105 | ||||
-rw-r--r-- | lib/syntax/nested_strings.ml | 98 | ||||
-rw-r--r-- | lib/syntax/t.ml | 7 | ||||
-rw-r--r-- | lib/syntax/type_of.ml | 230 | ||||
-rw-r--r-- | lib/syntax/type_of.mli | 10 |
6 files changed, 354 insertions, 169 deletions
diff --git a/lib/syntax/compose.ml b/lib/syntax/compose.ml new file mode 100644 index 0000000..dcc1a86 --- /dev/null +++ b/lib/syntax/compose.ml @@ -0,0 +1,73 @@ +(** Build a module with the result from another one module *) + +open StdLabels + +(** Build an expression module with the result from another expression. The + signature of the fuctions is a bit different, as they all receive the + result from the previous evaluated element in argument. *) +module Expression (E : S.Expression) = struct + module type SIG = sig + type t + type t' + + (* Override the type [t] in the definition of all the functions. The + signatures differs a bit from the standard signature as they get the + result from E.t in last argument *) + + val ident : (S.pos, E.t' * t) S.variable -> E.t' -> t + val integer : S.pos -> string -> E.t' -> t + val literal : S.pos -> (E.t' * t) T.literal list -> E.t' -> t + val function_ : S.pos -> T.function_ -> (E.t' * t) list -> E.t' -> t + val uoperator : S.pos -> T.uoperator -> E.t' * t -> E.t' -> t + val boperator : S.pos -> T.boperator -> E.t' * t -> E.t' * t -> E.t' -> t + + val v : E.t' * t -> t' + (** Convert from the internal representation to the external one. *) + end + + module Make (M : SIG) : S.Expression with type t' = M.t' = struct + type t = E.t * M.t + type t' = M.t' + + let v : t -> t' = fun (type_of, v) -> M.v (E.v type_of, v) + + let ident : (S.pos, t) S.variable -> t = + fun { pos; name : string; index : t option } -> + let t' = E.ident { pos; name; index = Option.map fst index } in + let index' = Option.map (fun (e, m) -> (E.v e, m)) index in + (t', M.ident { pos; name; index = index' } (E.v @@ t')) + + let integer : S.pos -> string -> t = + fun pos i -> + let t' = E.integer pos i in + (t', M.integer pos i (E.v t')) + + let literal : S.pos -> t T.literal list -> t = + fun pos litts -> + let e_litts = List.map litts ~f:(T.map_litteral ~f:fst) in + let litts' = + List.map litts ~f:(T.map_litteral ~f:(fun (e, m) -> (E.v e, m))) + in + + let t' = E.literal pos e_litts in + (t', M.literal pos litts' (E.v t')) + + let function_ : S.pos -> T.function_ -> t list -> t = + fun pos f expressions -> + let e = List.map ~f:fst expressions + and expressions' = List.map ~f:(fun (e, m) -> (E.v e, m)) expressions in + + let t' = E.function_ pos f e in + (t', M.function_ pos f expressions' (E.v t')) + + let uoperator : S.pos -> T.uoperator -> t -> t = + fun pos op (t, expr) -> + let t' = E.uoperator pos op t in + (t', M.uoperator pos op (E.v t, expr) (E.v t')) + + let boperator : S.pos -> T.boperator -> t -> t -> t = + fun pos op (t1, expr1) (t2, expr2) -> + let t' = E.boperator pos op t1 t2 in + (t', M.boperator pos op (E.v t1, expr1) (E.v t2, expr2) (E.v t')) + end +end diff --git a/lib/syntax/get_type.ml b/lib/syntax/get_type.ml new file mode 100644 index 0000000..4aecb01 --- /dev/null +++ b/lib/syntax/get_type.ml @@ -0,0 +1,105 @@ +open StdLabels + +type type_of = + | Integer (** A numeric value *) + | Bool (** A boolean, not a real type *) + | String (** String value *) + | NumericString + [@printer fun fmt _ -> Format.pp_print_string fmt "Integer as String"] + (** String containing a numeric value *) +[@@deriving show { with_path = false }] + +type t = Variable of type_of | Raw of type_of +type t' = t + +let v = Fun.id +let get_type : t -> type_of = function Raw r -> r | Variable r -> r + +let get_nature : t -> t -> type_of -> t = + fun t1 t2 type_of -> + match (t1, t2) with + | Variable _, _ -> Variable type_of + | _, Variable _ -> Variable type_of + | Raw _, Raw _ -> Raw type_of + +let integer : S.pos -> string -> t = fun _ _ -> Raw Integer + +let ident : (S.pos, 'any) S.variable -> t = + fun var -> + match var.name.[0] with '$' -> Variable String | _ -> Variable Integer + +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 -> + (* 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) + +let uoperator : S.pos -> T.uoperator -> t -> t = + fun pos operator t -> + ignore pos; + match operator with Add -> t | Neg | No -> Raw Integer + +let boperator : S.pos -> T.boperator -> t -> t -> t = + fun pos operator t1 t2 -> + ignore pos; + match operator with + | T.Plus -> ( + match (get_type t1, get_type t2) with + | Integer, Integer -> get_nature t1 t2 Integer + | String, _ -> get_nature t1 t2 String + | _, String -> get_nature t1 t2 String + | (_ as t), Bool -> get_nature t1 t2 t + | Bool, (_ as t) -> get_nature t1 t2 t + | (_ as t), NumericString -> get_nature t1 t2 t + | NumericString, (_ as t) -> get_nature t1 t2 t) + | T.Eq | T.Neq -> get_nature t1 t2 Bool + | T.Mod | T.Minus | T.Product | T.Div -> get_nature t1 t2 Integer + | T.And | T.Or -> get_nature t1 t2 Bool + | Lt | Gte | Lte | Gt -> get_nature t1 t2 Bool + +let function_ : S.pos -> T.function_ -> t list -> t = + fun pos function_ params -> + ignore pos; + match function_ with + | Arrcomp | Arrpos | Arrsize | Countobj | Desc | Dyneval | Getobj | Instr + | Isplay -> + Variable Integer + | Desc' | Dyneval' | Getobj' -> Variable String + | Func | Func' -> Variable NumericString + | Iif | Iif' -> ( match params with _ :: t :: _ -> t | _ -> Raw Bool) + | Input | Input' -> Variable NumericString + | Isnum -> Raw Bool + | Lcase | Lcase' | Ucase | Ucase' -> Raw String + | Len -> Raw Integer + | Loc -> Variable Bool + | Max | Max' | Min | Min' -> ( + try List.hd params with Failure _ -> Raw Bool) + | Mid | Mid' -> Variable String + | Msecscount -> Raw Integer + | Rand -> Raw Integer + | Replace -> Variable String + | Replace' -> Variable String + | Rgb -> Raw Integer + | Qspver | Qspver' | Rnd -> Raw Integer + | Selact -> Variable String + | Stattxt -> Variable String + | Stattxt' -> Variable String + | Str | Str' -> Raw String + | Strcomp -> Raw Bool + | Strfind -> Variable String + | Strfind' -> Variable String + | Strpos -> Raw Integer + | Trim -> Variable String + | Trim' -> Variable String + | Val -> Raw Integer diff --git a/lib/syntax/nested_strings.ml b/lib/syntax/nested_strings.ml index c7b0b83..fcd0b91 100644 --- a/lib/syntax/nested_strings.ml +++ b/lib/syntax/nested_strings.ml @@ -4,62 +4,68 @@ let identifier = "escaped_string" let description = "Check for unnecessary use of expression encoded in string" let active = ref true -module Expression : S.Expression with type t' = Report.t list = struct - type t = Report.t list * Type_of.Expression.t +module TypeBuilder = Compose.Expression (Get_type) + +module Expression = TypeBuilder.Make (struct + type t = Report.t list type t' = Report.t list - let get_type t = Type_of.Expression.v t |> Type_of.get_type - let v : t -> t' = Stdlib.fst + let v : Get_type.t * t -> t' = snd (** Identify the expressions reprented as string. That’s here that the report are added. All the rest of the module only push thoses warning to the top level. *) - let literal : S.pos -> t T.literal list -> t = - fun pos content -> - let type_of = - List.map content ~f:(function - | T.Text _ as text -> text - | T.Expression expr -> T.Expression (List.map ~f:snd expr)) - |> Type_of.Expression.literal pos - in - + let literal : S.pos -> (Get_type.t * t) T.literal list -> Get_type.t -> t = + fun pos content _type_of -> match content with - | [ T.Expression [ (_, t') ]; T.Text "" ] -> ( - match get_type t' with - | Type_of.Helper.Integer -> ([], type_of) + | [ T.Expression [ (t', _) ]; T.Text "" ] -> ( + match Get_type.get_type t' with + | Get_type.Integer -> [] | _ -> let msg = Report.debug pos "This expression can be simplified" in - ([ msg ], type_of)) - | _ -> ([], type_of) - - let ident : (S.pos, t) S.variable -> t = - fun { pos; name : string; index : t option } -> - match index with - | None -> - let type_ = Type_of.Expression.ident { pos; name; index = None } in - ([], type_) - | Some (v, t') -> - let type_ = Type_of.Expression.ident { pos; name; index = Some t' } in - (v, type_) - - let integer : S.pos -> string -> t = - fun pos t -> ([], Type_of.Expression.integer pos t) - - let function_ : S.pos -> T.function_ -> t list -> t = - fun pos f expressions -> - let r, t = List.split expressions in - - let type_of = Type_of.Expression.function_ pos f t in - (List.concat r, type_of) - - let uoperator : S.pos -> T.uoperator -> t -> t = - fun pos op (r, expr1) -> (r, Type_of.Expression.uoperator pos op expr1) - - let boperator : S.pos -> T.boperator -> t -> t -> t = - fun pos op (r1, expr1) (r2, expr2) -> - (r1 @ r2, Type_of.Expression.boperator pos op expr1 expr2) -end + [ msg ]) + | _ -> [] + + let ident : (S.pos, Get_type.t * t) S.variable -> Get_type.t -> t = + fun variable _type_of -> + match variable.index with None -> [] | Some (_, t) -> t + + let integer : S.pos -> string -> Get_type.t -> t = + fun pos t _type_of -> + ignore pos; + ignore t; + [] + + let function_ : + S.pos -> T.function_ -> (Get_type.t * t) list -> Get_type.t -> t = + fun pos f expressions _type_of -> + ignore pos; + ignore f; + let exprs = + List.fold_left ~init:[] expressions ~f:(fun acc el -> + List.rev_append (snd el) acc) + in + exprs + + let uoperator : S.pos -> T.uoperator -> Get_type.t * t -> Get_type.t -> t = + fun pos op r _type_of -> + ignore op; + ignore pos; + snd r + + let boperator : + S.pos -> + T.boperator -> + Get_type.t * t -> + Get_type.t * t -> + Get_type.t -> + t = + fun pos op (_, r1) (_, r2) _type_of -> + ignore pos; + ignore op; + r1 @ r2 +end) module Instruction : S.Instruction with type t' = Report.t list and type expression = Expression.t' = diff --git a/lib/syntax/t.ml b/lib/syntax/t.ml index 7186275..38ad5b0 100644 --- a/lib/syntax/t.ml +++ b/lib/syntax/t.ml @@ -2,8 +2,15 @@ This module contains the basic operators used in the QSP syntax. *) +open StdLabels + type 'a literal = Text of string | Expression of 'a list +let map_litteral : f:('a -> 'b) -> 'a literal -> 'b literal = + fun ~f -> function + | Text t -> Text t + | Expression e -> Expression (List.map ~f e) + type boperator = | Eq | Neq diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml index 15d6fe8..7b9a67e 100644 --- a/lib/syntax/type_of.ml +++ b/lib/syntax/type_of.ml @@ -5,20 +5,10 @@ let description = "Ensure all the expression are correctly typed" let active = ref true module Helper = struct - type type_of = - | Integer (** A numeric value *) - | Bool (** A boolean, not a real type *) - | String (** String value *) - | NumericString - [@printer fun fmt _ -> Format.pp_print_string fmt "Integer as String"] - (** String containing a numeric value *) - [@@deriving show { with_path = false }] - - type t = Variable of type_of | Raw of type_of - type argument_repr = { pos : S.pos; t : t } + type argument_repr = { pos : S.pos; t : Get_type.t } module DynType = struct - type nonrec t = t -> t + type nonrec t = Get_type.t -> Get_type.t (** Dynamic type is a type unknown during the code. For example, the equality operator accept either Integer or String, but @@ -42,14 +32,14 @@ module Helper = struct - Either the type shall constrained by another one - Or we have a variable number of arguments. *) type argument = - | Fixed of type_of + | Fixed of Get_type.type_of | Dynamic of DynType.t | Variable of argument let compare : ?strict:bool -> ?level:Report.level -> - type_of -> + Get_type.type_of -> argument_repr -> Report.t list -> Report.t list = @@ -94,8 +84,8 @@ module Helper = struct else let result_type = match actual.t with Variable v -> v | Raw r -> r in let message = - Format.asprintf "The type %a is expected but got %a" pp_type_of expected - pp_type_of result_type + Format.asprintf "The type %a is expected but got %a" Get_type.pp_type_of + expected Get_type.pp_type_of result_type in Report.message level actual.pos message :: report @@ -145,38 +135,39 @@ module Helper = struct msg :: report end -module Expression = struct - type state = { result : Helper.t; pos : S.pos; empty : bool } - type t = state * Report.t list - type t' = state * Report.t list +module TypeBuilder = Compose.Expression (Get_type) + +type t' = { result : Get_type.t; pos : S.pos; empty : bool } - let v : t -> t' = fun t -> t +let arg_of_repr : Get_type.t -> S.pos -> Helper.argument_repr = + fun type_of pos -> { pos; t = type_of } + +module TypedExpression = struct + type nonrec t' = t' * Report.t list + type state = { pos : S.pos; empty : bool } + type t = state * Report.t list - let arg_of_repr : state -> Helper.argument_repr = - fun { result; pos; empty } -> - ignore empty; - { pos; t = result } + let v : Get_type.t * t -> t' = + fun (type_of, (t, r)) -> + ({ result = type_of; pos = t.pos; empty = t.empty }, r) (** The variable has type string when starting with a '$' *) - let ident : (S.pos, t) S.variable -> t = - fun var -> + let ident : (S.pos, Get_type.t * t) S.variable -> Get_type.t -> t = + fun var _type_of -> let empty = false in (* Extract the error from the index *) let report = match var.index with | None -> [] - | Some expr -> + | Some (_, expr) -> let _, r = expr in r in + ({ pos = var.pos; empty }, report) - match var.name.[0] with - | '$' -> ({ result = Variable String; pos = var.pos; empty }, report) - | _ -> ({ result = Variable Integer; pos = var.pos; empty }, report) - - let integer : S.pos -> string -> t = - fun pos value -> + let integer : S.pos -> string -> Get_type.t -> t = + fun pos value _type_of -> let int_value = int_of_string_opt value in let empty, report = @@ -186,30 +177,28 @@ module Expression = struct | None -> (false, Report.error pos "Invalid integer value" :: []) in - ({ result = Raw Integer; pos; empty }, report) + ({ pos; empty }, report) - let literal : S.pos -> t T.literal list -> t = - fun pos values -> - let init = ({ result = Raw Helper.NumericString; pos; empty = true }, []) in + let literal : S.pos -> (Get_type.t * t) T.literal list -> Get_type.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 (state, report) -> function + List.fold_left values ~init ~f:(fun (_, 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 -> + ({ pos; empty }, report) + | T.Expression (t : (Get_type.t * t) list) -> (* Report the warning bottom top *) let result, r = List.fold_left t ~init:(None, []) - ~f:(fun (_, report) (result, r) -> + ~f:(fun (_, report) (type_of, t) -> + ignore type_of; + let r = snd t in let report = List.rev_append r report in - (Some { result = result.result; pos; empty = false }, report)) + (Some { pos; empty = false }, report)) in - let default = { result = Raw Helper.String; pos; empty = true } in + let default = { pos; empty = true } in let result = Option.value result ~default in (result, r)) @@ -217,137 +206,146 @@ module Expression = struct result - let function_ : S.pos -> T.function_ -> t list -> t = - fun pos function_ params -> + let function_ : + S.pos -> T.function_ -> (Get_type.t * t) list -> Get_type.t -> t = + fun pos function_ params _type_of -> (* Accumulate the expressions and get the results, the report is given in the differents arguments, and we build a list with the type of the parameters. *) let types, report = - List.fold_left params ~init:([], []) ~f:(fun (types, report) param -> + List.fold_left params ~init:([], []) + ~f:(fun (types, report) (type_of, param) -> + ignore type_of; let t, r = param in - let arg = arg_of_repr t in + let arg = arg_of_repr type_of t.pos in (arg :: types, r @ report)) in - let types = List.rev types - and default = { result = Variable NumericString; pos; empty = false } in + let types = List.rev types and default = { pos; empty = false } in match function_ with | Arrcomp | Arrpos | Arrsize | Countobj | Desc | Dyneval | Getobj | Instr | Isplay -> - ({ default with result = Variable Integer }, report) - | Desc' | Dyneval' | Getobj' -> - ({ default with result = Variable String }, report) - | Func | Func' -> ({ default with result = Variable NumericString }, report) + (default, report) + | Desc' | Dyneval' | Getobj' -> (default, report) + | Func | Func' -> (default, report) | Iif | Iif' -> let d = Helper.DynType.t () in 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 *) - let result = d (Raw Helper.Bool) in - ({ result; pos; empty = false }, report) + ({ pos; empty = false }, report) | Input | Input' -> (* Input should check the result if the variable is a num and raise a message in this case.*) let expected = Helper.[ Fixed String ] in let report = Helper.compare_args pos expected types report in - ({ result = Variable NumericString; pos; empty = false }, report) + (default, report) | Isnum -> let expected = Helper.[ Fixed String ] in let report = Helper.compare_args pos expected types report in - ({ result = Raw Bool; pos; empty = false }, report) + (default, report) | Lcase | Lcase' | Ucase | Ucase' -> let expected = Helper.[ Fixed String ] in let report = Helper.compare_args pos expected types report in - ({ result = Raw String; pos; empty = false }, report) + (default, report) | Len -> let expected = Helper.[ Fixed NumericString ] in let report = Helper.compare_args pos expected types report in - ({ result = Raw Integer; pos; empty = false }, report) + (default, report) | Loc -> let expected = Helper.[ Fixed String ] in let report = Helper.compare_args pos expected types report in - ({ result = Variable Bool; pos; empty = false }, report) + (default, report) | Max | Max' | Min | Min' -> let d = Helper.DynType.t () in (* 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 - let result = d (Raw Helper.Bool) in - ({ result; pos; empty = false }, report) + ({ pos; empty = false }, report) | Mid | Mid' -> let expected = Helper.[ Fixed String; Variable (Fixed Integer) ] in let report = Helper.compare_args pos expected types report in - ({ result = Variable String; pos; empty = false }, report) - | Msecscount -> ({ result = Raw Integer; pos; empty = false }, report) + (default, report) + | Msecscount -> (default, report) | Rand -> let expected = Helper.[ Variable (Fixed Integer) ] in let report = Helper.compare_args pos expected types report in - ({ result = Raw Integer; pos; empty = false }, report) - | Replace -> ({ result = Variable String; pos; empty = false }, report) - | Replace' -> ({ result = Variable String; pos; empty = false }, report) - | Rgb -> ({ result = Raw Integer; pos; empty = false }, report) + (default, report) + | Replace -> (default, report) + | Replace' -> (default, report) + | Rgb -> (default, report) | Qspver | Qspver' | Rnd -> (* No arg *) let report = Helper.compare_args pos [] types report in - ({ result = Raw Integer; pos; empty = false }, report) - | Selact -> ({ result = Variable String; pos; empty = false }, report) - | Stattxt -> ({ result = Variable String; pos; empty = false }, report) - | Stattxt' -> ({ result = Variable String; pos; empty = false }, report) + (default, report) + | Selact -> (default, report) + | Stattxt -> (default, report) + | Stattxt' -> (default, report) | Str | Str' -> let expected = Helper.[ Variable (Fixed Integer) ] in let report = Helper.compare_args pos expected types report in - ({ default with result = Raw String }, report) - | Strcomp -> ({ result = Raw Bool; pos; empty = false }, report) - | Strfind -> ({ result = Variable String; pos; empty = false }, report) - | Strfind' -> ({ result = Variable String; pos; empty = false }, report) - | Strpos -> ({ result = Raw Integer; pos; empty = false }, report) - | Trim -> ({ result = Variable String; pos; empty = false }, report) - | Trim' -> ({ result = Variable String; pos; empty = false }, report) + (default, report) + | Strcomp -> (default, report) + | Strfind -> (default, report) + | Strfind' -> (default, report) + | Strpos -> (default, report) + | Trim -> (default, report) + | Trim' -> (default, report) | Val -> let expected = Helper.[ Fixed NumericString ] in let report = Helper.compare_args pos expected types report in - ({ result = Raw Integer; pos; empty = false }, report) + (default, report) (** Unary operator like [-123] or [+'Text']*) - let uoperator : S.pos -> T.uoperator -> t -> t = - fun pos operator t1 -> - let t, report = t1 in + let uoperator : S.pos -> T.uoperator -> Get_type.t * t -> Get_type.t -> t = + fun pos operator t1 type_of -> + ignore type_of; + let type_of, (t, report) = t1 in match operator with | Add -> (t, report) | Neg | No -> - let types = [ arg_of_repr t ] in + 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 - ({ result = Raw Integer; pos; empty = false }, report) + ({ pos; empty = false }, report) - let boperator : S.pos -> T.boperator -> t -> t -> t = - fun pos operator t1 t2 -> + let boperator : + S.pos -> + T.boperator -> + Get_type.t * t -> + Get_type.t * t -> + Get_type.t -> + t = + fun pos operator (type_1, t1) (type_2, t2) type_of -> + ignore type_of; let t1, report1 = t1 in let t2, report2 = t2 in let report = report1 @ report2 in - let types = [ arg_of_repr t1; arg_of_repr t2 ] in + let types = [ arg_of_repr type_1 t1.pos; arg_of_repr type_2 t2.pos ] in match operator with | T.Plus -> let d = Helper.DynType.t () in (* Remove the empty elements *) let types = - List.filter_map [ t1; t2 ] ~f:(fun t -> + List.filter_map + [ (type_1, t1); (type_2, t2) ] + ~f:(fun (type_of, t) -> (* TODO could be added in the logs *) - match t.empty with true -> None | false -> Some (arg_of_repr t)) + match t.empty with + | true -> None + | false -> Some (arg_of_repr type_of t.pos)) in let expected = List.map types ~f:(fun _ -> Helper.Dynamic d) in let report = Helper.compare_args pos expected types report in - let result = d Helper.(Variable Integer) in - ({ result; pos; empty = false }, report) + ({ pos; empty = false }, report) | T.Eq | T.Neq -> (* If the expression is '' or 0, we accept the comparaison as if instead of raising a warning *) - if t1.empty || t2.empty then - ({ result = Raw Bool; pos; empty = false }, report) + if t1.empty || t2.empty then ({ pos; empty = false }, report) else let d = Helper.(Dynamic (DynType.t ())) in let expected = [ d; d ] in @@ -355,24 +353,26 @@ module Expression = struct Helper.compare_args ~strict:true pos expected (List.rev types) report in - ({ result = Raw Bool; pos; empty = false }, report) + ({ pos; empty = false }, report) | Lt | Gte | Lte | Gt -> let d = Helper.(Dynamic (DynType.t ())) in let expected = [ d; d ] in let report = Helper.compare_args pos expected types report in - ({ result = Raw Bool; pos; empty = false }, report) + ({ pos; empty = false }, 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 - ({ result = Raw Integer; pos; empty = false }, report) + ({ pos; empty = false }, 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 - ({ result = Raw Bool; pos; empty = false }, report) + ({ pos; empty = false }, report) end +module Expression = TypeBuilder.Make (TypedExpression) + module Instruction = struct type t = Report.t list type t' = Report.t list @@ -401,7 +401,9 @@ module Instruction = struct fun report (_pos, expr, instructions) -> let result, r = expr in - let r2 = Helper.compare Helper.Bool (Expression.arg_of_repr result) [] in + let r2 = + Helper.compare Get_type.Bool (arg_of_repr result.result result.pos) [] + in List.fold_left instructions ~init:(r @ r2 @ report) @@ -431,7 +433,9 @@ module Instruction = struct fun _pos ~label instructions -> let result, report = label in let report = - Helper.compare Helper.String (Expression.arg_of_repr result) report + Helper.compare Get_type.String + (arg_of_repr result.result result.pos) + report in List.fold_left instructions ~init:report ~f:(fun acc a -> @@ -446,13 +450,16 @@ module Instruction = struct t = fun pos variable _ expression -> let right_expression, report = expression in - let expr1, report' = Expression.ident variable in - let report = report' @ report in + + let report' = Option.map snd variable.index |> Option.value ~default:[] in + + let report = List.rev_append report' report in match right_expression.empty with | true -> report | false -> ( - let op1 = Expression.arg_of_repr expr1 in - let op2 = Expression.arg_of_repr right_expression in + let var_type = 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 let d = Helper.DynType.t () in (* Every part of the assignation should be the same type *) @@ -483,6 +490,3 @@ module Location = struct in report end - -let get_type : Expression.t' -> Helper.type_of = - fun t' -> match (fst t').result with Raw r -> r | Variable r -> r diff --git a/lib/syntax/type_of.mli b/lib/syntax/type_of.mli index a009c48..551f9ac 100644 --- a/lib/syntax/type_of.mli +++ b/lib/syntax/type_of.mli @@ -1,11 +1,3 @@ -module Helper : sig - type type_of = - | Integer (** A numeric value *) - | Bool (** A boolean, not a real type *) - | String (** String value *) - | NumericString -end - include S.Analyzer (** The module [type_of] populate the report with differents inconsistency errors in the types. @@ -13,5 +5,3 @@ include S.Analyzer - Assigning a [string] value in an [integer] variable - Comparing a [string] with an [integer] - Giving the wrong type in the argument for a function and so one. *) - -val get_type : Expression.t' -> Helper.type_of |