aboutsummaryrefslogtreecommitdiff
path: root/lib/checks/locations.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/checks/locations.ml')
-rw-r--r--lib/checks/locations.ml51
1 files changed, 13 insertions, 38 deletions
diff --git a/lib/checks/locations.ml b/lib/checks/locations.ml
index 8ee6ffa..8e5f500 100644
--- a/lib/checks/locations.ml
+++ b/lib/checks/locations.ml
@@ -74,7 +74,7 @@ let registerLocation : string -> t -> t =
{ calls; locations }
(** The module Expression is pretty simple, we are only interrested by the
- strings ( because only the first argument of [gt …] is read ).
+ strings ( because only the first argument of [gt …] is read ).
If the string is too much complex, we just ignore it. *)
module Expression = struct
@@ -99,6 +99,18 @@ module Instruction = struct
let v : t -> t' = Fun.id
+ include
+ Default.Instruction
+ (Expression)
+ (struct
+ type nonrec t = t
+
+ let default = Fun.id
+
+ let fold : t Seq.t -> t =
+ fun sequence t -> Seq.fold_left (fun acc t -> t acc) t sequence
+ end)
+
(** Keep a track of every gt or gs instruction *)
let call : S.pos -> T.keywords -> Expression.t' list -> t =
fun pos fn args t ->
@@ -106,43 +118,6 @@ module Instruction = struct
| 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