← Back to branch summary

~ubuntu-branches/ubuntu/trusty/mtasc/trusty-proposed

« back to all changes in this revision

Viewing changes to ocaml/mtasc/expr.ml

  • Committer: Bazaar Package Importer
  • Author(s): Paul Wise
  • Date: 2006-03-25 17:15:45 UTC
  • Revision ID: james.westby@ubuntu.com-20060325171545-zjh6rxeqehxiv4v2
Tags: upstream-1.12
Import upstream version 1.12

Show diffs side-by-side

added added

removed removed

Lines of Context:
ocaml/mtasc/expr.ml
 
1
(*
 
2
 *  MTASC - MotionTwin ActionScript2 Compiler
 
3
 *  Copyright (c)2004 Nicolas Cannasse
 
4
 *
 
5
 *  This program is free software; you can redistribute it and/or modify
 
6
 *  it under the terms of the GNU General Public License as published by
 
7
 *  the Free Software Foundation; either version 2 of the License, or
 
8
 *  (at your option) any later version.
 
9
 *
 
10
 *  This program is distributed in the hope that it will be useful,
 
11
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
13
 *  GNU General Public License for more details.
 
14
 *
 
15
 *  You should have received a copy of the GNU General Public License
 
16
 *  along with this program; if not, write to the Free Software
 
17
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
18
 *)
 
19
 
 
20
type pos = {
 
21
        pfile : string;
 
22
        pmin : int;
 
23
        pmax : int;
 
24
}
 
25
 
 
26
type keyword =
 
27
        | Function
 
28
        | Class
 
29
        | Var
 
30
        | If
 
31
        | Else
 
32
        | While
 
33
        | Do
 
34
        | For
 
35
        | Break
 
36
        | Continue
 
37
        | Return
 
38
        | Interface
 
39
        | Extends
 
40
        | Implements
 
41
        | Import
 
42
        | Switch
 
43
        | Case
 
44
        | Default
 
45
        | Static
 
46
        | Intrinsic
 
47
        | Dynamic
 
48
        | Public
 
49
        | Private
 
50
        | Try
 
51
        | Catch
 
52
        | Finally
 
53
        | With
 
54
        | In
 
55
        | InstanceOf
 
56
        | New
 
57
        | This
 
58
        | Throw
 
59
        | Typeof
 
60
        | Delete
 
61
        | Void
 
62
        (* deprecated *)
 
63
        | Add | And | Or | Eq | Ne | KwdNot | Le | Lt | Ge | Gt
 
64
        | IfFrameLoaded | On | OnClipEvent | TellTarget
 
65
        
 
66
type binop =
 
67
        | OpAdd
 
68
        | OpMult
 
69
        | OpDiv
 
70
        | OpSub
 
71
        | OpAssign
 
72
        | OpEq
 
73
        | OpPhysEq
 
74
        | OpNotEq
 
75
        | OpPhysNotEq
 
76
        | OpGt
 
77
        | OpGte
 
78
        | OpLt
 
79
        | OpLte
 
80
        | OpAnd
 
81
        | OpOr
 
82
        | OpXor
 
83
        | OpBoolAnd
 
84
        | OpBoolOr
 
85
        | OpShl
 
86
        | OpShr
 
87
        | OpUShr
 
88
        | OpMod
 
89
        | OpAssignOp of binop
 
90
 
 
91
type unop =
 
92
        | Increment
 
93
        | Decrement
 
94
        | Not
 
95
        | Neg
 
96
        | NegBits
 
97
 
 
98
type constant =
 
99
        | Int of string
 
100
        | Float of string
 
101
        | String of string
 
102
        | Ident of string
 
103
 
 
104
type token =
 
105
        | Eof
 
106
        | Const of constant
 
107
        | Kwd of keyword
 
108
        | Comment of string
 
109
        | CommentLine of string
 
110
        | Binop of binop
 
111
        | Unop of unop
 
112
        | Next
 
113
        | Sep
 
114
        | BrOpen
 
115
        | BrClose
 
116
        | BkOpen
 
117
        | BkClose
 
118
        | POpen
 
119
        | PClose
 
120
        | Dot
 
121
        | DblDot
 
122
        | Question
 
123
        | Sharp
 
124
 
 
125
type unop_flag =
 
126
        | Prefix
 
127
        | Postfix
 
128
 
 
129
type while_flag =
 
130
        | NormalWhile
 
131
        | DoWhile
 
132
 
 
133
type static_flag = 
 
134
        | IsMember
 
135
        | IsStatic
 
136
 
 
137
type public_flag =
 
138
        | IsPublic
 
139
        | IsPrivate
 
140
 
 
141
type getter_flag =
 
142
        | Normal
 
143
        | Getter
 
144
        | Setter
 
145
 
 
146
type type_path = string list * string
 
147
 
 
148
type func = {
 
149
        fname : string;
 
150
        fargs : (string * type_path option) list;
 
151
        ftype : type_path option;
 
152
        fstatic : static_flag;
 
153
        fpublic : public_flag;
 
154
        fgetter : getter_flag;
 
155
        fexpr : expr option;
 
156
}
 
157
 
 
158
and herit = 
 
159
        | HExtends of type_path
 
160
        | HImplements of type_path
 
161
        | HIntrinsic
 
162
        | HDynamic
 
163
 
 
164
and eval_def =
 
165
        | EConst of constant
 
166
        | EArray of eval * eval
 
167
        | EBinop of binop * eval * eval
 
168
        | EField of eval * string
 
169
        | EParenthesis of eval
 
170
        | EObjDecl of (string * eval) list
 
171
        | EArrayDecl of eval list
 
172
        | ECall of eval * eval list
 
173
        | ENew of eval * eval list
 
174
        | EUnop of unop * unop_flag * eval
 
175
        | EQuestion of eval * eval * eval
 
176
        | ELambda of func
 
177
        | EStatic of type_path
 
178
        | ECast of eval * eval
 
179
 
 
180
and eval = eval_def * pos
 
181
 
 
182
and expr_def =
 
183
        | EVars of static_flag * public_flag * (string * type_path option * eval option) list
 
184
        | EFunction of func
 
185
        | EBlock of expr list
 
186
        | EFor of expr list * eval list * eval list * expr
 
187
        | EForIn of expr * eval * expr
 
188
        | EIf of eval * expr * expr option
 
189
        | EWhile of eval * expr * while_flag
 
190
        | ESwitch of eval * (eval option * expr) list
 
191
        | ETry of expr * (string * type_path option * expr) list ref * expr option
 
192
        | EWith of eval * expr
 
193
        | EReturn of eval option
 
194
        | EBreak
 
195
        | EContinue
 
196
        | EVal of eval
 
197
 
 
198
and expr = expr_def * pos
 
199
 
 
200
and sign_def =
 
201
        | EClass of type_path * herit list * expr
 
202
        | EInterface of type_path * herit list * expr
 
203
        | EImport of string list * string option
 
204
 
 
205
and signature = sign_def * pos
 
206
 
 
207
let pos = snd
 
208
 
 
209
let is_postfix (e,_) = function
 
210
        | Increment | Decrement -> (match e with EConst _ | EField _ | EStatic _ | EArray _ -> true | _ -> false)
 
211
        | Not | Neg | NegBits -> false
 
212
 
 
213
let is_prefix = function
 
214
        | Increment | Decrement -> true
 
215
        | Not | Neg | NegBits -> true
 
216
 
 
217
let base_class_name = snd
 
218
 
 
219
let null_pos = { pfile = "<null>"; pmin = -1; pmax = -1 }
 
220
 
 
221
let set_eval (e : eval) (v : eval_def) =
 
222
        Obj.set_field (Obj.repr e) 0 (Obj.repr v)
 
223
 
 
224
let punion p p2 =
 
225
        {
 
226
                pfile = p.pfile;
 
227
                pmin = min p.pmin p2.pmin;
 
228
                pmax = max p.pmax p2.pmax;
 
229
        }
 
230
 
 
231
let s_type_path (p,s) = match p with [] -> s | _ -> String.concat "." p ^ "." ^ s
 
232
 
 
233
let s_escape s =
 
234
        let b = Buffer.create (String.length s) in
 
235
        for i = 0 to (String.length s) - 1 do
 
236
                match s.[i] with
 
237
                | '\n' -> Buffer.add_string b "\\n"
 
238
                | '\t' -> Buffer.add_string b "\\t"
 
239
                | '\r' -> Buffer.add_string b "\\r"
 
240
                | c -> Buffer.add_char b c
 
241
        done;
 
242
        Buffer.contents b
 
243
 
 
244
let s_constant = function
 
245
        | Int s -> s
 
246
        | Float s -> s
 
247
        | String s -> "\"" ^ s_escape s ^ "\""
 
248
        | Ident s -> s
 
249
        
 
250
let s_keyword = function
 
251
        | Function -> "function"
 
252
        | Class -> "class"
 
253
        | Static -> "static"
 
254
        | Var -> "var"
 
255
        | If -> "if"
 
256
        | Else -> "else"
 
257
        | While -> "while"
 
258
        | Do -> "do"
 
259
        | For -> "for"
 
260
        | Break -> "break"
 
261
        | Return -> "return"
 
262
        | Continue -> "continue"
 
263
        | Interface -> "interface"
 
264
        | Extends -> "extends"
 
265
        | Implements -> "implements"
 
266
        | Import -> "import"
 
267
        | Switch -> "switch"
 
268
        | Case -> "case"
 
269
        | Default -> "default"
 
270
        | Intrinsic -> "intrinsic"
 
271
        | Dynamic -> "dynamic"
 
272
        | Private -> "private"
 
273
        | Public -> "public"
 
274
        | Try -> "try"
 
275
        | Catch -> "catch"
 
276
        | Finally -> "finally"
 
277
        | With -> "with"
 
278
        | In -> "in"
 
279
        | InstanceOf -> "instanceof"
 
280
        | New -> "new"
 
281
        | This -> "this"
 
282
        | Throw -> "throw"
 
283
        | Typeof -> "typeof"
 
284
        | Delete -> "delete"
 
285
        | Void -> "void"
 
286
        (* deprecated *)
 
287
        | Add -> "add"
 
288
        | And -> "and"
 
289
        | Or -> "or"
 
290
        | Eq -> "eq"
 
291
        | Ne -> "ne"
 
292
        | KwdNot -> "not"
 
293
        | Le -> "le"
 
294
        | Lt -> "lt"
 
295
        | Ge -> "ge"
 
296
        | Gt -> "gt"
 
297
        | IfFrameLoaded -> "ifFrameLoaded"
 
298
        | On -> "on"
 
299
        | OnClipEvent -> "onClipEvent"
 
300
        | TellTarget -> "tellTarget"
 
301
 
 
302
let rec s_binop = function
 
303
        | OpAdd -> "+"
 
304
        | OpMult -> "*"
 
305
        | OpDiv -> "/"
 
306
        | OpSub -> "-"
 
307
        | OpAssign -> "="
 
308
        | OpEq -> "=="
 
309
        | OpPhysEq -> "==="
 
310
        | OpNotEq -> "!="
 
311
        | OpPhysNotEq -> "!=="
 
312
        | OpGte -> ">="
 
313
        | OpLte -> "<="
 
314
        | OpGt -> ">"
 
315
        | OpLt -> "<"
 
316
        | OpAnd -> "&"
 
317
        | OpOr -> "|"
 
318
        | OpXor -> "^"
 
319
        | OpBoolAnd -> "&&"
 
320
        | OpBoolOr -> "||"
 
321
        | OpShr -> ">>"
 
322
        | OpUShr -> ">>>"
 
323
        | OpShl -> "<<"
 
324
        | OpMod -> "%"
 
325
        | OpAssignOp op -> s_binop op ^ "="
 
326
 
 
327
let s_unop = function
 
328
        | Increment -> "++"
 
329
        | Decrement -> "--"
 
330
        | Not -> "!"
 
331
        | Neg -> "-"
 
332
        | NegBits -> "~"
 
333
 
 
334
let s_token = function
 
335
        | Eof -> "<end of file>"
 
336
        | Const c -> s_constant c
 
337
        | Kwd k -> s_keyword k
 
338
        | Comment s -> "/*"^s^"*/"
 
339
        | CommentLine s -> "//"^s
 
340
        | Binop o -> s_binop o
 
341
        | Unop o -> s_unop o
 
342
        | Next -> ";"
 
343
        | Sep -> ","
 
344
        | BkOpen -> "["
 
345
        | BkClose -> "]"
 
346
        | BrOpen -> "{"
 
347
        | BrClose -> "}"
 
348
        | POpen -> "("
 
349
        | PClose -> ")"
 
350
        | Dot -> "."
 
351
        | DblDot -> ":"
 
352
        | Question -> "?"
 
353
        | Sharp -> "#"
 
354
 
 
355
exception Invalid_expression of pos
 
356
 
 
357
let rec check_val (v,p) =
 
358
        match v with
 
359
        | EBinop (OpAssign,_,_)
 
360
        | EBinop (OpAssignOp _,_,_)
 
361
        | ECall _
 
362
        | EUnop (Increment,_,_)
 
363
        | EUnop (Decrement,_,_)
 
364
        | EQuestion _
 
365
                -> ()
 
366
        | ENew _
 
367
        | EConst _
 
368
        | EArray _ 
 
369
        | EBinop _
 
370
        | EField _
 
371
        | EObjDecl _
 
372
        | EArrayDecl _
 
373
        | EUnop _
 
374
        | ELambda _
 
375
        | EStatic _
 
376
        | ECast _
 
377
                -> raise (Invalid_expression p)
 
378
        | EParenthesis v ->
 
379
                check_val v
 
380
 
 
381
let rec check_expr (e,p) =
 
382
        match e with
 
383
        | EVars (_,_,vl) -> ()
 
384
        | EFunction f -> 
 
385
                (match f.fexpr with None -> () | Some e -> check_expr e)
 
386
        | EBlock el ->
 
387
                List.iter check_expr el
 
388
        | EFor (el, _ , _ , e ) ->
 
389
                List.iter check_expr el;
 
390
                check_expr e
 
391
        | EForIn (_,_,e) ->
 
392
                check_expr e
 
393
        | EIf (_,e,eo) ->
 
394
                check_expr e;
 
395
                (match eo with None -> () | Some e -> check_expr e)
 
396
        | EWhile (_,e,_) ->
 
397
                check_expr e
 
398
        | ESwitch (_,cl) ->
 
399
                List.iter (fun (_,e) -> check_expr e) cl;
 
400
        | ETry (e,cl,eo) ->
 
401
                check_expr e;
 
402
                List.iter (fun (_,_,e) -> check_expr e) !cl;
 
403
                (match eo with None -> () | Some e -> check_expr e)
 
404
        | EWith (_,e) ->
 
405
                check_expr e;
 
406
        | EReturn _
 
407
        | EBreak
 
408
        | EContinue -> ()               
 
409
        | EVal v ->
 
410
                check_val v
 
411
 
 
412
let check_sign (s,p) = 
 
413
        match s with
 
414
        | EClass (_,_,e) -> check_expr e
 
415
        | EInterface (_,_,e) -> check_expr e
 
416
        | EImport _ -> ()