Moved the checks in a dedicated library

1 files changed, 0 insertions, 171 deletions

diff --git a/lib/syntax/dead_end.ml b/lib/syntax/dead_end.ml
deleted file mode 100644
index c0dbc58..0000000
--- a/lib/syntax/dead_end.ml
+++ /dev/null
@@ -1,171 +0,0 @@
-open StdLabels
-
-let identifier = "dead_end"
-let description = "Check for dead end in the code"
-let is_global = false
-let active = ref false
-
-type context = unit
-
-let initialize = Fun.id
-let finalize () = []
-
-module Expression = struct
-  type t = unit
-
-  include Default.Expression (struct
-    type nonrec t = t
-
-    let default = ()
-  end)
-
-  let v : t -> t' = fun () -> ()
-end
-
-module Instruction = struct
-  type cause = Missing_else | Unchecked_path
-
-  type state = {
-    block_pos : S.pos;
-    has_gt : bool;
-    is_gt : bool;
-    pos : (cause * S.pos) option;
-  }
-
-  type t = state
-  type t' = state
-
-  (** For each instruction, return thoses two informations :
-
-      - the intruction contains at [gt] 
-      - the last instruction is a [gt]
-
-    *)
-  let v : t -> t' = fun t -> t
-
-  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.t' list -> t =
-   fun pos f _ ->
-    ignore pos;
-    match f with
-    | T.Goto | T.XGoto ->
-        { block_pos = pos; has_gt = true; is_gt = true; pos = None }
-    | T.Gosub -> { block_pos = pos; has_gt = false; is_gt = true; pos = None }
-    | _ -> default
-
-  (** Label for a loop *)
-  let location : S.pos -> string -> t = fun _ _ -> default
-
-  (** Comment *)
-  let comment : S.pos -> t = fun _ -> default
-
-  (** Raw expression *)
-  let expression : Expression.t' -> t = fun _ -> default
-
-  (** The content of a block is very linear, I only need to check the last element *)
-  let check_block : S.pos -> t list -> t =
-   fun pos instructions ->
-    let last_element =
-      List.fold_left instructions ~init:default ~f:(fun t instruction ->
-          let result = instruction 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 })
-    in
-    last_element
-
-  let if_ :
-      S.pos ->
-      (Expression.t', t) S.clause ->
-      elifs:(Expression.t', t) S.clause list ->
-      else_:(S.pos * t list) option ->
-      t =
-   fun pos clause ~elifs ~else_ ->
-    (* For each block, evaluate the instructions *)
-    let res, has_gt, is_gt =
-      List.fold_left ~init:([], false, false) (clause :: elifs)
-        ~f:(fun (acc, has_gt, is_gt) clause ->
-          let pos, _, instructions = clause in
-          let clause_t = check_block pos instructions in
-          let has_gt = has_gt || clause_t.has_gt
-          and is_gt = is_gt || clause_t.is_gt in
-
-          ((clause_t, pos) :: acc, has_gt, is_gt))
-    in
-
-    let else_pos, else_block =
-      match else_ with
-      | Some (pos, instructions) ->
-          let block = check_block pos instructions in
-          (pos, block)
-      | None -> (pos, default)
-    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
-    | 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 }
-            | 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) })
-        | _, _ -> { default with block_pos = pos; has_gt; is_gt })
-
-  let act : S.pos -> label:Expression.t' -> t list -> t =
-   fun pos ~label expressions ->
-    ignore label;
-    check_block pos expressions
-
-  let assign :
-      S.pos ->
-      (S.pos, Expression.t') S.variable ->
-      T.assignation_operator ->
-      Expression.t' ->
-      t =
-   fun _ _ _ _ -> default
-end
-
-module Location = struct
-  type t = Report.t list
-
-  let v = Fun.id
-
-  let location : unit -> S.pos -> Instruction.t' list -> t =
-   fun () _pos instructions ->
-    List.fold_left instructions ~init:[] ~f:(fun report t ->
-        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