|
@@ -142,26 +142,23 @@ end
|
|
|
|
|
|
module TypeBuilder = Compose.Expression (Get_type)
|
|
|
|
|
|
-type t' = { result : Get_type.t Lazy.t; pos : S.pos; empty : bool }
|
|
|
+type t' = { result : Get_type.t Lazy.t; pos : S.pos }
|
|
|
|
|
|
let arg_of_repr : Get_type.t Lazy.t -> S.pos -> Helper.argument_repr =
|
|
|
fun type_of pos -> { pos; t = Lazy.force type_of }
|
|
|
|
|
|
module TypedExpression = struct
|
|
|
type nonrec t' = t' * Report.t list
|
|
|
- type state = { pos : S.pos; empty : bool }
|
|
|
+ type state = { pos : S.pos }
|
|
|
type t = state * Report.t list
|
|
|
|
|
|
let v : Get_type.t Lazy.t * t -> t' =
|
|
|
- fun (type_of, (t, r)) ->
|
|
|
- ({ result = type_of; pos = t.pos; empty = t.empty }, r)
|
|
|
+ fun (type_of, (t, r)) -> ({ result = type_of; pos = t.pos }, r)
|
|
|
|
|
|
(** The variable has type string when starting with a '$' *)
|
|
|
let ident :
|
|
|
(S.pos, Get_type.t Lazy.t * t) S.variable -> Get_type.t Lazy.t -> t =
|
|
|
fun var _type_of ->
|
|
|
- let empty = false in
|
|
|
-
|
|
|
(* Extract the error from the index *)
|
|
|
let report =
|
|
|
match var.index with
|
|
@@ -170,36 +167,35 @@ module TypedExpression = struct
|
|
|
let _, r = expr in
|
|
|
r
|
|
|
in
|
|
|
- ({ pos = var.pos; empty }, report)
|
|
|
+ ({ pos = var.pos }, report)
|
|
|
|
|
|
let integer : S.pos -> string -> Get_type.t Lazy.t -> t =
|
|
|
fun pos value _type_of ->
|
|
|
let int_value = int_of_string_opt value in
|
|
|
|
|
|
- let empty, report =
|
|
|
+ let report =
|
|
|
match int_value with
|
|
|
- | Some 0 -> (true, [])
|
|
|
- | Some _ -> (false, [])
|
|
|
- | None -> (false, Report.error pos "Invalid integer value" :: [])
|
|
|
+ | Some 0 -> []
|
|
|
+ | Some _ -> []
|
|
|
+ | None -> Report.error pos "Invalid integer value" :: []
|
|
|
in
|
|
|
|
|
|
- ({ pos; empty }, report)
|
|
|
+ ({ pos }, report)
|
|
|
|
|
|
let literal :
|
|
|
S.pos -> (Get_type.t Lazy.t * t) T.literal list -> Get_type.t Lazy.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 (_, report) -> function
|
|
|
- | T.Text t ->
|
|
|
- let empty = String.equal t String.empty in
|
|
|
- ({ pos; empty }, report)
|
|
|
- | T.Expression t -> snd t)
|
|
|
+ let init = [] in
|
|
|
+ let report =
|
|
|
+ List.fold_left values ~init ~f:(fun report -> function
|
|
|
+ | T.Text _ -> report
|
|
|
+ | T.Expression (_, t) ->
|
|
|
+ let report = List.rev_append (snd t) report in
|
|
|
+ report)
|
|
|
in
|
|
|
-
|
|
|
- result
|
|
|
+ ({ pos }, report)
|
|
|
|
|
|
let function_ :
|
|
|
S.pos ->
|
|
@@ -219,7 +215,7 @@ module TypedExpression = struct
|
|
|
let arg = arg_of_repr type_of t.pos in
|
|
|
(arg :: types, r @ report))
|
|
|
in
|
|
|
- let types = List.rev types and default = { pos; empty = false } in
|
|
|
+ let types = List.rev types and default = { pos } in
|
|
|
|
|
|
match function_ with
|
|
|
| Arrcomp | Arrpos | Arrsize | Countobj | Desc | Dyneval | Getobj | Instr
|
|
@@ -232,7 +228,7 @@ module TypedExpression = struct
|
|
|
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 *)
|
|
|
- ({ pos; empty = false }, report)
|
|
|
+ ({ pos }, report)
|
|
|
| Input | Input' ->
|
|
|
(* Input should check the result if the variable is a num and raise a
|
|
|
message in this case.*)
|
|
@@ -260,7 +256,7 @@ module TypedExpression = struct
|
|
|
(* 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
|
|
|
- ({ pos; empty = false }, report)
|
|
|
+ ({ pos }, report)
|
|
|
| Mid | Mid' ->
|
|
|
let expected = Helper.[ Fixed String; Variable (Fixed Integer) ] in
|
|
|
let report = Helper.compare_args pos expected types report in
|
|
@@ -305,7 +301,7 @@ module TypedExpression = struct
|
|
|
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
|
|
|
- ({ pos; empty = false }, report)
|
|
|
+ ({ pos }, report)
|
|
|
|
|
|
let boperator :
|
|
|
S.pos ->
|
|
@@ -330,37 +326,35 @@ module TypedExpression = struct
|
|
|
|
|
|
When concatenating, it’s allowed to add an integer and a number.
|
|
|
*)
|
|
|
- ({ pos; empty = false }, report)
|
|
|
+ ({ pos }, report)
|
|
|
| T.Eq | T.Neq | Lt | Gte | Lte | Gt ->
|
|
|
(* If the expression is '' or 0, we accept the comparaison as if
|
|
|
instead of raising a warning *)
|
|
|
- if t1.empty || t2.empty then ({ pos; empty = false }, report)
|
|
|
- else
|
|
|
- let d = Helper.(Dynamic (DynType.t ())) in
|
|
|
- let expected = [ d; d ] in
|
|
|
- (* Compare and report as error if the types are incompatible. If no
|
|
|
- error is reported, try in strict mode, and report as a warning. *)
|
|
|
- let report =
|
|
|
- match
|
|
|
- Helper.compare_args ~level:Error pos expected (List.rev types)
|
|
|
+ let d = Helper.(Dynamic (DynType.t ())) in
|
|
|
+ let expected = [ d; d ] in
|
|
|
+ (* Compare and report as error if the types are incompatible. If no
|
|
|
+ error is reported, try in strict mode, and report as a warning. *)
|
|
|
+ let report =
|
|
|
+ match
|
|
|
+ Helper.compare_args ~level:Error pos expected (List.rev types)
|
|
|
+ report
|
|
|
+ with
|
|
|
+ | [] ->
|
|
|
+ Helper.compare_args ~strict:true pos expected (List.rev types)
|
|
|
report
|
|
|
- with
|
|
|
- | [] ->
|
|
|
- Helper.compare_args ~strict:true pos expected (List.rev types)
|
|
|
- report
|
|
|
- | report -> report
|
|
|
- in
|
|
|
- ({ pos; empty = false }, report)
|
|
|
+ | report -> report
|
|
|
+ in
|
|
|
+ ({ pos }, 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
|
|
|
- ({ pos; empty = false }, report)
|
|
|
+ ({ pos }, 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
|
|
|
- ({ pos; empty = false }, report)
|
|
|
+ ({ pos }, report)
|
|
|
end
|
|
|
|
|
|
module Expression = TypeBuilder.Make (TypedExpression)
|
|
@@ -448,13 +442,9 @@ module Instruction = struct
|
|
|
let report' = Option.map snd variable.index |> Option.value ~default:[] in
|
|
|
|
|
|
let report = List.rev_append report' report in
|
|
|
- match
|
|
|
- ( right_expression.empty,
|
|
|
- op,
|
|
|
- Get_type.get_type (Lazy.force right_expression.result) )
|
|
|
- with
|
|
|
- | true, _, _ -> report
|
|
|
- | _, T.Eq', Get_type.(Integer) ->
|
|
|
+
|
|
|
+ match (op, Get_type.get_type (Lazy.force right_expression.result)) with
|
|
|
+ | T.Eq', Get_type.Integer ->
|
|
|
(* Assigning an intger is allowed in a string variable, but raise a
|
|
|
warning. *)
|
|
|
let var_type = Lazy.from_val (Get_type.ident variable) in
|
|
@@ -462,7 +452,7 @@ module Instruction = struct
|
|
|
let expected = Helper.[ Fixed Integer ] in
|
|
|
Helper.compare_args ~strict:true ~level:Report.Warn pos expected [ op1 ]
|
|
|
report
|
|
|
- | false, _, _ -> (
|
|
|
+ | _, _ -> (
|
|
|
let var_type = Lazy.from_val (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
|