open StdLabels

module Ast = struct
  type 'a variable = { pos : 'a; name : string; index : 'a expression option }
  [@@deriving eq, show]

  and 'a expression =
    | Integer of 'a * string
    | Literal of 'a * string
    | Ident of 'a variable
    | BinaryOp of 'a * T.boperator * 'a expression * 'a expression
    | Op of 'a * T.uoperator * 'a expression
    | Function of 'a * T.function_ * 'a expression list
  [@@deriving eq, show]

  and 'a condition = 'a * 'a expression * 'a statement list

  and 'a statement =
    | If of {
        loc : 'a;
        then_ : 'a condition;
        elifs : 'a condition list;
        else_ : 'a statement list;
      }
    | Act of { loc : 'a; label : 'a expression; statements : 'a statement list }
    | Declaration of ('a * 'a variable * T.assignation_operator * 'a expression)
    | Expression of 'a expression
    | Comment of 'a
    | Call of 'a * T.keywords * 'a expression list
    | Location of 'a * string
  [@@deriving eq, show]
end

(** Default implementation for the expression *)
module Expression : S.Expression with type t' = S.pos Ast.expression = struct
  type t = S.pos Ast.expression
  type t' = t

  let v : t -> t' * Report.t list = fun t -> (t, [])
  let integer : S.pos -> string -> t = fun pos i -> Ast.Integer (pos, i)
  let literal : S.pos -> string -> t = fun pos l -> Ast.Literal (pos, l)

  let function_ : S.pos -> T.function_ -> t list -> t =
   fun pos name args -> Ast.Function (pos, name, args)

  let uoperator : S.pos -> T.uoperator -> t -> t =
   fun pos op expression -> Ast.Op (pos, op, expression)

  let boperator : S.pos -> T.boperator -> t -> t -> t =
   fun pos op op1 op2 ->
    let op1 = op1 and op2 = op2 in
    Ast.BinaryOp (pos, op, op1, op2)

  let ident : (S.pos, t) S.variable -> t =
   fun { pos; name; index } ->
    let index = Option.map (fun i -> i) index in
    Ast.Ident { pos; name; index }
end

module Instruction :
  S.Instruction
    with type expression = Expression.t' * Report.t list
     and type t' = S.pos Ast.statement = struct
  type t = S.pos Ast.statement
  type t' = t

  let v : t -> t' * Report.t list = fun t -> (t, [])

  type expression = Expression.t' * Report.t list

  let call : S.pos -> T.keywords -> expression list -> t S.repr =
   fun pos name args _ ->
    let args = List.map ~f:fst args in
    Ast.Call (pos, name, args)

  let location : S.pos -> string -> t S.repr =
   fun loc label _ -> Ast.Location (loc, label)

  let comment : S.pos -> t S.repr = fun pos _ -> Ast.Comment pos

  let expression : expression -> t S.repr =
   fun expr _ -> Ast.Expression (fst expr)

  let if_ :
      S.pos ->
      (expression, t) S.clause ->
      elifs:(expression, t) S.clause list ->
      else_:(S.pos * t S.repr list) option ->
      t S.repr =
   fun pos predicate ~elifs ~else_ _ ->
    let clause (pos, expr, repr) =
      let repr = List.map ~f:(fun instr -> instr []) repr in
      (pos, fst @@ expr, repr)
    in
    let elifs = List.map ~f:clause elifs
    and else_ =
      match else_ with
      | None -> []
      | Some (_, instructions) ->
          List.map ~f:(fun instr -> instr []) instructions
    in

    Ast.If { loc = pos; then_ = clause predicate; elifs; else_ }

  let act : S.pos -> label:expression -> t S.repr list -> t S.repr =
   fun pos ~label statements _ ->
    let label = fst label
    and statements = List.map ~f:(fun instr -> instr []) statements in
    Ast.Act { loc = pos; label; statements }

  let assign :
      S.pos ->
      (S.pos, expression) S.variable ->
      T.assignation_operator ->
      expression ->
      t S.repr =
   fun pos_loc { pos; name; index } op expr _ ->
    (*let index = Option.map (fun i -> fst @@ Expression.observe (i [])) index*)
    let index = Option.map fst index in
    let expr = fst expr in
    Ast.Declaration (pos_loc, { pos; name; index }, op, expr)
end

module Location = struct
  type instruction = (Instruction.t' * Report.t list) S.repr
  type t = S.pos * S.pos Ast.statement list

  let location : S.pos -> instruction list -> (t * Report.t list) S.repr =
   fun pos block report ->
    let report, block =
      List.fold_left_map ~init:report block ~f:(fun report b ->
          let v, report = b report in
          (report, v))
    in
    ((pos, block), report)
end