From 2cad3abf180c14e0c026033d65f4fb895b5348f7 Mon Sep 17 00:00:00 2001 From: Chimrod <> Date: Sat, 21 Oct 2023 18:55:42 +0200 Subject: Updated the type checker in a more precise way --- lib/syntax/type_of.ml | 221 +++++++++++++++++++++++++++++++------------------- 1 file changed, 138 insertions(+), 83 deletions(-) (limited to 'lib') diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml index b0d14ec..6e28ae0 100644 --- a/lib/syntax/type_of.ml +++ b/lib/syntax/type_of.ml @@ -1,61 +1,97 @@ open StdLabels module Helper = struct - type t = Integer | Bool | String | Any + 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"] + (** 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 dyn_type = t -> t - (** Dynamic type is a type unknown during the code. + module DynType = struct + type nonrec t = t -> t + (** Dynamic type is a type unknown during the code. For example, the equality operator accept either Integer or String, but we expect that both sides of the equality uses the same type.*) - (** Build a new dynamic type *) - let dyn_type : unit -> dyn_type = - fun () -> - let stored = ref None in - fun t -> - match !stored with - | None -> - stored := Some t; - t - | Some t -> t + (** Build a new dynamic type *) + let t : unit -> t = + fun () -> + let stored = ref None in + fun t -> + match !stored with + | None -> + stored := Some t; + t + | Some t -> t + end (** Declare an argument for a function. - Either we already know the type and we just have to compare. - Either the type shall constrained by another one - Or we have a variable number of arguments. *) - type argument = Fixed of t | Dynamic of dyn_type | Variable of argument + type argument = + | Fixed of type_of + | Dynamic of DynType.t + | Variable of argument let compare : ?strict:bool -> ?level:Report.level -> - t -> + type_of -> argument_repr -> Report.t list -> Report.t list = fun ?(strict = false) ?(level = Report.Warn) expected actual report -> let equal = match (expected, actual.t) with - | _, Any -> true - | Any, _ -> true - | String, String -> true - | Integer, Integer -> true - | Bool, Bool -> true - | Bool, Integer when not strict -> true - | Integer, Bool -> true - | String, Integer when not strict -> true - | String, Bool when not strict -> true + (* Strict equality for this ones, always true *) + | String, Variable String + | String, Raw String + | String, Raw NumericString + | String, Variable NumericString + | Integer, Variable Integer + | Integer, Raw Integer + | NumericString, Raw NumericString + | NumericString, Variable NumericString + | Bool, Raw Bool + | Bool, Variable Bool + (* Also include the conversion between bool and integer *) + | Integer, Raw Bool + | Integer, Variable Bool + (* The type NumericString can be used as a generic type in input *) + | _, Variable NumericString + | NumericString, Raw String + | NumericString, Variable String + | NumericString, Raw Integer + | NumericString, Variable Integer + (* A numeric type can be used at any place *) + | String, Raw Integer -> + true + | Bool, Variable Integer when not strict -> true + | Bool, Raw Integer when not strict -> true + | String, Variable Integer when not strict -> true + | String, Raw Bool when not strict -> true + | String, Variable Bool when not strict -> true + | Integer, Variable String when not strict -> true + (* Explicit rejected cases *) + | Integer, Raw NumericString when not strict -> true + | Integer, Raw String -> false | _, _ -> false in if equal then report 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 expected pp - actual.t + Format.asprintf "The type %a is expected but got %a" pp_type_of expected + pp_type_of result_type in Report.message level actual.pos message :: report @@ -70,7 +106,7 @@ module Helper = struct match expected with | Fixed t -> compare ~level t param report | Dynamic d -> - let type_ = d param.t in + let type_ = match d param.t with Raw r -> r | Variable v -> v in compare ~strict ~level type_ param report | Variable c -> compare_parameter ~level c param report @@ -121,8 +157,8 @@ module Expression = struct fun var report -> let empty = false in match var.name.[0] with - | '$' -> ({ result = String; pos = var.pos; empty }, report) - | _ -> ({ result = Integer; pos = var.pos; empty }, report) + | '$' -> ({ result = Variable String; pos = var.pos; empty }, report) + | _ -> ({ result = Variable Integer; pos = var.pos; empty }, report) let integer : S.pos -> string -> t S.repr = fun pos value report -> @@ -135,12 +171,17 @@ module Expression = struct | None -> (false, Report.error pos "Invalid integer value" :: report) in - ({ result = Integer; pos; empty }, report) + ({ result = Raw Integer; pos; empty }, report) let literal : S.pos -> string -> t S.repr = fun pos value report -> let empty = String.equal String.empty value in - ({ result = String; pos; empty }, report) + let type_of = + match int_of_string_opt value with + | Some _ -> Helper.NumericString + | None -> Helper.String + in + ({ result = Raw type_of; pos; empty }, report) let function_ : S.pos -> T.function_ -> t S.repr list -> t S.repr = fun pos function_ params _acc -> @@ -154,83 +195,84 @@ module Expression = struct (arg :: types, report)) in let types = List.rev types - and default = { result = Any; pos; empty = false } in + and default = { result = Variable NumericString; pos; empty = false } in match function_ with - | Arrcomp | Arrpos | Arrsize | Countobj | Desc | Dyneval | Func | Getobj - | Instr | Isplay -> - ({ default with result = Integer }, report) - | Desc' | Dyneval' | Func' | Getobj' -> - ({ default with result = String }, report) + | 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) | Iif | Iif' -> - let d = Helper.dyn_type () in + 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 Helper.Bool in + let result = d (Raw Helper.Bool) in ({ result; 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 = String; pos; empty = false }, report) + ({ result = Variable NumericString; pos; empty = false }, report) | Isnum -> let expected = Helper.[ Fixed String ] in let report = Helper.compare_args pos expected types report in - ({ result = Bool; pos; empty = false }, report) + ({ result = Raw Bool; pos; empty = false }, report) | Lcase | Lcase' | Ucase | Ucase' -> let expected = Helper.[ Fixed String ] in let report = Helper.compare_args pos expected types report in - ({ result = String; pos; empty = false }, report) + ({ result = Raw String; pos; empty = false }, report) | Len -> - let expected = Helper.[ Fixed Any ] in + let expected = Helper.[ Fixed NumericString ] in let report = Helper.compare_args pos expected types report in - ({ result = Integer; pos; empty = false }, report) + ({ result = Raw Integer; pos; empty = false }, report) | Loc -> let expected = Helper.[ Fixed String ] in let report = Helper.compare_args pos expected types report in - ({ result = Bool; pos; empty = false }, report) + ({ result = Variable Bool; pos; empty = false }, report) | Max | Max' | Min | Min' -> - let d = Helper.dyn_type () in + 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 Helper.Bool in + let result = d (Raw Helper.Bool) in ({ result; 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 = String; pos; empty = false }, report) - | Msecscount -> ({ result = Integer; pos; empty = false }, report) + ({ result = Variable String; pos; empty = false }, report) + | Msecscount -> ({ result = Raw Integer; pos; empty = false }, report) | Rand -> let expected = Helper.[ Variable (Fixed Integer) ] in let report = Helper.compare_args pos expected types report in - ({ result = Integer; pos; empty = false }, report) - | Replace -> ({ result = Integer; pos; empty = false }, report) - | Replace' -> ({ result = String; pos; empty = false }, report) - | Rgb -> ({ result = Integer; pos; empty = false }, report) + ({ 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) | Qspver | Qspver' | Rnd -> (* No arg *) let report = Helper.compare_args pos [] types report in - ({ result = Integer; pos; empty = false }, report) - | Selact -> ({ result = Integer; pos; empty = false }, report) - | Stattxt -> ({ result = Integer; pos; empty = false }, report) - | Stattxt' -> ({ result = String; pos; empty = false }, report) + ({ 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) | Str | Str' -> let expected = Helper.[ Variable (Fixed Integer) ] in let report = Helper.compare_args pos expected types report in - ({ default with result = String }, report) - | Strcomp -> ({ result = Integer; pos; empty = false }, report) - | Strfind -> ({ result = Integer; pos; empty = false }, report) - | Strfind' -> ({ result = String; pos; empty = false }, report) - | Strpos -> ({ result = Integer; pos; empty = false }, report) - | Trim -> ({ result = Integer; pos; empty = false }, report) - | Trim' -> ({ result = String; pos; empty = false }, report) + ({ 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) | Val -> - let expected = Helper.[ Fixed Any ] in + let expected = Helper.[ Fixed NumericString ] in let report = Helper.compare_args pos expected types report in - ({ result = Integer; pos; empty = false }, report) + ({ result = Raw Integer; pos; empty = false }, report) (** Unary operator like [-123] or [+'Text']*) let uoperator : S.pos -> T.uoperator -> t S.repr -> t S.repr = @@ -242,7 +284,7 @@ module Expression = struct let types = [ arg_of_repr t ] in let expected = Helper.[ Fixed Integer ] in let report = Helper.compare_args pos expected types report in - ({ result = Integer; pos; empty = false }, report) + ({ result = Raw Integer; pos; empty = false }, report) let boperator : S.pos -> T.boperator -> t S.repr -> t S.repr -> t S.repr = fun pos operator t1 t2 report -> @@ -251,40 +293,46 @@ module Expression = struct let types = [ arg_of_repr t1; arg_of_repr t2 ] in match operator with | T.Plus -> - (* Operation over number *) - let d = Helper.(dyn_type ()) in - let expected = Helper.[ Dynamic d; Dynamic d ] in + let d = Helper.DynType.t () in + (* Remove the empty elements *) + let types = + List.filter_map [ t1; t2 ] ~f:(fun t -> + (* TODO could be added in the logs *) + match t.empty with true -> None | false -> Some (arg_of_repr t)) + 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.Integer in + let result = d Helper.(Variable Integer) in ({ result; 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 = Bool; pos; empty = false }, report) + ({ result = Raw Bool; pos; empty = false }, report) else - let d = Helper.(Dynamic (dyn_type ())) in + let d = Helper.(Dynamic (DynType.t ())) in let expected = [ d; d ] in let report = Helper.compare_args ~strict:true pos expected (List.rev types) report in - ({ result = Bool; pos; empty = false }, report) + ({ result = Raw Bool; pos; empty = false }, report) | Lt | Gte | Lte | Gt -> - let d = Helper.(Dynamic (dyn_type ())) in + let d = Helper.(Dynamic (DynType.t ())) in let expected = [ d; d ] in let report = Helper.compare_args pos expected types report in - ({ result = Bool; pos; empty = false }, report) + ({ result = Raw Bool; 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 = Integer; pos; empty = false }, report) + ({ result = Raw Integer; 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 = Bool; pos; empty = false }, report) + ({ result = Raw Bool; pos; empty = false }, report) end module Instruction = struct @@ -360,17 +408,24 @@ module Instruction = struct let right_expression, report = expression report in match right_expression.empty with | true -> ((), report) - | false -> + | false -> ( let expr1, report = Expression.ident variable report in let op1 = Expression.arg_of_repr expr1 in let op2 = Expression.arg_of_repr right_expression in - let d = Helper.dyn_type () in + let d = Helper.DynType.t () in (* Every part of the assignation should be the same type *) let expected = Helper.[ Dynamic d; Dynamic d ] in - ( (), - Helper.compare_args ~level:Report.Debug pos expected [ op1; op2 ] - report ) + + match + Helper.compare_args ~strict:false ~level:Report.Error pos expected + [ op1; op2 ] [] + with + | [] -> + ( (), + Helper.compare_args ~strict:true ~level:Report.Debug pos expected + [ op1; op2 ] report ) + | reports -> ((), reports @ report)) end module Location = struct -- cgit v1.2.3