From 97ab5c9a21166f0bffee482210d69877fd6809fa Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Fri, 6 Oct 2023 08:35:56 +0200
Subject: Moved qparser and syntax in the library folder
---
syntax/S.ml | 91 -------------
syntax/dune | 6 -
syntax/report.ml | 40 ------
syntax/t.ml | 78 -----------
syntax/tree.ml | 95 --------------
syntax/tree.mli | 51 --------
syntax/type_of.ml | 385 ------------------------------------------------------
7 files changed, 746 deletions(-)
delete mode 100644 syntax/S.ml
delete mode 100644 syntax/dune
delete mode 100644 syntax/report.ml
delete mode 100644 syntax/t.ml
delete mode 100644 syntax/tree.ml
delete mode 100644 syntax/tree.mli
delete mode 100644 syntax/type_of.ml
(limited to 'syntax')
diff --git a/syntax/S.ml b/syntax/S.ml
deleted file mode 100644
index 3873eed..0000000
--- a/syntax/S.ml
+++ /dev/null
@@ -1,91 +0,0 @@
-(**
- 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/syntax/dune b/syntax/dune
deleted file mode 100644
index 666273f..0000000
--- a/syntax/dune
+++ /dev/null
@@ -1,6 +0,0 @@
-(library
- (name qsp_syntax)
-
- (preprocess (pps
- ppx_deriving.show ppx_deriving.enum
- ppx_deriving.eq )))
diff --git a/syntax/report.ml b/syntax/report.ml
deleted file mode 100644
index 9ad24c3..0000000
--- a/syntax/report.ml
+++ /dev/null
@@ -1,40 +0,0 @@
-(** 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/syntax/t.ml b/syntax/t.ml
deleted file mode 100644
index 9c25647..0000000
--- a/syntax/t.ml
+++ /dev/null
@@ -1,78 +0,0 @@
-(**
- 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/syntax/tree.ml b/syntax/tree.ml
deleted file mode 100644
index bb31253..0000000
--- a/syntax/tree.ml
+++ /dev/null
@@ -1,95 +0,0 @@
-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/syntax/tree.mli b/syntax/tree.mli
deleted file mode 100644
index ca5a639..0000000
--- a/syntax/tree.mli
+++ /dev/null
@@ -1,51 +0,0 @@
-(**
- 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/syntax/type_of.ml b/syntax/type_of.ml
deleted file mode 100644
index d578700..0000000
--- a/syntax/type_of.ml
+++ /dev/null
@@ -1,385 +0,0 @@
-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
--
cgit v1.2.3