aboutsummaryrefslogtreecommitdiff
path: root/lib/syntax/nested_strings.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/syntax/nested_strings.ml')
-rw-r--r--lib/syntax/nested_strings.ml109
1 files changed, 109 insertions, 0 deletions
diff --git a/lib/syntax/nested_strings.ml b/lib/syntax/nested_strings.ml
new file mode 100644
index 0000000..fb056d6
--- /dev/null
+++ b/lib/syntax/nested_strings.ml
@@ -0,0 +1,109 @@
+open StdLabels
+
+module Expression : S.Expression with type t' = Report.t list = struct
+ type t = Report.t list
+ type t' = t
+
+ let v : t -> t' = Fun.id
+
+ (** Identify the expressions reprented as string. That’s here that the report
+ are added.
+
+ All the rest of the module only push thoses warning to the top level. *)
+ let literal : S.pos -> t T.literal list -> t =
+ fun pos content ->
+ match content with
+ | [ T.Expression expr; T.Text "" ] ->
+ ignore expr;
+ let msg = Report.debug pos "This expression can be simplified" in
+ [ msg ]
+ | _ -> []
+
+ let ident : (S.pos, t) S.variable -> t =
+ fun { pos; name : string; index : t option } ->
+ ignore pos;
+ ignore name;
+ match index with None -> [] | Some v -> v
+
+ let integer : S.pos -> string -> t = fun _ _ -> []
+
+ let function_ : S.pos -> T.function_ -> t list -> t =
+ fun _ _ expressions -> List.concat expressions
+
+ let uoperator : S.pos -> T.uoperator -> t -> t = fun _ _ expr1 -> expr1
+
+ let boperator : S.pos -> T.boperator -> t -> t -> t =
+ fun _ _ expr1 expr2 -> expr1 @ expr2
+end
+
+module Instruction :
+ S.Instruction with type t' = Report.t list and type expression = Expression.t' =
+struct
+ type t = Report.t list
+ (** Internal type used in the evaluation *)
+
+ type t' = t
+
+ let v : t -> t' = Fun.id
+
+ type expression = Expression.t'
+
+ let call : S.pos -> T.keywords -> expression list -> t =
+ fun pos k exprs ->
+ ignore pos;
+ ignore k;
+ List.concat exprs
+
+ let location : S.pos -> string -> t = fun _ _ -> []
+ let comment : S.pos -> t = fun _ -> []
+ let expression : expression -> t = Fun.id
+
+ let act : S.pos -> label:expression -> t list -> t =
+ fun pos ~label instructions ->
+ ignore pos;
+ List.concat (label :: instructions)
+
+ let fold_clause : (expression, t) S.clause -> t =
+ fun (_pos1, expression, ts) -> List.concat (expression :: ts)
+
+ let if_ :
+ S.pos ->
+ (expression, t) S.clause ->
+ elifs:(expression, t) S.clause list ->
+ else_:(S.pos * t list) option ->
+ t =
+ fun pos clause ~elifs ~else_ ->
+ ignore pos;
+
+ let init =
+ match else_ with
+ | None -> fold_clause clause
+ | Some (_, ts) -> List.rev_append (fold_clause clause) (List.concat ts)
+ in
+
+ List.fold_left elifs ~init ~f:(fun t clause ->
+ List.rev_append (fold_clause clause) t)
+
+ let assign :
+ S.pos ->
+ (S.pos, expression) S.variable ->
+ T.assignation_operator ->
+ expression ->
+ t =
+ fun pos variable op expression ->
+ ignore pos;
+ ignore op;
+ match variable.index with
+ | None -> expression
+ | Some v -> List.rev_append v expression
+end
+
+module Location = struct
+ type t = unit
+ type instruction = Instruction.t'
+
+ let location : S.pos -> instruction list -> t * Report.t list =
+ fun pos intructions ->
+ ignore pos;
+ ((), List.concat intructions)
+end