diff options
Diffstat (limited to 'syntax/type_of.ml')
| -rw-r--r-- | syntax/type_of.ml | 385 |
1 files changed, 0 insertions, 385 deletions
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 |