1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
(** This module extract the type for an expression.
The module does not check anything, but is intended to be composed in
another one check. *)
open StdLabels
module S = Qsp_syntax.S
module T = Qsp_syntax.T
module Report = Qsp_syntax.Report
type type_of =
| Integer (** A numeric value *)
| Bool (** A boolean, not a real type *)
| String (** String value *)
| NumericString
[@printer fun fmt _ -> Format.pp_print_string fmt "Integer as String"]
(** String containing a numeric value *)
[@@deriving show { with_path = false }, eq]
module Expression = struct
type t = Variable of type_of | Raw of type_of [@@deriving show, eq]
type t' = t
let v = Fun.id
let get_type : t -> type_of = function Raw r -> r | Variable r -> r
let map : t -> type_of -> t =
fun t type_of ->
match t with Raw _ -> Raw type_of | Variable _ -> Variable type_of
let get_nature : t -> t -> type_of -> t =
fun t1 t2 type_of ->
match (t1, t2) with
| Variable _, _ -> Variable type_of
| _, Variable _ -> Variable type_of
| Raw _, Raw _ -> Raw type_of
let integer : ctx:Qsp_syntax.S.extract_context -> S.pos -> string -> t =
fun ~ctx _ _ ->
ignore ctx;
Raw Integer
let ident : ctx:Qsp_syntax.S.extract_context -> (S.pos, 'any) S.variable -> t
=
fun ~ctx var ->
ignore ctx;
match var.name.[0] with '$' -> Variable String | _ -> Variable Integer
let literal :
ctx:Qsp_syntax.S.extract_context -> S.pos -> t T.literal list -> t =
fun ~ctx pos values ->
ignore ctx;
ignore pos;
let init = None in
let typed =
List.fold_left values ~init ~f:(fun state -> function
| T.Text t -> (
(* Tranform the type, but keep the information is it’s a raw data
or a variable one *)
let nature = Option.value ~default:(Raw Integer) state in
match (Option.map get_type state, int_of_string_opt t) with
| None, Some _
| Some Integer, Some _
| Some NumericString, Some _
| Some Bool, Some _ ->
Some (map nature NumericString)
| _, _ ->
if String.equal "" t then
(* If the text is empty, ignore it *)
state
else Some (map nature String))
| T.Expression t -> (
let nature = Option.value ~default:(Raw Integer) state in
match (Option.map get_type state, get_type t) with
| None, Integer | Some NumericString, Integer ->
Some (get_nature nature t NumericString)
| _ -> Some (map nature String)))
in
let result = Option.value ~default:(Raw String) typed in
result
let uoperator :
ctx:Qsp_syntax.S.extract_context -> S.pos -> T.uoperator -> t -> t =
fun ~ctx pos operator t ->
ignore ctx;
ignore pos;
match operator with Add -> t | Neg | No -> Raw Integer
let boperator :
ctx:Qsp_syntax.S.extract_context -> S.pos -> T.boperator -> t -> t -> t =
fun ~ctx pos operator t1 t2 ->
ignore ctx;
ignore pos;
match operator with
| T.Plus -> (
match (get_type t1, get_type t2) with
| Integer, Integer -> get_nature t1 t2 Integer
| String, _ -> get_nature t1 t2 String
| _, String -> get_nature t1 t2 String
| (_ as t), Bool -> get_nature t1 t2 t
| Bool, (_ as t) -> get_nature t1 t2 t
| (_ as t), NumericString -> get_nature t1 t2 t
| NumericString, (_ as t) -> get_nature t1 t2 t)
| T.Eq | T.Neq -> get_nature t1 t2 Bool
| T.Mod | T.Minus | T.Product | T.Div -> get_nature t1 t2 Integer
| T.And | T.Or -> get_nature t1 t2 Bool
| Lt | Gte | Lte | Gt -> get_nature t1 t2 Bool
let function_ :
ctx:Qsp_syntax.S.extract_context -> S.pos -> T.function_ -> t list -> t =
fun ~ctx pos function_ params ->
ignore ctx;
ignore pos;
match function_ with
| Dyneval | Dyneval' -> Variable NumericString
| Arrcomp | Arrpos | Arrsize | Countobj | Desc | Getobj | Instr | Isplay ->
Variable Integer
| Desc' | Getobj' -> Variable String
| Func | Func' -> Variable NumericString
| Iif | Iif' -> ( match params with _ :: t :: _ -> t | _ -> Raw Bool)
| Input | Input' -> Variable NumericString
| Isnum -> Raw Bool
| Lcase | Lcase' | Ucase | Ucase' -> Raw String
| Len -> Variable Integer
| Loc -> Variable Bool
| Max | Max' | Min | Min' -> (
match params with
| [] -> Raw Bool
| Raw String :: [] | Variable String :: [] -> Variable NumericString
| hd :: _ -> hd)
| Mid | Mid' -> Variable String
| Msecscount -> Variable Integer
| Rand -> Variable Integer
| Replace -> Variable String
| Replace' -> Variable String
| Rgb -> Variable Integer
| Rnd -> Variable Integer
| Selact -> Variable String
| Str | Str' -> Raw String
| Strcomp -> Raw Bool
| Strfind -> Variable String
| Strfind' -> Variable String
| Strpos -> Variable Integer
| Trim -> Variable String
| Trim' -> Variable String
| Val -> Variable Integer
end
module A = struct
let identifier = "get_types"
let description = "Identify the type for an expression"
let is_global = true
let active = ref false
let depends = []
type ex = Qsp_syntax.Identifier.t
type context = unit
let initialize () = ()
module Expression = Expression
module Instruction = struct
type t = unit
type t' = unit
include
Default.Instruction
(Expression)
(struct
type t = unit
let default = ()
let fold seq = Seq.iter (fun _ -> ()) seq
end)
let v = Fun.id
end
module Location = struct
type t = unit
type instruction = Instruction.t'
let location : context -> S.pos -> instruction list -> t =
fun context pos instr ->
ignore context;
ignore pos;
List.iter instr ~f:(fun _ -> ())
let v : t -> Report.t list = fun _ -> []
end
let finalize context =
ignore context;
[]
end
let expression_id = Type.Id.make ()
let ex = Qsp_syntax.Identifier.build ~expression_id (module A)
|
