open StdLabels module Expression : S.Expression with type t' = Report.t list = struct type t = Report.t list type t' = t let v : t -> t' = Fun.id (** 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 -> match content with | [ T.Expression expr; T.Text "" ] -> ignore expr; let msg = Report.debug pos "This expression can be simplified" in [ msg ] | _ -> [] let ident : (S.pos, t) S.variable -> t = fun { pos; name : string; index : t option } -> ignore pos; ignore name; match index with None -> [] | Some v -> v let integer : S.pos -> string -> t = fun _ _ -> [] let function_ : S.pos -> T.function_ -> t list -> t = fun _ _ expressions -> List.concat expressions let uoperator : S.pos -> T.uoperator -> t -> t = fun _ _ expr1 -> expr1 let boperator : S.pos -> T.boperator -> t -> t -> t = fun _ _ expr1 expr2 -> expr1 @ expr2 end module Instruction : S.Instruction with type t' = Report.t list and type expression = Expression.t' = struct type t = Report.t list (** Internal type used in the evaluation *) type t' = t let v : t -> t' = Fun.id type expression = Expression.t' let call : S.pos -> T.keywords -> expression list -> t = fun pos k exprs -> ignore pos; ignore k; List.concat exprs let location : S.pos -> string -> t = fun _ _ -> [] let comment : S.pos -> t = fun _ -> [] let expression : expression -> t = Fun.id let act : S.pos -> label:expression -> t list -> t = fun pos ~label instructions -> ignore pos; List.concat (label :: instructions) let fold_clause : (expression, t) S.clause -> t = fun (_pos1, expression, ts) -> List.concat (expression :: ts) let if_ : S.pos -> (expression, t) S.clause -> elifs:(expression, t) S.clause list -> else_:(S.pos * t list) option -> t = fun pos clause ~elifs ~else_ -> ignore pos; let init = match else_ with | None -> fold_clause clause | Some (_, ts) -> List.rev_append (fold_clause clause) (List.concat ts) in List.fold_left elifs ~init ~f:(fun t clause -> List.rev_append (fold_clause clause) t) let assign : S.pos -> (S.pos, expression) S.variable -> T.assignation_operator -> expression -> t = fun pos variable op expression -> ignore pos; ignore op; match variable.index with | None -> expression | Some v -> List.rev_append v expression end module Location = struct type t = unit type instruction = Instruction.t' let location : S.pos -> instruction list -> t * Report.t list = fun pos intructions -> ignore pos; ((), List.concat intructions) end