Moved qparser and syntax in the library folder

24 files changed, 746 insertions, 0 deletions

diff --git a/lib/analyzer.ml b/lib/qparser/analyzer.ml
index da1adbf..da1adbf 100644
--- a/lib/analyzer.ml
+++ b/lib/qparser/analyzer.ml
diff --git a/lib/analyzer.mli b/lib/qparser/analyzer.mli
index 30b6625..30b6625 100644
--- a/lib/analyzer.mli
+++ b/lib/qparser/analyzer.mli
diff --git a/lib/dune b/lib/qparser/dune
index f62c90e..f62c90e 100644
--- a/lib/dune
+++ b/lib/qparser/dune
diff --git a/lib/explain.sh b/lib/qparser/explain.sh
index 609d208..609d208 100755
--- a/lib/explain.sh
+++ b/lib/qparser/explain.sh
diff --git a/lib/expression_parser.messages b/lib/qparser/expression_parser.messages
index a493067..a493067 100644
--- a/lib/expression_parser.messages
+++ b/lib/qparser/expression_parser.messages
diff --git a/lib/generate_errors.sh b/lib/qparser/generate_errors.sh
index 3cff769..3cff769 100755
--- a/lib/generate_errors.sh
+++ b/lib/qparser/generate_errors.sh
diff --git a/lib/grammar.txt b/lib/qparser/grammar.txt
index d7208ef..d7208ef 100644
--- a/lib/grammar.txt
+++ b/lib/qparser/grammar.txt
diff --git a/lib/idents.ml b/lib/qparser/idents.ml
index baf23dc..baf23dc 100644
--- a/lib/idents.ml
+++ b/lib/qparser/idents.ml
diff --git a/lib/interpreter.ml b/lib/qparser/interpreter.ml
index b719600..b719600 100644
--- a/lib/interpreter.ml
+++ b/lib/qparser/interpreter.ml
diff --git a/lib/lexbuf.ml b/lib/qparser/lexbuf.ml
index 3f0b186..3f0b186 100644
--- a/lib/lexbuf.ml
+++ b/lib/qparser/lexbuf.ml
diff --git a/lib/lexbuf.mli b/lib/qparser/lexbuf.mli
index 41f07d1..41f07d1 100644
--- a/lib/lexbuf.mli
+++ b/lib/qparser/lexbuf.mli
diff --git a/lib/lexer.ml b/lib/qparser/lexer.ml
index c643577..c643577 100644
--- a/lib/lexer.ml
+++ b/lib/qparser/lexer.ml
diff --git a/lib/lexer.mli b/lib/qparser/lexer.mli
index 585877c..585877c 100644
--- a/lib/lexer.mli
+++ b/lib/qparser/lexer.mli
diff --git a/lib/parser.mly b/lib/qparser/parser.mly
index 84c1af8..84c1af8 100644
--- a/lib/parser.mly
+++ b/lib/qparser/parser.mly
diff --git a/lib/qsp_expression.mly b/lib/qparser/qsp_expression.mly
index 06cfadd..06cfadd 100644
--- a/lib/qsp_expression.mly
+++ b/lib/qparser/qsp_expression.mly
diff --git a/lib/qsp_instruction.mly b/lib/qparser/qsp_instruction.mly
index 564e154..564e154 100644
--- a/lib/qsp_instruction.mly
+++ b/lib/qparser/qsp_instruction.mly
diff --git a/lib/tokens.mly b/lib/qparser/tokens.mly
index 9ac4b10..9ac4b10 100644
--- a/lib/tokens.mly
+++ b/lib/qparser/tokens.mly
diff --git a/lib/syntax/S.ml b/lib/syntax/S.ml
new file mode 100644
index 0000000..3873eed
--- /dev/null
+++ b/lib/syntax/S.ml
@@ -0,0 +1,91 @@
+(** 
+    This module describe the type an analyzer must implement in order to be
+    used with the parser. 
+
+    The module is divided in three modules :
+        - Expression : the finest part of the QSP syntax.
+        - Instruction : if/act block, 
+        - Location
+
+    All the elements of the syntax are represented with a dedicated function
+    (instead of a big sum type). The module [Tree] provide an implementation
+    which build the AST.
+
+ *)
+
+type pos = Lexing.position * Lexing.position
+type ('a, 'b) variable = { pos : 'a; name : string; index : 'b option }
+
+(** Represent the evaluation over an expression *)
+module type Expression = sig
+  type 'a obs
+  type repr
+
+  type variable = { pos : pos; name : string; index : repr option }
+  (** 
+      Describe a variable, using the name in capitalized text, and an optionnal
+      index.
+
+      If missing, the index should be considered as [0].
+   *)
+
+  val ident : variable -> repr
+
+  (*
+        Basic values, text, number…
+   *)
+
+  val integer : pos -> string -> repr
+  val literal : pos -> string -> repr
+
+  val function_ : pos -> T.function_ -> repr list -> repr
+  (** Call a function. The functions list is hardcoded in lib/lexer.mll *)
+
+  val uoperator : pos -> T.uoperator -> repr -> repr
+  (** Unary operator like [-123] or [+'Text']*)
+
+  val boperator : pos -> T.boperator -> repr -> repr -> repr
+  (** Binary operator, for a comparaison, or an operation *)
+end
+
+module type Instruction = sig
+  type repr
+  type expression
+  type variable
+
+  val call : pos -> string -> expression list -> repr
+  (** Call for an instruction like [GT] or [*CLR] *)
+
+  val location : pos -> string -> repr
+  (** Label for a loop *)
+
+  val comment : pos -> repr
+  (** Comment *)
+
+  val expression : expression -> repr
+  (** Raw expression *)
+
+  type clause = pos * expression * repr list
+
+  val if_ : pos -> clause -> elifs:clause list -> else_:repr list -> repr
+  val act : pos -> label:expression -> repr list -> repr
+  val assign : pos -> variable -> T.assignation_operator -> expression -> repr
+end
+
+module type Location = sig
+  type repr
+  type instruction
+
+  val location : pos -> instruction list -> repr
+end
+
+module type Analyzer = sig
+  module Expression : Expression
+
+  module Instruction :
+    Instruction
+      with type expression = Expression.repr
+       and type variable = Expression.variable
+
+  module Location : Location with type instruction = Instruction.repr
+end
diff --git a/lib/syntax/dune b/lib/syntax/dune
new file mode 100644
index 0000000..666273f
--- /dev/null
+++ b/lib/syntax/dune
@@ -0,0 +1,6 @@
+(library
+ (name qsp_syntax)
+ 
+ (preprocess (pps 
+   ppx_deriving.show ppx_deriving.enum
+   ppx_deriving.eq )))
diff --git a/lib/syntax/report.ml b/lib/syntax/report.ml
new file mode 100644
index 0000000..9ad24c3
--- /dev/null
+++ b/lib/syntax/report.ml
@@ -0,0 +1,40 @@
+(** Report built over the differents analysis in the file *)
+
+type level = Error | Warn | Debug
+[@@deriving show { with_path = false }, enum, eq]
+
+type pos = Lexing.position * Lexing.position
+
+let level_of_string : string -> (level, string) result =
+ fun level ->
+  match String.lowercase_ascii level with
+  | "error" -> Ok Error
+  | "warn" -> Ok Warn
+  | "debug" -> Ok Debug
+  | _ ->
+      Error
+        (Format.sprintf
+           "Unknown report level '%s'. Accepted values are error, warn, debug"
+           level)
+
+let pp_pos : Format.formatter -> pos -> unit =
+ fun f (start_pos, end_pos) ->
+  let start_c = start_pos.Lexing.pos_cnum - start_pos.Lexing.pos_bol
+  and end_c = end_pos.Lexing.pos_cnum - end_pos.Lexing.pos_bol
+  and start_line = start_pos.Lexing.pos_lnum
+  and end_line = end_pos.Lexing.pos_lnum in
+
+  if start_line != end_line then
+    Format.fprintf f "Lines %d-%d" start_line end_line
+  else Format.fprintf f "Line %d %d:%d" start_line start_c end_c
+
+type t = { level : level; loc : pos; message : string }
+[@@deriving show { with_path = false }]
+
+let warn : pos -> string -> t =
+ fun loc message -> { level = Warn; loc; message }
+
+let error : pos -> string -> t =
+ fun loc message -> { level = Error; loc; message }
+
+let message level loc message = { level; loc; message }
diff --git a/lib/syntax/t.ml b/lib/syntax/t.ml
new file mode 100644
index 0000000..9c25647
--- /dev/null
+++ b/lib/syntax/t.ml
@@ -0,0 +1,78 @@
+(**
+    This module contains the basic operators used in the QSP syntax.
+ *)
+
+type boperator =
+  | Eq
+  | Neq
+  | Plus
+  | Minus
+  | Product
+  | Div
+  | Gt
+  | Lt
+  | Gte
+  | Lte
+  | And
+  | Or
+  | Mod
+[@@deriving eq, show]
+
+and uoperator = No | Neg | Add [@@deriving eq, show]
+
+and assignation_operator = Eq' | Inc  (** += *) | Decr  (** -= *) | Mult
+[@@deriving eq, show]
+
+type function_ =
+  | Arrcomp
+  | Arrpos
+  | Arrsize
+  | Countobj
+  | Desc
+  | Desc'
+  | Dyneval
+  | Dyneval'
+  | Func
+  | Func'
+  | Getobj
+  | Getobj'
+  | Iif
+  | Iif'
+  | Input
+  | Input'
+  | Instr
+  | Isnum
+  | Isplay
+  | Lcase
+  | Lcase'
+  | Len
+  | Loc
+  | Max
+  | Max'
+  | Mid
+  | Mid'
+  | Min
+  | Min'
+  | Msecscount
+  | Qspver
+  | Qspver'
+  | Rand
+  | Replace
+  | Replace'
+  | Rgb
+  | Rnd
+  | Selact
+  | Stattxt
+  | Stattxt'
+  | Str
+  | Str'
+  | Strcomp
+  | Strfind
+  | Strfind'
+  | Strpos
+  | Trim
+  | Trim'
+  | Ucase
+  | Ucase'
+  | Val
+[@@deriving eq, show]
diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml
new file mode 100644
index 0000000..bb31253
--- /dev/null
+++ b/lib/syntax/tree.ml
@@ -0,0 +1,95 @@
+type pos = Lexing.position * Lexing.position
+
+module Ast = struct
+  type nonrec pos = pos
+
+  type 'a variable = { pos : 'a; name : string; index : 'a expression option }
+  [@@deriving eq, show]
+
+  and 'a expression =
+    | Integer of 'a * string
+    | Literal of 'a * string
+    | Ident of 'a variable
+    | BinaryOp of 'a * T.boperator * 'a expression * 'a expression
+    | Op of 'a * T.uoperator * 'a expression
+    | Function of 'a * T.function_ * 'a expression list
+  [@@deriving eq, show]
+
+  and 'a condition = 'a * 'a expression * 'a statement list
+
+  and 'a statement =
+    | If of {
+        loc : 'a;
+        then_ : 'a condition;
+        elifs : 'a condition list;
+        else_ : 'a statement list;
+      }
+    | Act of { loc : 'a; label : 'a expression; statements : 'a statement list }
+    | Declaration of ('a * 'a variable * T.assignation_operator * 'a expression)
+    | Expression of 'a expression
+    | Comment of 'a
+    | Call of 'a * string * 'a expression list
+    | Location of 'a * string
+  [@@deriving eq, show]
+end
+
+(** Default implementation for the expression *)
+module Expression : S.Expression with type repr = pos Ast.expression = struct
+  type 'a obs
+  type repr = pos Ast.expression
+  type variable = { pos : pos; name : string; index : repr option }
+
+  let integer : pos -> string -> repr = fun pos i -> Ast.Integer (pos, i)
+  let literal : pos -> string -> repr = fun pos l -> Ast.Literal (pos, l)
+
+  let function_ : pos -> T.function_ -> repr list -> repr =
+   fun pos name args -> Ast.Function (pos, name, args)
+
+  let uoperator : pos -> T.uoperator -> repr -> repr =
+   fun pos op expression -> Ast.Op (pos, op, expression)
+
+  let boperator : pos -> T.boperator -> repr -> repr -> repr =
+   fun pos op op1 op2 -> Ast.BinaryOp (pos, op, op1, op2)
+
+  let ident : variable -> repr =
+   fun { pos; name; index } -> Ast.Ident { pos; name; index }
+end
+
+module Instruction :
+  S.Instruction
+    with type expression = Expression.repr
+     and type repr = pos Ast.statement
+     and type variable = Expression.variable = struct
+  type repr = pos Ast.statement
+  type expression = Expression.repr
+  type variable = Expression.variable
+
+  let call : pos -> string -> expression list -> repr =
+   fun pos name args -> Ast.Call (pos, name, args)
+
+  let location : pos -> string -> repr =
+   fun loc label -> Ast.Location (loc, label)
+
+  let comment : pos -> repr = fun pos -> Ast.Comment pos
+  let expression : expression -> repr = fun expr -> Ast.Expression expr
+
+  type clause = pos * expression * repr list
+
+  let if_ : pos -> clause -> elifs:clause list -> else_:repr list -> repr =
+   fun pos predicate ~elifs ~else_ ->
+    Ast.If { loc = pos; then_ = predicate; elifs; else_ }
+
+  let act : pos -> label:expression -> repr list -> repr =
+   fun pos ~label statements -> Ast.Act { loc = pos; label; statements }
+
+  let assign : pos -> variable -> T.assignation_operator -> expression -> repr =
+   fun pos_loc { pos; name; index } op expr ->
+    Ast.Declaration (pos_loc, { pos; name; index }, op, expr)
+end
+
+module Location = struct
+  type instruction = pos Ast.statement
+  type repr = pos * instruction list
+
+  let location : pos -> instruction list -> repr = fun pos block -> (pos, block)
+end
diff --git a/lib/syntax/tree.mli b/lib/syntax/tree.mli
new file mode 100644
index 0000000..ca5a639
--- /dev/null
+++ b/lib/syntax/tree.mli
@@ -0,0 +1,51 @@
+(** 
+    Implementation for S.Analyzer for building a complete Ast.
+
+    Used in the unit test in order to check if the grammar is interpreted as
+    expected, not really usefull over a big qsp.
+ *)
+
+(** This module is the result of the evaluation. *)
+module Ast : sig
+  type pos = Lexing.position * Lexing.position
+
+  type 'a variable = { pos : 'a; name : string; index : 'a expression option }
+  [@@deriving eq, show]
+  (** A variable, used both in an expression (reference) or in a statement
+      (assignation) *)
+
+  and 'a expression =
+    | Integer of 'a * string
+    | Literal of 'a * string
+    | Ident of 'a variable
+    | BinaryOp of 'a * T.boperator * 'a expression * 'a expression
+    | Op of 'a * T.uoperator * 'a expression
+    | Function of 'a * T.function_ * 'a expression list
+  [@@deriving eq, show]
+
+  and 'a condition = 'a * 'a expression * 'a statement list
+  (** A condition in if or elseif statement *)
+
+  and 'a statement =
+    | If of {
+        loc : 'a;
+        then_ : 'a condition;
+        elifs : 'a condition list;
+        else_ : 'a statement list;
+      }
+    | Act of { loc : 'a; label : 'a expression; statements : 'a statement list }
+    | Declaration of ('a * 'a variable * T.assignation_operator * 'a expression)
+    | Expression of 'a expression
+    | Comment of 'a
+    | Call of 'a * string * 'a expression list
+    | Location of 'a * string
+  [@@deriving eq, show]
+end
+
+(** / **)
+
+include
+  S.Analyzer
+    with type Expression.repr = Ast.pos Ast.expression
+     and type Instruction.repr = Ast.pos Ast.statement
+     and type Location.repr = Ast.pos * Ast.pos Ast.statement list
diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml
new file mode 100644
index 0000000..d578700
--- /dev/null
+++ b/lib/syntax/type_of.ml
@@ -0,0 +1,385 @@
+open StdLabels
+
+type pos = Lexing.position * Lexing.position
+(** Extract the type for expression *)
+
+module Helper = struct
+  type t = Integer | Bool | String | Any
+  [@@deriving show { with_path = false }]
+
+  type argument_repr = { pos : pos; t : t }
+
+  type dyn_type = t -> t
+  (** Dynamic type is a type unknown during the code.
+
+      For example, the equality operator accept either Integer or String, but
+      we expect that both sides of the equality uses the same type.*)
+
+  (** Build a new dynamic type *)
+  let dyn_type : unit -> dyn_type =
+   fun () ->
+    let stored = ref None in
+    fun t ->
+      match !stored with
+      | None ->
+          stored := Some t;
+          t
+      | Some t -> t
+
+  (** Declare an argument for a function. 
+
+ - Either we already know the type and we just have to compare.
+ - Either the type shall constrained by another one 
+ - Or we have a variable number of arguments. *)
+  type argument = Fixed of t | Dynamic of dyn_type | Variable of argument
+
+  let compare :
+      ?strict:bool ->
+      ?level:Report.level ->
+      t ->
+      argument_repr ->
+      Report.t list ->
+      Report.t list =
+   fun ?(strict = false) ?(level = Report.Warn) expected actual report ->
+    let equal =
+      match (expected, actual.t) with
+      | _, Any -> true
+      | Any, _ -> true
+      | String, String -> true
+      | Integer, Integer -> true
+      | Bool, Bool -> true
+      | Bool, Integer when not strict -> true
+      | Integer, Bool -> true
+      | String, Integer when not strict -> true
+      | String, Bool when not strict -> true
+      | _, _ -> false
+    in
+    if equal then report
+    else
+      let message =
+        Format.asprintf "The type %a is expected but got %a" pp expected pp
+          actual.t
+      in
+      Report.message level actual.pos message :: report
+
+  let rec compare_parameter :
+      ?strict:bool ->
+      ?level:Report.level ->
+      argument ->
+      argument_repr ->
+      Report.t list ->
+      Report.t list =
+   fun ?(strict = false) ?(level = Report.Warn) expected param report ->
+    match expected with
+    | Fixed t -> compare ~level t param report
+    | Dynamic d ->
+        let type_ = d param.t in
+        compare ~strict ~level type_ param report
+    | Variable c -> compare_parameter ~level c param report
+
+  (** Compare the arguments one by one *)
+  let compare_args :
+      ?strict:bool ->
+      ?level:Report.level ->
+      pos ->
+      argument list ->
+      argument_repr list ->
+      Report.t list ->
+      Report.t list =
+   fun ?(strict = false) ?(level = Report.Warn) pos expected actuals report ->
+    let tl, report =
+      List.fold_left actuals ~init:(expected, report)
+        ~f:(fun (expected, report) param ->
+          match expected with
+          | (Variable _ as hd) :: _ ->
+              let check = compare_parameter ~strict ~level hd param report in
+              (expected, check)
+          | hd :: tl ->
+              let check = compare_parameter ~strict ~level hd param report in
+              (tl, check)
+          | [] ->
+              let msg = Report.error param.pos "Unexpected argument" in
+              ([], msg :: report))
+    in
+    match tl with
+    | [] | Variable _ :: _ -> report
+    | _ ->
+        let msg = Report.error pos "Not enougth arguments given" in
+        msg :: report
+end
+
+module Expression = struct
+  type 'a obs
+
+  type t = {
+    result : Helper.t;
+    report : Report.t list; (* See the comment below *)
+    pos : pos;
+    empty : bool;
+  }
+
+  type repr = Report.t list -> t
+  (** The type repr is a function accepting the report as a first argement.
+      When the report is given, it will be reported into the tree and collected
+      in bottom-top.
+
+      It’s easy to forget that the report is updated when the type is created.
+      The function takes the report in argument, and store the report in the
+      returned type. Maybe should I make a tupple instead in order to make it
+      explicit ?
+  *)
+
+  type variable = { pos : pos; name : string; index : repr option }
+
+  let arg_of_repr : t -> Helper.argument_repr =
+   fun { result; report; pos; empty } ->
+    ignore report;
+    ignore empty;
+    { pos; t = result }
+
+  (** The variable has type string when starting with a '$' *)
+  let ident : variable -> repr =
+   fun var report ->
+    let empty = false in
+    match var.name.[0] with
+    | '$' -> { result = String; report; pos = var.pos; empty }
+    | _ -> { result = Integer; report; pos = var.pos; empty }
+
+  let integer : pos -> string -> repr =
+   fun pos value report ->
+    let empty =
+      match int_of_string_opt value with Some 0 -> true | _ -> false
+    in
+
+    { result = Integer; report; pos; empty }
+
+  let literal : pos -> string -> repr =
+   fun pos value report ->
+    let empty = String.equal String.empty value in
+    { result = String; report; pos; empty }
+
+  let function_ : pos -> T.function_ -> repr list -> repr =
+   fun pos function_ params _acc ->
+    (* Accumulate the expressions and get the results, the report is given in
+       the differents arguments, and we build a list with the type of the
+       parameters. *)
+    let types, report =
+      List.fold_left params ~init:([], _acc) ~f:(fun (types, report) param ->
+          let t = param report in
+          let arg = arg_of_repr t in
+          (arg :: types, t.report))
+    in
+    let types = List.rev types
+    and default = { result = Any; report; pos; empty = false } in
+
+    match function_ with
+    | Arrcomp | Arrpos | Arrsize | Countobj | Desc | Dyneval | Func | Getobj
+    | Instr | Isplay ->
+        { default with result = Integer }
+    | Desc' | Dyneval' | Func' | Getobj' -> { default with result = String }
+    | Iif | Iif' ->
+        let d = Helper.dyn_type () in
+        let expected = Helper.[ Fixed Bool; Dynamic d; Dynamic d ] in
+        let report = Helper.compare_args pos expected types report in
+        (* Extract the type for the expression *)
+        let result = d Helper.Bool in
+        { result; report; pos; empty = false }
+    | Input | Input' ->
+        (* Input should check the result if the variable is a num and raise a
+           message in this case.*)
+        let expected = Helper.[ Fixed String ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = String; report; pos; empty = false }
+    | Isnum ->
+        let expected = Helper.[ Fixed String ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = Bool; report; pos; empty = false }
+    | Lcase | Lcase' | Ucase | Ucase' ->
+        let expected = Helper.[ Fixed String ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = String; report; pos; empty = false }
+    | Len ->
+        let expected = Helper.[ Fixed Any ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = Integer; report; pos; empty = false }
+    | Loc ->
+        let expected = Helper.[ Fixed String ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = Bool; report; pos; empty = false }
+    | Max | Max' | Min | Min' ->
+        let d = Helper.dyn_type () in
+        (* All the arguments must have the same type *)
+        let expected = Helper.[ Variable (Dynamic d) ] in
+        let report = Helper.compare_args pos expected types report in
+        let result = d Helper.Bool in
+        { result; report; pos; empty = false }
+    | Mid | Mid' ->
+        let expected = Helper.[ Fixed String; Variable (Fixed Integer) ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = String; report; pos; empty = false }
+    | Msecscount -> { result = Integer; report; pos; empty = false }
+    | Rand ->
+        let expected = Helper.[ Variable (Fixed Integer) ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = Integer; report; pos; empty = false }
+    | Replace -> { result = Integer; report; pos; empty = false }
+    | Replace' -> { result = String; report; pos; empty = false }
+    | Rgb -> { result = Integer; report; pos; empty = false }
+    | Qspver | Qspver' | Rnd ->
+        (* No arg *)
+        let report = Helper.compare_args pos [] types report in
+        { result = Integer; report; pos; empty = false }
+    | Selact -> { result = Integer; report; pos; empty = false }
+    | Stattxt -> { result = Integer; report; pos; empty = false }
+    | Stattxt' -> { result = String; report; pos; empty = false }
+    | Str | Str' ->
+        let expected = Helper.[ Variable (Fixed Integer) ] in
+        let report = Helper.compare_args pos expected types report in
+        { default with result = String; report }
+    | Strcomp -> { result = Integer; report; pos; empty = false }
+    | Strfind -> { result = Integer; report; pos; empty = false }
+    | Strfind' -> { result = String; report; pos; empty = false }
+    | Strpos -> { result = Integer; report; pos; empty = false }
+    | Trim -> { result = Integer; report; pos; empty = false }
+    | Trim' -> { result = String; report; pos; empty = false }
+    | Val ->
+        let expected = Helper.[ Fixed Any ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = Integer; report; pos; empty = false }
+
+  (** Unary operator like [-123] or [+'Text']*)
+  let uoperator : pos -> T.uoperator -> repr -> repr =
+   fun pos operator t1 report ->
+    let t = t1 report in
+    let report = t.report in
+    match operator with
+    | Add -> t
+    | Neg | No ->
+        let types = [ arg_of_repr t ] in
+        let expected = Helper.[ Fixed Integer ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = Integer; report; pos; empty = false }
+
+  let boperator : pos -> T.boperator -> repr -> repr -> repr =
+   fun pos operator t1 t2 report ->
+    let t1 = t1 report in
+    let t2 = t2 t1.report in
+    let report = t2.report in
+    let types = [ arg_of_repr t1; arg_of_repr t2 ] in
+    match operator with
+    | T.Plus ->
+        (* Operation over number *)
+        let d = Helper.(dyn_type ()) in
+        let expected = Helper.[ Dynamic d; Dynamic d ] in
+        let report = Helper.compare_args pos expected types report in
+        let result = d Helper.Integer in
+        { result; report; pos; empty = false }
+    | T.Eq | T.Neq ->
+        (* If the expression is '' or 0, we accept the comparaison as if
+            instead of raising a warning *)
+        if t1.empty || t2.empty then
+          { result = Bool; report; pos; empty = false }
+        else
+          let d = Helper.(Dynamic (dyn_type ())) in
+          let expected = [ d; d ] in
+          let report =
+            Helper.compare_args ~strict:true pos expected (List.rev types)
+              report
+          in
+          { result = Bool; report; pos; empty = false }
+    | Lt | Gte | Lte | Gt ->
+        let d = Helper.(Dynamic (dyn_type ())) in
+        let expected = [ d; d ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = Bool; report; pos; empty = false }
+    | T.Mod | T.Minus | T.Product | T.Div ->
+        (* Operation over number *)
+        let expected = Helper.[ Fixed Integer; Fixed Integer ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = Integer; report; pos; empty = false }
+    | T.And | T.Or ->
+        (* Operation over booleans *)
+        let expected = Helper.[ Fixed Bool; Fixed Bool ] in
+        let report = Helper.compare_args pos expected types report in
+        { result = Bool; report; pos; empty = false }
+end
+
+module Instruction = struct
+  type repr = Report.t list -> Report.t list
+  type expression = Expression.repr
+  type variable = Expression.variable
+
+  (** Call for an instruction like [GT] or [*CLR] *)
+  let call : pos -> string -> expression list -> repr =
+   fun _pos _ expressions report ->
+    List.fold_left expressions ~init:report ~f:(fun report expression ->
+        let result = expression report in
+        result.Expression.report)
+
+  let location : pos -> string -> repr = fun _pos _ report -> report
+
+  (** Comment *)
+  let comment : pos -> repr = fun _pos report -> report
+
+  (** Raw expression *)
+  let expression : expression -> repr =
+   fun expression report -> (expression report).report
+
+  type clause = pos * expression * repr list
+
+  let if_ : pos -> clause -> elifs:clause list -> else_:repr list -> repr =
+   fun _pos clause ~elifs ~else_ report ->
+    (* Helper function *)
+    let fold_clause report (_pos, expr, instructions) : Report.t list =
+      let result = expr report in
+      let report =
+        Helper.compare Helper.Bool
+          (Expression.arg_of_repr result)
+          result.Expression.report
+      in
+      List.fold_left instructions ~init:report ~f:(fun report instruction ->
+          instruction report)
+    in
+
+    (* Traverse the whole block recursively *)
+    let report = fold_clause report clause in
+    let report = List.fold_left elifs ~f:fold_clause ~init:report in
+    List.fold_left else_ ~init:report ~f:(fun report instruction ->
+        instruction report)
+
+  let act : pos -> label:expression -> repr list -> repr =
+   fun _pos ~label instructions report ->
+    let result = label report in
+    let report =
+      Helper.compare Helper.String
+        (Expression.arg_of_repr result)
+        result.Expression.report
+    in
+    List.fold_left instructions ~init:report ~f:(fun report instruction ->
+        instruction report)
+
+  let assign : pos -> variable -> T.assignation_operator -> expression -> repr =
+   fun pos variable _ expression report ->
+    let right_expression = expression report in
+    match right_expression.empty with
+    | true -> report
+    | false ->
+        let op1 = Expression.arg_of_repr (Expression.ident variable report) in
+        let report = right_expression.Expression.report in
+        let op2 = Expression.arg_of_repr right_expression in
+
+        let d = Helper.dyn_type () in
+        (* Every part of the assignation should be the same type *)
+        let expected = Helper.[ Dynamic d; Dynamic d ] in
+        Helper.compare_args ~level:Report.Debug pos expected [ op1; op2 ] report
+end
+
+module Location = struct
+  type repr = Instruction.repr
+  type instruction = Instruction.repr
+
+  let location : pos -> instruction list -> repr =
+   fun _pos instructions report ->
+    List.fold_left instructions ~init:report ~f:(fun report instruction ->
+        instruction report)
+end