aboutsummaryrefslogtreecommitdiff
path: root/lib/checks/default.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/checks/default.ml')
-rw-r--r--lib/checks/default.ml84
1 files changed, 73 insertions, 11 deletions
diff --git a/lib/checks/default.ml b/lib/checks/default.ml
index a2b53f6..0c4d761 100644
--- a/lib/checks/default.ml
+++ b/lib/checks/default.ml
@@ -1,25 +1,23 @@
-(** Default implementation which does nothing.
+(** Default implementation which does nothing.
-This module is expected to be used when you only need to implement an analyze
-over a limited part of the whole syntax. *)
+ This module is expected to be used when you only need to implement an
+ analyze over a limited part of the whole syntax. *)
+open StdLabels
module S = Qsp_syntax.S
module T = Qsp_syntax.T
module Report = Qsp_syntax.Report
-module type T = sig
+module Expression (T' : sig
type t
val default : t
-end
-
-module Expression (T' : T) = struct
- (**
- Describe a variable, using the name in capitalized text, and an optionnal
+end) =
+struct
+ (** Describe a variable, using the name in capitalized text, and an optionnal
index.
- If missing, the index should be considered as [0].
- *)
+ If missing, the index should be considered as [0]. *)
type t' = T'.t
@@ -43,3 +41,67 @@ module Expression (T' : T) = struct
let boperator : S.pos -> T.boperator -> T'.t -> T'.t -> T'.t =
fun _ _ _ _ -> T'.default
end
+
+module Instruction (Expression : sig
+ type t'
+end) (T : sig
+ type t
+
+ val default : t
+ val fold : t Seq.t -> t
+end) =
+struct
+ let call : S.pos -> Qsp_syntax.T.keywords -> Expression.t' list -> T.t =
+ fun _ _ _ -> T.default
+
+ let location : S.pos -> string -> T.t =
+ fun position name ->
+ ignore position;
+ ignore name;
+ T.default
+
+ let comment : S.pos -> T.t =
+ fun position ->
+ ignore position;
+ T.default
+
+ let expression : Expression.t' -> T.t =
+ fun expr ->
+ ignore expr;
+ T.default
+
+ let map_clause : (Expression.t', T.t) S.clause -> T.t Seq.t =
+ fun (_, _, els) -> List.to_seq els
+
+ let if_ :
+ S.pos ->
+ (Expression.t', T.t) S.clause ->
+ elifs:(Expression.t', T.t) S.clause list ->
+ else_:(S.pos * T.t list) option ->
+ T.t =
+ fun pos clause ~elifs ~else_ ->
+ ignore pos;
+
+ let seq = List.to_seq (clause :: elifs) |> Seq.flat_map map_clause in
+
+ let seq =
+ match else_ with
+ | None -> seq
+ | Some (_, ts) -> Seq.append seq (List.to_seq ts)
+ in
+ T.fold seq
+
+ let act : S.pos -> label:Expression.t' -> T.t list -> T.t =
+ fun pos ~label instructions ->
+ ignore pos;
+ ignore label;
+ T.fold (List.to_seq instructions)
+
+ let assign :
+ S.pos ->
+ (S.pos, Expression.t') S.variable ->
+ Qsp_syntax.T.assignation_operator ->
+ Expression.t' ->
+ T.t =
+ fun _ _ _ _ -> T.default
+end