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/syntax')
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