Moved the checks in a dedicated library

1 files changed, 0 insertions, 159 deletions

diff --git a/lib/syntax/locations.ml b/lib/syntax/locations.ml
deleted file mode 100644
index 17f33bd..0000000
--- a/lib/syntax/locations.ml
+++ /dev/null
@@ -1,159 +0,0 @@
-open StdLabels
-
-module IgnoreCaseString = struct
-  type t = string
-
-  let compare t1 t2 =
-    String.compare (String.lowercase_ascii t1) (String.lowercase_ascii t2)
-
-  let equal t1 t2 =
-    String.equal (String.lowercase_ascii t1) (String.lowercase_ascii t2)
-end
-
-module LocationSet = Set.Make (IgnoreCaseString)
-module LocationCalls = Map.Make (IgnoreCaseString)
-
-let identifier = "locations"
-let description = "Ensure every call points to an existing location"
-let is_global = true
-let active = ref true
-
-type t = {
-  locations : LocationSet.t;
-  calls : (string * S.pos) list LocationCalls.t;
-}
-
-type context = t ref
-
-let initialize () =
-  ref { locations = LocationSet.empty; calls = LocationCalls.empty }
-
-let finalize : context -> (string * Report.t) list =
- fun context ->
-  LocationCalls.fold
-    (fun location positions acc ->
-      let message = Printf.sprintf "The location %s does not exists" location in
-
-      List.fold_left ~init:acc (List.rev positions)
-        ~f:(fun acc (loc, position) ->
-          let report = Report.error position message in
-          (loc, report) :: acc))
-    !context.calls []
-
-(** Register a new call to a defined location. *)
-let registerCall : S.pos -> string -> t -> t =
- fun pos location t ->
-  let file_name = (fst pos).Lexing.pos_fname in
-  match
-    IgnoreCaseString.equal location file_name
-    || LocationSet.mem location t.locations
-  with
-  | true -> t
-  | false ->
-      (* The location is not yet defined, register the call for later *)
-      let calls =
-        LocationCalls.update location
-          (function
-            | None -> Some [ (file_name, pos) ]
-            | Some poss ->
-                Some
-                  (let new_pos = (file_name, pos) in
-                   new_pos :: poss))
-          t.calls
-      in
-      { t with calls }
-
-(** Add a new location in the list of all the collected elements *)
-let registerLocation : string -> t -> t =
- fun location t ->
-  let calls = LocationCalls.remove location t.calls
-  and locations = LocationSet.add location t.locations in
-  { calls; locations }
-
-(** The module Expression is pretty simple, we are only interrested by the
-    strings ( because only the first argument of [gt …] is read ). 
-
-    If the string is too much complex, we just ignore it. *)
-module Expression = struct
-  type t = string option
-
-  include Default.Expression (struct
-    type nonrec t = t
-
-    let default = None
-  end)
-
-  let v : t -> t' = Fun.id
-
-  (* Extract the litteral if this is a simple text *)
-  let literal : S.pos -> t' T.literal list -> t' =
-   fun _ ll -> match ll with Text lit :: [] -> Some lit | _ -> None
-end
-
-module Instruction = struct
-  type nonrec t = t -> t
-  type t' = t
-
-  let v : t -> t' = Fun.id
-
-  (** Keep a track of every gt or gs instruction *)
-  let call : S.pos -> T.keywords -> Expression.t' list -> t =
-   fun pos fn args t ->
-    match (fn, args) with
-    | T.Goto, Some dest :: _ -> registerCall pos dest t
-    | T.Gosub, Some dest :: _ -> registerCall pos dest t
-    | _ -> t
-
-  let location : S.pos -> string -> t = fun _ _ -> Fun.id
-  let comment : S.pos -> t = fun _ -> Fun.id
-  let expression : Expression.t' -> t = fun _ -> Fun.id
-
-  let if_ :
-      S.pos ->
-      (Expression.t', t) S.clause ->
-      elifs:(Expression.t', t) S.clause list ->
-      else_:(S.pos * t list) option ->
-      t =
-   fun _ clause ~elifs ~else_ t ->
-    let traverse_clause t clause =
-      let _, _, block = clause in
-      List.fold_left block ~init:t ~f:(fun t instruction -> instruction t)
-    in
-
-    let t = traverse_clause t clause in
-    let t = List.fold_left ~init:t ~f:traverse_clause elifs in
-    match else_ with
-    | None -> t
-    | Some (_, instructions) ->
-        List.fold_left instructions ~init:t ~f:(fun t instruction ->
-            instruction t)
-
-  let act : S.pos -> label:Expression.t' -> t list -> t =
-   fun _ ~label instructions t ->
-    ignore label;
-    List.fold_left instructions ~init:t ~f:(fun t instruction -> instruction t)
-
-  let assign :
-      S.pos ->
-      (S.pos, Expression.t') S.variable ->
-      T.assignation_operator ->
-      Expression.t' ->
-      t =
-   fun _ _ _ _ -> Fun.id
-end
-
-module Location = struct
-  type t = unit
-
-  let v : t -> Report.t list = fun () -> []
-
-  let location : context -> S.pos -> Instruction.t list -> t =
-   fun context pos instructions ->
-    (* Register the location *)
-    let file_name = (fst pos).Lexing.pos_fname in
-    let c = registerLocation file_name !context in
-    (* Then update the list of all the calls to the differents locations *)
-    context :=
-      List.fold_left instructions ~init:c ~f:(fun t instruction ->
-          instruction t)
-end