open StdLabels

module Expression = struct
  type t = unit
  type t' = unit

  include Default.Expression (struct
    type nonrec t = t

    let default = ()
  end)

  let v : t * Report.t list -> t' * Report.t list = Fun.id
end

module Instruction = struct
  type expression = Expression.t' S.repr
  type cause = Missing_else | Unchecked_path

  type t = {
    block_pos : S.pos;
    has_gt : bool;
    is_gt : bool;
    pos : (cause * S.pos) option;
  }

  type t' = t

  (** For each instruction, return thoses two informations :

      - the intruction contains at [gt] 
      - the last instruction is a [gt]

    *)
  let v : t * Report.t list -> t' * Report.t list = Fun.id

  let default =
    {
      block_pos = (Lexing.dummy_pos, Lexing.dummy_pos);
      has_gt = false;
      is_gt = false;
      pos = None;
    }

  (** Call for an instruction like [GT] or [*CLR] *)
  let call : S.pos -> T.keywords -> expression list -> t S.repr =
   fun pos f _ report ->
    ignore pos;
    match f with
    | T.Goto | T.XGoto ->
        ({ block_pos = pos; has_gt = true; is_gt = true; pos = None }, report)
    | T.Gosub ->
        ({ block_pos = pos; has_gt = false; is_gt = true; pos = None }, report)
    | _ -> (default, report)

  (** Label for a loop *)
  let location : S.pos -> string -> t S.repr =
   fun _ _ report -> (default, report)

  (** Comment *)
  let comment : S.pos -> t S.repr = fun _ report -> (default, report)

  (** Raw expression *)
  let expression : expression -> t S.repr = fun _ report -> (default, report)

  (** The content of a block is very linear, I only need to check the last element *)
  let check_block : S.pos -> t S.repr list -> t S.repr =
   fun pos instructions report ->
    let last_element =
      List.fold_left instructions ~init:(default, report)
        ~f:(fun (t, report) instruction ->
          let result, report = instruction report in
          let has_gt = result.has_gt || t.has_gt in
          let is_gt = result.is_gt || t.is_gt in
          ({ result with block_pos = pos; is_gt; has_gt }, report))
    in
    last_element

  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 clause ~elifs ~else_ report ->
    (* For each block, evaluate the instructions *)
    let report, res, has_gt, is_gt =
      List.fold_left ~init:(report, [], false, false) (clause :: elifs)
        ~f:(fun (report, acc, has_gt, is_gt) clause ->
          let pos, _, instructions = clause in
          let clause_t, report = check_block pos instructions report in
          let has_gt = has_gt || clause_t.has_gt
          and is_gt = is_gt || clause_t.is_gt in

          (report, (clause_t, pos) :: acc, has_gt, is_gt))
    in

    let else_pos, else_block, report =
      match else_ with
      | Some (pos, instructions) ->
          let block, report = check_block pos instructions report in
          (pos, block, report)
      | None -> (pos, default, report)
    in
    let has_gt = has_gt || else_block.has_gt
    and is_gt = is_gt || else_block.is_gt in

    let blocks = (else_block, else_pos) :: res in

    (* Check if one of the clauses already holds a dead end*)
    match List.find_opt res ~f:(fun (res, _) -> res.pos != None) with
    | Some (v, _) -> (v, report)
    | None -> (
        match (is_gt, has_gt) with
        | _, true -> (
            (* There is gt intruction in one of the branch, we need to checks
               the others *)
            match List.find_opt blocks ~f:(fun (f, _) -> not f.is_gt) with
            | None ->
                (* Every branch in the if is covered. It’s ok. *)
                ({ default with block_pos = pos; is_gt; has_gt }, report)
            | Some (_, pos) ->
                (* TODO check if [pos] is the whole block *)
                let cause =
                  match else_ with None -> Missing_else | _ -> Unchecked_path
                in
                ( { default with block_pos = pos; pos = Some (cause, pos) },
                  report ))
        | _, _ -> ({ default with block_pos = pos; has_gt; is_gt }, report))

  let act : S.pos -> label:expression -> t S.repr list -> t S.repr =
   fun pos ~label expressions report ->
    ignore label;
    check_block pos expressions report

  let assign :
      S.pos ->
      (S.pos, expression) S.variable ->
      T.assignation_operator ->
      expression ->
      t S.repr =
   fun _ _ _ _ report -> (default, report)
end

module Location = struct
  type t = unit
  type instruction = Instruction.t

  let location : S.pos -> instruction S.repr list -> t S.repr =
   fun _pos instructions report ->
    ( (),
      List.fold_left instructions ~init:report ~f:(fun report instruction ->
          let t, report = instruction report in

          match (t.Instruction.is_gt, t.Instruction.pos) with
          | false, Some (cause, value) ->
              ignore cause;
              if t.Instruction.block_pos != value then
                match cause with
                | Missing_else ->
                    Report.debug value "Possible dead end (no else fallback)"
                    :: report
                | Unchecked_path ->
                    Report.warn value "Possible dead end (unmatched path)"
                    :: report
              else report
          | _ -> report) )
end