Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

added variance.

git-svn-id: http://haxe.googlecode.com/svn/trunk@1432 f16182fa-f095-11de-8f43-4547254af6c6
  • Loading branch information...
commit bbcdb812a7e15c937559fa2e6646964bd7899970 1 parent f5fed79
ncannasse authored
Showing with 358 additions and 211 deletions.
  1. +21 −7 ast.ml
  2. +15 −5 genxml.ml
  3. +62 −31 parser.ml
  4. +6 −0 std/StdTypes.hx
  5. +110 −52 type.ml
  6. +144 −116 typer.ml
View
28 ast.ml
@@ -132,10 +132,16 @@ type while_flag =
| NormalWhile
| DoWhile
+type variance =
+ | VNo
+ | VCo
+ | VContra
+ | VBi
+
type type_path_normal = {
tpackage : string list;
tname : string;
- tparams : type_path list;
+ tparams : (variance * type_path) list;
}
and anonymous_field =
@@ -185,7 +191,7 @@ and expr_def =
and expr = expr_def * pos
-type type_param = string * type_path_normal list
+type type_param = variance * string * type_path_normal list
type documentation = string option
@@ -201,11 +207,11 @@ type class_field =
| FFun of string * documentation * access list * type_param list * func
| FProp of string * documentation * access list * string * string * type_path
-type enum_param =
+type enum_flag =
| EPrivate
| EExtern
-type type_param_flag =
+type class_flag =
| HInterface
| HExtern
| HPrivate
@@ -214,10 +220,18 @@ type type_param_flag =
type enum_constructor = string * documentation * (string * bool * type_path) list * pos
+type ('a,'b) definition = {
+ d_name : string;
+ d_doc : documentation;
+ d_params : type_param list;
+ d_flags : 'a list;
+ d_data : 'b;
+}
+
type type_def =
- | EClass of string * documentation * type_param list * type_param_flag list * (class_field * pos) list
- | EEnum of string * documentation * type_param list * enum_param list * enum_constructor list
- | ETypedef of string * documentation * type_param list * enum_param list * type_path
+ | EClass of (class_flag, (class_field * pos) list) definition
+ | EEnum of (enum_flag, enum_constructor list) definition
+ | ETypedef of (enum_flag, type_path) definition
| EImport of string list * string * string option
type type_decl = type_def * pos
View
20 genxml.ml
@@ -51,14 +51,24 @@ let gen_arg_name (name,opt,_) =
let rec gen_type t =
match t with
| TMono m -> (match !m with None -> tag "unknown" | Some t -> gen_type t)
- | TEnum (e,params) -> node "e" [gen_path e.e_path e.e_private] (List.map gen_type params)
- | TInst (c,params) -> node "c" [gen_path c.cl_path c.cl_private] (List.map gen_type params)
- | TType (t,params) -> node "t" [gen_path t.t_path t.t_private] (List.map gen_type params)
+ | TEnum (e,params) -> node "e" [gen_path e.e_path e.e_private] (List.map gen_ptype params)
+ | TInst (c,params) -> node "c" [gen_path c.cl_path c.cl_private] (List.map gen_ptype params)
+ | TType (t,params) -> node "t" [gen_path t.t_path t.t_private] (List.map gen_ptype params)
| TFun (args,r) -> node "f" ["a",String.concat ":" (List.map gen_arg_name args)] (List.map gen_type (List.map (fun (_,_,t) -> t) args @ [r]))
| TAnon a -> node "a" [] (pmap (fun f -> node f.cf_name [] [gen_type f.cf_type]) a.a_fields)
| TDynamic t2 -> node "d" [] (if t == t2 then [] else [gen_type t2])
| TLazy f -> gen_type (!f())
+and gen_ptype (v,t) =
+ match gen_type t with
+ | Node (name,att,c) as n ->
+ (match v with
+ | VNo -> n
+ | VBi -> Node (name,("v","*") :: att,c)
+ | VCo -> Node (name,("v","+") :: att,c)
+ | VContra -> Node (name,("v","-") :: att,c))
+ | _ -> assert false
+
let gen_constr e =
let doc = gen_doc_opt e.ef_doc in
let args, t = (match follow e.ef_type with
@@ -77,10 +87,10 @@ let gen_field att f =
let gen_type_params priv path params pos m =
let mpriv = (if priv then [("private","1")] else []) in
let mpath = (if m.mpath <> path then [("module",snd (gen_path m.mpath false))] else []) in
- gen_path path priv :: ("params", String.concat ":" (List.map fst params)) :: ("file",if pos == null_pos then "" else pos.pfile) :: (mpriv @ mpath)
+ gen_path path priv :: ("params", String.concat ":" (List.map (fun (_,n,_) -> n) params)) :: ("file",if pos == null_pos then "" else pos.pfile) :: (mpriv @ mpath)
let gen_class_path name (c,pl) =
- node name [("path",s_type_path c.cl_path)] (List.map gen_type pl)
+ node name [("path",s_type_path c.cl_path)] (List.map gen_ptype pl)
let gen_type ctx t =
let m = Typer.module_of_type ctx t in
View
93 parser.ml
@@ -146,11 +146,32 @@ let rec parse_file s =
and parse_type_decl s =
match s with parser
| [< '(Kwd Import,p1); p, t, s = parse_import; p2 = semicolon >] -> EImport (p,t,s) , punion p1 p2
- | [< c = parse_common_params; s >] ->
+ | [< c = parse_common_flags; s >] ->
match s with parser
- | [< n , p1 = parse_enum_params; doc = get_doc; '(Const (Type name),_); tl = parse_type_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] -> (EEnum (name,doc,tl,List.map snd c @ n,l), punion p1 p2)
- | [< n , p1 = parse_class_params; doc = get_doc; '(Const (Type name),_); tl = parse_type_params; hl = psep Comma parse_class_herit; '(BrOpen,_); fl = plist parse_class_field; '(BrClose,p2) >] -> (EClass (name,doc,tl,List.map fst c @ n @ hl,fl), punion p1 p2)
- | [< '(Kwd Typedef,p1); doc = get_doc; '(Const (Type name),p2); tl = parse_type_params; '(Binop OpAssign,_); t = parse_type_path >] -> (ETypedef (name,doc,tl,List.map snd c,t), punion p1 p2)
+ | [< n , p1 = parse_enum_flags; doc = get_doc; '(Const (Type name),_); tl = parse_constraint_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] ->
+ (EEnum {
+ d_name = name;
+ d_doc = doc;
+ d_params = tl;
+ d_flags = List.map snd c @ n;
+ d_data = l
+ }, punion p1 p2)
+ | [< n , p1 = parse_class_flags; doc = get_doc; '(Const (Type name),_); tl = parse_constraint_params; hl = psep Comma parse_class_herit; '(BrOpen,_); fl = plist parse_class_field; '(BrClose,p2) >] ->
+ (EClass {
+ d_name = name;
+ d_doc = doc;
+ d_params = tl;
+ d_flags = List.map fst c @ n @ hl;
+ d_data = fl;
+ }, punion p1 p2)
+ | [< '(Kwd Typedef,p1); doc = get_doc; '(Const (Type name),p2); tl = parse_constraint_params; '(Binop OpAssign,_); t = parse_type_path >] ->
+ (ETypedef {
+ d_name = name;
+ d_doc = doc;
+ d_params = tl;
+ d_flags = List.map snd c;
+ d_data = t;
+ }, punion p1 p2)
and parse_package s = psep Dot ident s
@@ -161,15 +182,15 @@ and parse_import = parser
| [< '(Dot,_); '(Const (Type s),_) >] -> Some s
| [< >] -> None
-and parse_common_params = parser
- | [< '(Kwd Private,_); l = parse_common_params >] -> (HPrivate, EPrivate) :: l
- | [< '(Kwd Extern,_); l = parse_common_params >] -> (HExtern, EExtern) :: l
+and parse_common_flags = parser
+ | [< '(Kwd Private,_); l = parse_common_flags >] -> (HPrivate, EPrivate) :: l
+ | [< '(Kwd Extern,_); l = parse_common_flags >] -> (HExtern, EExtern) :: l
| [< >] -> []
-and parse_enum_params = parser
+and parse_enum_flags = parser
| [< '(Kwd Enum,p) >] -> [] , p
-and parse_class_params = parser
+and parse_class_flags = parser
| [< '(Kwd Class,p) >] -> [] , p
| [< '(Kwd Interface,p) >] -> [HInterface] , p
@@ -198,7 +219,7 @@ and parse_type_path1 pack = parser
| [< '(Const (Ident name),_); '(Dot,_); t = parse_type_path1 (name :: pack) >] -> t
| [< '(Const (Type name),_); s >] ->
let params = (match s with parser
- | [< '(Binop OpLt,_); l = psep Comma parse_type_path; '(Binop OpGt,_) >] -> l
+ | [< '(Binop OpLt,_); l = psep Comma parse_type_path_variance; '(Binop OpGt,_) >] -> l
| [< >] -> []
) in
{
@@ -207,6 +228,12 @@ and parse_type_path1 pack = parser
tparams = params
}
+and parse_type_path_variance = parser
+ | [< '(Binop OpAdd,_); t = parse_type_path >] -> VCo, t
+ | [< '(Binop OpSub,_); t = parse_type_path >] -> VContra, t
+ | [< '(Binop OpMult,_); t = parse_type_path >] -> VBi, t
+ | [< t = parse_type_path >] -> VNo, t
+
and parse_type_path_next t = parser
| [< '(Arrow,_); t2 = parse_type_path >] ->
(match t2 with
@@ -256,7 +283,7 @@ and parse_class_field s =
| [< >] -> serror()
) in
(FVar (name,doc,l,t,e),punion p1 p2))
- | [< '(Kwd Function,p1); name = parse_fun_name; pl = parse_type_params; '(POpen,_); al = psep Comma parse_fun_param; '(PClose,_); t = parse_type_opt; s >] ->
+ | [< '(Kwd Function,p1); name = parse_fun_name; pl = parse_constraint_params; '(POpen,_); al = psep Comma parse_fun_param; '(PClose,_); t = parse_type_opt; s >] ->
let e = (match s with parser
| [< e = expr >] -> e
| [< '(Semicolon,p) >] -> (EBlock [],p)
@@ -300,19 +327,23 @@ and parse_fun_param_type = parser
| [< '(Question,_); name = any_ident; '(DblDot,_); t = parse_type_path >] -> (name,true,t)
| [< name = any_ident; '(DblDot,_); t = parse_type_path >] -> (name,false,t)
-and parse_type_params = parser
- | [< '(Binop OpLt,_); l = psep Comma parse_type_param; '(Binop OpGt,_) >] -> l
+and parse_constraint_params = parser
+ | [< '(Binop OpLt,_); l = psep Comma parse_constraint_param; '(Binop OpGt,_) >] -> l
| [< >] -> []
-and parse_type_param = parser
- | [< '(Const (Type name),_); s >] ->
- match s with parser
- | [< '(DblDot,_); s >] ->
- (match s with parser
- | [< '(POpen,_); l = psep Comma parse_type_path_normal; '(PClose,_) >] -> (name,l)
- | [< t = parse_type_path_normal >] -> (name,[t])
- | [< >] -> serror())
- | [< >] -> (name,[])
+and parse_constraint_param = parser
+ | [< '(Binop OpAdd,_); '(Const (Type name),_); s >] -> parse_constraint_param_next VCo name s
+ | [< '(Binop OpSub,_); '(Const (Type name),_); s >] -> parse_constraint_param_next VContra name s
+ | [< '(Binop OpMult,_); '(Const (Type name),_); s >] -> parse_constraint_param_next VBi name s
+ | [< '(Const (Type name),_); s >] -> parse_constraint_param_next VNo name s
+
+and parse_constraint_param_next v name = parser
+ | [< '(DblDot,_); s >] ->
+ (match s with parser
+ | [< '(POpen,_); l = psep Comma parse_type_path_normal; '(PClose,_) >] -> (v,name,l)
+ | [< t = parse_type_path_normal >] -> (v,name,[t])
+ | [< >] -> serror())
+ | [< >] -> (v,name,[])
and parse_class_herit = parser
| [< '(Kwd Extends,_); t = parse_type_path_normal >] -> HExtends t
@@ -361,7 +392,7 @@ and parse_obj_decl = parser
| [< >] -> [])
| [< >] -> []
-and parse_array_decl = parser
+and parse_array_decl = parser
| [< e = expr; s >] ->
(match s with parser
| [< '(Comma,_); l = parse_array_decl >] -> e :: l
@@ -483,9 +514,9 @@ let parse code file =
cache := DynArray.create();
doc := None;
Lexer.init file;
- let rec next_token() = process_token (Lexer.token code)
+ let rec next_token() = process_token (Lexer.token code)
- and process_token tk =
+ and process_token tk =
match fst tk with
| Comment s ->
let l = String.length s in
@@ -545,17 +576,17 @@ let parse code file =
and skip_tokens_loop test tk =
match fst tk with
- | Macro "end" ->
+ | Macro "end" ->
Lexer.token code
- | Macro "else" when not test ->
+ | Macro "else" when not test ->
skip_tokens test
- | Macro "else" ->
+ | Macro "else" ->
enter_macro()
- | Macro "if" ->
+ | Macro "if" ->
skip_tokens_loop test (skip_tokens false)
- | Eof ->
+ | Eof ->
raise Exit
- | _ ->
+ | _ ->
skip_tokens test
and skip_tokens test = skip_tokens_loop test (Lexer.token code)
View
6 std/StdTypes.hx
@@ -51,3 +51,9 @@ typedef Iterator<T> = {
}
extern interface ArrayAccess<T> { }
+
+/**
+ Protected represent the type parameter that cannot be used when using variance annotations.
+*/
+extern enum Protected {
+}
View
162 type.ml
@@ -16,6 +16,7 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
+open Ast
type module_path = string list * string
@@ -25,16 +26,20 @@ type field_access =
| MethodAccess of string
| F9MethodAccess
+type variance = Ast.variance
+
type t =
| TMono of t option ref
- | TEnum of tenum * t list
- | TInst of tclass * t list
- | TType of tdef * t list
+ | TEnum of tenum * tparams
+ | TInst of tclass * tparams
+ | TType of tdef * tparams
| TFun of (string * bool * t) list * t
| TAnon of tanon
| TDynamic of t
| TLazy of (unit -> t) ref
+and tparams = (variance * t) list
+
and tconstant =
| TInt of int32
| TFloat of string
@@ -67,7 +72,7 @@ and texpr_expr =
| TObjectDecl of (string * texpr) list
| TArrayDecl of texpr list
| TCall of texpr * texpr list
- | TNew of tclass * t list * texpr list
+ | TNew of tclass * tparams * texpr list
| TUnop of Ast.unop * Ast.unop_flag * texpr
| TFunction of tfunc
| TVars of (string * t * texpr option) list
@@ -76,7 +81,7 @@ and texpr_expr =
| TIf of texpr * texpr * texpr option
| TWhile of texpr * texpr * Ast.while_flag
| TSwitch of texpr * (texpr * texpr) list * texpr option
- | TMatch of texpr * (tenum * t list) * (string * (string option * t) list option * texpr) list * texpr option
+ | TMatch of texpr * (tenum * tparams) * (string * (string option * t) list option * texpr) list * texpr option
| TTry of texpr * (string * t * texpr) list
| TReturn of texpr option
| TBreak
@@ -107,9 +112,9 @@ and tclass = {
cl_private : bool;
mutable cl_extern : bool;
mutable cl_interface : bool;
- mutable cl_types : (string * t) list;
- mutable cl_super : (tclass * t list) option;
- mutable cl_implements : (tclass * t list) list;
+ mutable cl_types : (variance * string * t) list;
+ mutable cl_super : (tclass * tparams) option;
+ mutable cl_implements : (tclass * tparams) list;
mutable cl_fields : (string , tclass_field) PMap.t;
mutable cl_statics : (string, tclass_field) PMap.t;
mutable cl_ordered_statics : tclass_field list;
@@ -132,7 +137,7 @@ and tenum = {
e_doc : Ast.documentation;
e_private : bool;
e_extern : bool;
- mutable e_types : (string * t) list;
+ mutable e_types : (variance * string * t) list;
mutable e_constrs : (string , tenum_field) PMap.t;
}
@@ -142,7 +147,7 @@ and tdef = {
t_doc : Ast.documentation;
t_private : bool;
t_static : tclass option;
- mutable t_types : (string * t) list;
+ mutable t_types : (variance * string * t) list;
mutable t_type : t;
}
@@ -236,7 +241,7 @@ let rec s_type ctx t =
let fl = PMap.fold (fun f acc -> (" " ^ f.cf_name ^ " : " ^ s_type ctx f.cf_type) :: acc) a.a_fields [] in
"{" ^ (if !(a.a_open) then "+" else "") ^ String.concat "," fl ^ " }"
| TDynamic t2 ->
- "Dynamic" ^ s_type_params ctx (if t == t2 then [] else [t2])
+ "Dynamic" ^ s_type_params ctx (if t == t2 then [] else [VNo,t2])
| TLazy f ->
s_type ctx (!f())
@@ -248,7 +253,13 @@ and s_fun ctx t void =
and s_type_params ctx = function
| [] -> ""
- | l -> "<" ^ String.concat ", " (List.map (s_type ctx) l) ^ ">"
+ | l -> "<" ^ String.concat ", " (List.map (fun (v,t) -> s_var v ^ s_type ctx t) l) ^ ">"
+
+and s_var = function
+ | VNo -> ""
+ | VCo -> "+"
+ | VContra -> "-"
+ | VBi -> "*"
let rec is_parent csup c =
if c == csup then
@@ -263,7 +274,8 @@ let rec link e a b =
true
else match t with
| TMono t -> (match !t with None -> false | Some t -> loop t)
- | TEnum (_,tl) | TInst (_,tl) | TType (_,tl) -> List.exists loop tl
+ | TEnum (e,tl) -> e.e_path = ([],"Protected") || List.exists (fun (_,t) -> loop t) tl
+ | TInst (_,tl) | TType (_,tl) -> List.exists (fun (_,t) -> loop t) tl
| TFun (tl,t) -> List.exists (fun (_,_,t) -> loop t) tl || loop t
| TDynamic t2 ->
if t == t2 then
@@ -294,63 +306,88 @@ let apply_params cparams params t =
let rec loop l1 l2 =
match l1, l2 with
| [] , [] -> []
- | (_,t1) :: l1 , t2 :: l2 -> (t1,t2) :: loop l1 l2
+ | (_,_,t1) :: l1 , (v,t2) :: l2 -> (t1,(v,t2)) :: loop l1 l2
| _ -> assert false
in
+ let protect() =
+ TEnum ({
+ e_path = [] , "Protected";
+ e_pos = null_pos;
+ e_doc = None;
+ e_private = false;
+ e_extern = true;
+ e_types = [];
+ e_constrs = PMap.empty;
+ },[])
+ in
let subst = loop cparams params in
- let rec loop t =
+ let rec loop v t =
try
- List.assq t subst
+ let v2, t = List.assq t subst in
+ (match v2 with
+ | VCo when v <> VContra -> VBi, protect()
+ | VContra when v <> VCo -> VBi, protect()
+ | VBi -> VBi, protect()
+ | _ -> v2, t)
with Not_found ->
match t with
| TMono r ->
(match !r with
- | None -> t
- | Some t -> loop t)
+ | None -> v, t
+ | Some t -> loop v t)
| TEnum (e,tl) ->
- (match tl with
+ v, (match tl with
| [] -> t
- | _ -> TEnum (e,List.map loop tl))
+ | _ -> TEnum (e,List.map (vloop v) tl))
| TType (t2,tl) ->
- (match tl with
+ v, (match tl with
| [] -> t
- | _ -> TType (t2,List.map loop tl))
+ | _ -> TType (t2,List.map (vloop v) tl))
| TInst (c,tl) ->
- (match tl with
+ v, (match tl with
| [] ->
t
- | [TMono r] ->
+ | [mv,TMono r] ->
(match !r with
| Some tt when t == tt ->
(* for dynamic *)
let pt = mk_mono() in
- let t = TInst (c,[pt]) in
+ let t = TInst (c,[mv,pt]) in
(match pt with TMono r -> r := Some t | _ -> assert false);
t
- | _ -> TInst (c,List.map loop tl))
+ | _ -> TInst (c,List.map (vloop v) tl))
| _ ->
- TInst (c,List.map loop tl))
+ TInst (c,List.map (vloop v) tl))
| TFun (tl,r) ->
- TFun (List.map (fun (s,o,t) -> s, o, loop t) tl,loop r)
+ v, TFun (List.map (fun (s,o,t) -> s, o, snd (loop VCo t)) tl,snd (loop VContra r))
| TAnon a ->
- TAnon {
- a_fields = PMap.map (fun f -> { f with cf_type = loop f.cf_type }) a.a_fields;
+ v, TAnon {
+ a_fields = PMap.map (fun f -> { f with cf_type = snd (loop VCo f.cf_type) }) a.a_fields;
a_open = a.a_open;
}
| TLazy f ->
let ft = !f() in
- let ft2 = loop ft in
+ let v , ft2 = loop v ft in
if ft == ft2 then
- t
+ v, t
else
- ft2
+ v, ft2
| TDynamic t2 ->
if t == t2 then
- t
+ v, t
else
- TDynamic (loop t2)
+ v, TDynamic (snd (loop VNo t2))
+ and vloop v (v2,t) =
+ (* only use the given variance position if no variance defined by default *)
+ let v, t = loop v t in
+ (* compute max. restricted variance based on both requested and found *)
+ (match v , v2 with
+ | _ , VBi | VBi , _ | VCo, VContra | VContra, VCo -> VBi
+ | VCo , VCo | VContra , VContra -> v
+ | VNo , _ -> v2
+ | _ , VNo -> v) , t
in
- loop t
+ snd (loop VNo t)
let rec follow t =
match t with
@@ -365,23 +402,26 @@ let rec follow t =
| _ -> t
let monomorphs eparams t =
- apply_params eparams (List.map (fun _ -> mk_mono()) eparams) t
+ apply_params eparams (List.map (fun (v,_,_) -> v , mk_mono()) eparams) t
let rec fast_eq a b =
- if a == b then
+ if a == b then
true
else match a , b with
| TFun (l1,r1) , TFun (l2,r2) ->
List.for_all2 (fun (_,_,t1) (_,_,t2) -> fast_eq t1 t2) l1 l2 && fast_eq r1 r2
| TType (t1,l1), TType (t2,l2) ->
- t1 == t2 && List.for_all2 fast_eq l1 l2
+ t1 == t2 && List.for_all2 fast_peq l1 l2
| TEnum (e1,l1), TEnum (e2,l2) ->
- e1 == e2 && List.for_all2 fast_eq l1 l2
+ e1 == e2 && List.for_all2 fast_peq l1 l2
| TInst (c1,l1), TInst (c2,l2) ->
- c1 == c2 && List.for_all2 fast_eq l1 l2
+ c1 == c2 && List.for_all2 fast_peq l1 l2
| _ , _ ->
false
+and fast_peq (_,a) (_,b) =
+ fast_eq a b
+
let eq_stack = ref []
let rec type_eq param a b =
@@ -402,9 +442,9 @@ let rec type_eq param a b =
eq_stack := List.tl !eq_stack;
r
end
- | TEnum (a,tl1) , TEnum (b,tl2) -> a == b && List.for_all2 (type_eq param) tl1 tl2
+ | TEnum (a,tl1) , TEnum (b,tl2) -> a == b && List.for_all2 (type_peq param) tl1 tl2
| TInst (c1,tl1) , TInst (c2,tl2) ->
- c1 == c2 && List.for_all2 (type_eq param) tl1 tl2
+ c1 == c2 && List.for_all2 (type_peq param) tl1 tl2
| TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 ->
type_eq param r1 r2 && List.for_all2 (fun (_,o1,t1) (_,o2,t2) -> o1 = o2 && type_eq param t1 t2) l1 l2
| TDynamic a , TDynamic b ->
@@ -415,7 +455,7 @@ let rec type_eq param a b =
try
let f2 = PMap.find f1.cf_name a2.a_fields in
if not (type_eq param f1.cf_type f2.cf_type) then raise Exit;
- if f1.cf_get <> f2.cf_get || f1.cf_set <> f2.cf_set then raise Exit;
+ if f1.cf_get <> f2.cf_get || f1.cf_set <> f2.cf_set then raise Exit;
with
Not_found ->
if not !(a2.a_open) then raise Exit;
@@ -433,6 +473,10 @@ let rec type_eq param a b =
| _ , _ ->
false
+and type_peq params (_,a) (_,b) =
+ type_eq params a b
+
+
(* perform unification with subtyping.
the first type is always the most down in the class hierarchy
it's also the one that is pointed by the position.
@@ -457,11 +501,6 @@ let error l = raise (Unify_error l)
let unify_stack = ref []
-let unify_types a b tl1 tl2 =
- List.iter2 (fun ta tb ->
- if not (type_eq true ta tb) then error [cannot_unify a b; cannot_unify ta tb]
- ) tl1 tl2
-
let unify_access a1 a2 =
a1 = a2 || (a1 = NormalAccess && (a2 = NoAccess || a2 = F9MethodAccess))
|| (a1 = F9MethodAccess && a2 = NormalAccess) (* unsafe, but no inference of prop. set *)
@@ -469,7 +508,7 @@ let unify_access a1 a2 =
let field_type f =
match f.cf_params with
| [] -> f.cf_type
- | l -> monomorphs l f.cf_type
+ | l -> monomorphs (List.map (fun (n,t) -> VNo, n, t) l) f.cf_type
let rec class_field c i =
try
@@ -536,9 +575,9 @@ let rec unify a b =
end else (match c.cl_super with
| None -> false
| Some (cs,tls) ->
- loop cs (List.map (apply_params c.cl_types tl) tls)
+ loop cs (List.map (fun (v,t) -> v , apply_params c.cl_types tl t) tls)
) || List.exists (fun (cs,tls) ->
- loop cs (List.map (apply_params c.cl_types tl) tls)
+ loop cs (List.map (fun (v,t) -> v , apply_params c.cl_types tl t) tls)
) c.cl_implements
in
if not (loop c1 tl1) then error [cannot_unify a b]
@@ -606,6 +645,25 @@ let rec unify a b =
| _ , _ ->
error [cannot_unify a b]
+and unify_types a b tl1 tl2 =
+ try
+ List.iter2 (fun (va,ta) (vb,tb) ->
+ (match va, vb with
+ | VNo , _
+ | VCo , VCo
+ | VContra, VContra
+ | _ , VBi -> ()
+ | _ -> error []
+ );
+ match vb with
+ | VNo -> if not (type_eq true ta tb) then error [cannot_unify ta tb]
+ | VCo -> unify ta tb
+ | VContra -> unify tb ta
+ | VBi -> ()
+ ) tl1 tl2
+ with
+ Unify_error l -> error ((cannot_unify a b) :: l)
+
let rec iter f e =
match e.eexpr with
| TConst _
View
260 typer.ml
@@ -25,7 +25,7 @@ type error_msg =
| Unify of unify_error list
| Custom of string
| Protect of error_msg
- | Unknown_ident of string
+ | Unknown_ident of string
| Stack of error_msg * error_msg
type context = {
@@ -287,20 +287,20 @@ let rec load_normal_type ctx t p allow_no_params =
| TTypeDecl t -> t.t_types , t.t_path , (fun tl -> TType(t,tl))
in
if allow_no_params && t.tparams = [] then
- f (List.map (fun (name,t) ->
+ f (List.map (fun (v,name,t) ->
match follow t with
- | TEnum _ -> mk_mono()
+ | TEnum _ -> v, mk_mono()
| _ -> error ("Type parameter " ^ name ^ " need constraint") p
) types)
else if path = ([],"Dynamic") then
match t.tparams with
| [] -> t_dynamic
- | [t] -> TDynamic (load_type ctx p t)
+ | [_,t] -> TDynamic (load_type ctx p t)
| _ -> error "Too many parameters for Dynamic" p
else begin
if List.length types <> List.length t.tparams then error ("Invalid number of type parameters for " ^ s_type_path path) p;
- let tparams = List.map (load_type ctx p) t.tparams in
- let params = List.map2 (fun t (_,t2) ->
+ let tparams = List.map (fun (v,t) -> v, load_type ctx p t) t.tparams in
+ let params = List.map2 (fun (v1,t) (v2,_,t2) ->
(match follow t2 with
| TInst (c,[]) ->
List.iter (fun (i,params) ->
@@ -308,7 +308,7 @@ let rec load_normal_type ctx t p allow_no_params =
) c.cl_implements
| TEnum (c,[]) -> ()
| _ -> assert false);
- t
+ (match v1 with VNo -> v2 | _ -> v1) , t
) tparams types in
f params
end
@@ -392,11 +392,11 @@ let load_type_opt ctx p t =
let rec reverse_type t =
match t with
| TEnum (e,params) ->
- TPNormal { tpackage = fst e.e_path; tname = snd e.e_path; tparams = List.map reverse_type params }
+ TPNormal { tpackage = fst e.e_path; tname = snd e.e_path; tparams = List.map reverse_param params }
| TInst (c,params) ->
- TPNormal { tpackage = fst c.cl_path; tname = snd c.cl_path; tparams = List.map reverse_type params }
+ TPNormal { tpackage = fst c.cl_path; tname = snd c.cl_path; tparams = List.map reverse_param params }
| TType (t,params) ->
- TPNormal { tpackage = fst t.t_path; tname = snd t.t_path; tparams = List.map reverse_type params }
+ TPNormal { tpackage = fst t.t_path; tname = snd t.t_path; tparams = List.map reverse_param params }
| TFun (params,ret) ->
TPFunction (List.map (fun (_,_,t) -> reverse_type t) params,reverse_type ret)
| TAnon a ->
@@ -404,10 +404,13 @@ let rec reverse_type t =
(f.cf_name , AFVar (reverse_type f.cf_type), null_pos) :: acc
) a.a_fields [])
| TDynamic t2 ->
- TPNormal { tpackage = []; tname = "Dynamic"; tparams = if t == t2 then [] else [reverse_type t2] }
+ TPNormal { tpackage = []; tname = "Dynamic"; tparams = if t == t2 then [] else [VNo,reverse_type t2] }
| _ ->
raise Exit
+and reverse_param (v,t) =
+ v , reverse_type t
+
let extend_remoting ctx c t p async prot =
if ctx.isproxy then error "Cascading proxys can result in infinite loops, please use conditional compilation to prevent this proxy access" p;
if c.cl_super <> None then error "Cannot extend several classes" p;
@@ -463,7 +466,13 @@ let extend_remoting ctx c t p async prot =
| _ ->
error "Remoting type parameter should be a class" p
) in
- let class_decl = (EClass (t.tname,None,[],[],class_fields),p) in
+ let class_decl = (EClass {
+ d_name = t.tname;
+ d_doc = None;
+ d_params = [];
+ d_flags = [];
+ d_data = class_fields;
+ },p) in
let m = (try Hashtbl.find ctx2.modules (t.tpackage,t.tname) with Not_found -> assert false) in
let mdecl = (List.map (fun (m,t) -> (EImport (fst m.mpath, snd m.mpath, t),p)) m.mimports) @ [class_decl] in
let m = (!type_module_ref) ctx ("Remoting" :: t.tpackage,t.tname) mdecl p in
@@ -508,12 +517,18 @@ let extend_proxy ctx c t p =
| _ ->
error "Proxy type parameter should be a class" p
) in
- let tproxy = { tpackage = ["haxe"]; tname = "Proxy"; tparams = [TPNormal t] } in
+ let tproxy = { tpackage = ["haxe"]; tname = "Proxy"; tparams = [VNo,TPNormal t] } in
let pname = "P" ^ t.tname in
- let class_decl = (EClass (pname,None,List.map (fun (s,_) -> s,[]) c.cl_types,[HExtends tproxy; HImplements t],class_fields),p) in
+ let class_decl = (EClass {
+ d_name = pname;
+ d_doc = None;
+ d_params = List.map (fun (v,s,_) -> v,s,[]) c.cl_types;
+ d_flags = [HExtends tproxy; HImplements t];
+ d_data = class_fields;
+ },p) in
let m = (!type_module_ref) ctx ("Proxy" :: t.tpackage, pname) [class_decl] p in
c.cl_super <- Some (match m.mtypes with
- | [TClassDecl c2] -> (c2,List.map snd c.cl_types)
+ | [TClassDecl c2] -> (c2,List.map (fun (v,_,t) -> v,t) c.cl_types)
| _ -> assert false
)
@@ -521,13 +536,13 @@ let set_heritance ctx c herits p =
let rec loop = function
| HPrivate | HExtern | HInterface ->
()
- | HExtends { tpackage = ["haxe";"remoting"]; tname = "Proxy"; tparams = [TPNormal t] } ->
+ | HExtends { tpackage = ["haxe";"remoting"]; tname = "Proxy"; tparams = [_,TPNormal t] } ->
extend_remoting ctx c t p false true
- | HExtends { tpackage = ["haxe";"remoting"]; tname = "AsyncProxy"; tparams = [TPNormal t] } ->
+ | HExtends { tpackage = ["haxe";"remoting"]; tname = "AsyncProxy"; tparams = [_,TPNormal t] } ->
extend_remoting ctx c t p true true
- | HExtends { tpackage = ["mt"]; tname = "AsyncProxy"; tparams = [TPNormal t] } ->
+ | HExtends { tpackage = ["mt"]; tname = "AsyncProxy"; tparams = [_,TPNormal t] } ->
extend_remoting ctx c t p true false
- | HExtends { tpackage = ["haxe"]; tname = "Proxy"; tparams = [TPNormal t] } when match c.cl_path with "Proxy" :: _ , _ -> false | _ -> true ->
+ | HExtends { tpackage = ["haxe"]; tname = "Proxy"; tparams = [_,TPNormal t] } when match c.cl_path with "Proxy" :: _ , _ -> false | _ -> true ->
extend_proxy ctx c t p
| HExtends t ->
if c.cl_super <> None then error "Cannot extend several classes" p;
@@ -552,7 +567,7 @@ let set_heritance ctx c herits p =
in
List.iter loop herits
-let type_type_params ctx path p (n,flags) =
+let type_type_params ctx path p (v,n,flags) =
let t = (match flags with
| [] ->
(* build a phantom enum *)
@@ -578,7 +593,7 @@ let type_type_params ctx path p (n,flags) =
ctx.delays := [(fun () -> ignore(!r()))] :: !(ctx.delays);
TLazy r
) in
- n , t
+ v, n , t
let hide_types ctx =
let old_locals = ctx.local_types in
@@ -616,25 +631,25 @@ let is_float t =
| _ ->
false
-let t_array ctx =
+let t_array ctx v =
let show = hide_types ctx in
match load_type_def ctx null_pos ([],"Array") with
| TClassDecl c ->
show();
if List.length c.cl_types <> 1 then assert false;
let pt = mk_mono() in
- TInst (c,[pt]) , pt
+ TInst (c,[v,pt]) , pt
| _ ->
assert false
-let t_array_access ctx =
+let t_array_access ctx v =
let show = hide_types ctx in
match load_type_def ctx null_pos ([],"ArrayAccess") with
| TClassDecl c ->
show();
if List.length c.cl_types <> 1 then assert false;
let pt = mk_mono() in
- TInst (c,[pt]) , pt
+ TInst (c,[v,pt]) , pt
| _ ->
assert false
@@ -645,7 +660,7 @@ let t_iterator ctx =
show();
if List.length t.t_types <> 1 then assert false;
let pt = mk_mono() in
- apply_params t.t_types [pt] t.t_type, pt
+ apply_params t.t_types [VNo,pt] t.t_type, pt
| _ ->
assert false
@@ -754,8 +769,8 @@ let type_type ctx tpath p =
let pub = is_parent c ctx.curclass in
let types = (match tparams with
| None ->
- List.map (fun (_,t) ->
- match follow t with
+ List.map (fun (v,_,t) ->
+ v, match follow t with
| TEnum _ -> mk_mono()
| _ -> t
) c.cl_types
@@ -773,7 +788,7 @@ let type_type ctx tpath p =
} in
mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,types)) p
| TEnumDecl e ->
- let types = (match tparams with None -> List.map (fun _ -> mk_mono()) e.e_types | Some l -> l) in
+ let types = (match tparams with None -> List.map (fun (v,_,_) -> v,mk_mono()) e.e_types | Some l -> l) in
let fl = PMap.fold (fun f acc ->
PMap.add f.ef_name {
cf_name = f.ef_name;
@@ -1271,7 +1286,7 @@ and type_switch ctx e cases def need_val p =
(try
let e = acc_get (type_ident ctx name false p true) p in
(match e.eexpr with
- | TEnumField (e,_) -> Some (e, List.map (fun _ -> mk_mono()) e.e_types)
+ | TEnumField (e,_) -> Some (e, List.map (fun (v,_,_) -> v,mk_mono()) e.e_types)
| _ -> None)
with
Error (Custom _,_) -> lookup_enum l)
@@ -1417,6 +1432,24 @@ and type_access ctx e p get =
fields acc (type_access ctx (fst e) (snd e))
in
loop [] (e,p) get
+ | EArray (e1,e2) ->
+ let e1 = type_expr ctx e1 in
+ let e2 = type_expr ctx e2 in
+ unify ctx e2.etype (t_int ctx) e2.epos;
+ let pt = (try
+ let t , pt = t_array ctx VNo in
+ unify_raise ctx e1.etype t e1.epos;
+ pt
+ with Error (Unify _,_) -> try
+ let t , pt = t_array ctx (if get then VCo else VContra) in
+ unify_raise ctx e1.etype t e1.epos;
+ pt
+ with Error (Unify _,_) ->
+ let t, pt = t_array_access ctx (if get then VCo else VContra) in
+ unify ctx e1.etype t e1.epos;
+ pt
+ ) in
+ AccExpr (mk (TArray (e1,e2)) pt p)
| _ ->
AccExpr (type_expr ctx (e,p))
@@ -1424,26 +1457,12 @@ and type_expr ctx ?(need_val=true) (e,p) =
match e with
| EField _
| EType _
+ | EArray _
| EConst (Ident _)
| EConst (Type _) ->
acc_get (type_access ctx e p true) p
| EConst c ->
type_constant ctx c p
- | EArray (e1,e2) ->
- let e1 = type_expr ctx e1 in
- let e2 = type_expr ctx e2 in
- unify ctx e2.etype (t_int ctx) e2.epos;
- let t , pt = t_array ctx in
- let pt = (try
- unify_raise ctx e1.etype t e1.epos;
- pt
- with
- Error (Unify _,_) ->
- let t, pt = t_array_access ctx in
- unify ctx e1.etype t e1.epos;
- pt
- ) in
- mk (TArray (e1,e2)) pt p
| EBinop (op,e1,e2) ->
type_binop ctx op e1 e2 p
| EBlock l ->
@@ -1483,7 +1502,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
let fields , types = List.fold_left loop ([],PMap.empty) fl in
mk (TObjectDecl fields) (mk_anon types) p
| EArrayDecl el ->
- let t , pt = t_array ctx in
+ let t , pt = t_array ctx VNo in
let dyn = ref ctx.untyped in
let el = List.map (fun e ->
let e = type_expr ctx e in
@@ -1494,7 +1513,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
e
) el in
let t = if !dyn then begin
- let t , pt = t_array ctx in
+ let t , pt = t_array ctx VNo in
unify ctx t_dynamic pt p;
t
end else t in
@@ -1635,7 +1654,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
let t = load_type ctx (pos e) t in
(match follow t with
| TInst (_,params) | TEnum (_,params) ->
- List.iter (fun pt ->
+ List.iter (fun (_,pt) ->
if pt != t_dynamic then error "Catch class parameter must be Dynamic" p;
) params;
| TDynamic _ -> ()
@@ -1867,7 +1886,7 @@ let rec check_interface ctx c p intf params =
if not c.cl_interface then display_error ctx ("Field " ^ i ^ " needed by " ^ s_type_path intf.cl_path ^ " is missing") p
) intf.cl_fields;
List.iter (fun (i2,p2) ->
- check_interface ctx c p i2 (List.map (apply_params intf.cl_types params) p2)
+ check_interface ctx c p i2 (List.map (fun (v,t) -> v, apply_params intf.cl_types params t) p2)
) intf.cl_implements
let check_interfaces ctx c p () =
@@ -1880,11 +1899,11 @@ let check_interfaces ctx c p () =
(* PASS 1 & 2 : Module and Class Structure *)
let init_class ctx c p herits fields =
- ctx.type_params <- c.cl_types;
+ ctx.type_params <- List.map (fun (_,n,t) -> n,t) c.cl_types;
c.cl_extern <- List.mem HExtern herits;
c.cl_interface <- List.mem HInterface herits;
set_heritance ctx c herits p;
- let tthis = TInst (c,List.map snd c.cl_types) in
+ let tthis = TInst (c,List.map (fun (v,_,t) -> v,t) c.cl_types) in
let is_public access =
if c.cl_extern || c.cl_interface then not (List.mem APrivate access) else List.mem APublic access
in
@@ -1942,9 +1961,11 @@ let init_class ctx c p herits fields =
) in
access, false, cf, delay
| FFun (name,doc,access,params,f) ->
- let params = List.map (fun (n,flags) ->
+ let params = List.map (fun (v,n,flags) ->
match flags with
- | [] -> type_type_params ctx c.cl_path p (n,[])
+ | [] ->
+ let _, n, t = type_type_params ctx c.cl_path p (v,n,[]) in
+ n, t
| _ -> error "This notation is not allowed because it can't be checked" p
) params in
let ctx = { ctx with
@@ -2100,31 +2121,31 @@ let type_module ctx m tdecls loadp =
List.iter (fun (d,p) ->
match d with
| EImport _ -> ()
- | EClass (name,doc,_,flags,_) ->
- let priv = List.mem HPrivate flags in
- let path = decl_with_name name p priv in
- let c = mk_class path p doc priv in
+ | EClass d ->
+ let priv = List.mem HPrivate d.d_flags in
+ let path = decl_with_name d.d_name p priv in
+ let c = mk_class path p d.d_doc priv in
decls := TClassDecl c :: !decls
- | EEnum (name,doc,_,flags,l) ->
- let priv = List.mem EPrivate flags in
- let path = decl_with_name name p priv in
+ | EEnum d ->
+ let priv = List.mem EPrivate d.d_flags in
+ let path = decl_with_name d.d_name p priv in
let e = {
e_path = path;
e_pos = p;
- e_doc = doc;
+ e_doc = d.d_doc;
e_types = [];
e_private = priv;
- e_extern = List.mem EExtern flags || l = [];
+ e_extern = List.mem EExtern d.d_flags || d.d_data = [];
e_constrs = PMap.empty;
} in
decls := TEnumDecl e :: !decls
- | ETypedef (name,doc,_,flags,_) ->
- let priv = List.mem EPrivate flags in
- let path = decl_with_name name p priv in
+ | ETypedef d ->
+ let priv = List.mem EPrivate d.d_flags in
+ let path = decl_with_name d.d_name p priv in
let t = {
t_path = path;
t_pos = p;
- t_doc = doc;
+ t_doc = d.d_doc;
t_private = priv;
t_types = [];
t_static = None;
@@ -2182,15 +2203,15 @@ let type_module ctx m tdecls loadp =
List.iter (fun (d,p) ->
match d with
| EImport _ -> ()
- | EClass (name,_,types,_,_) ->
- let c = get_class name in
- c.cl_types <- List.map (type_type_params ctx c.cl_path p) types;
- | EEnum (name,_,types,_,_) ->
- let e = get_enum name in
- e.e_types <- List.map (type_type_params ctx e.e_path p) types;
- | ETypedef (name,_,types,_,_) ->
- let t = get_tdef name in
- t.t_types <- List.map (type_type_params ctx t.t_path p) types;
+ | EClass d ->
+ let c = get_class d.d_name in
+ c.cl_types <- List.map (type_type_params ctx c.cl_path p) d.d_params;
+ | EEnum d ->
+ let e = get_enum d.d_name in
+ e.e_types <- List.map (type_type_params ctx e.e_path p) d.d_params;
+ | ETypedef d ->
+ let t = get_tdef d.d_name in
+ t.t_types <- List.map (type_type_params ctx t.t_path p) d.d_params;
) tdecls;
(* back to PASS2 *)
List.iter (fun (d,p) ->
@@ -2208,13 +2229,13 @@ let type_module ctx m tdecls loadp =
Not_found -> error ("Module " ^ s_type_path (pack,name) ^ " does not define type " ^ name) p
);
m.mimports <- (md,topt) :: m.mimports;
- | EClass (name,_,_,herits,fields) ->
- let c = get_class name in
- delays := !delays @ check_overriding ctx c p :: check_interfaces ctx c p :: init_class ctx c p herits fields
- | EEnum (name,_,_,_,constrs) ->
- let e = get_enum name in
- ctx.type_params <- e.e_types;
- let et = TEnum (e,List.map snd e.e_types) in
+ | EClass d ->
+ let c = get_class d.d_name in
+ delays := !delays @ check_overriding ctx c p :: check_interfaces ctx c p :: init_class ctx c p d.d_flags d.d_data
+ | EEnum d ->
+ let e = get_enum d.d_name in
+ ctx.type_params <- List.map (fun (_,n,t) -> n, t) e.e_types;
+ let et = TEnum (e,List.map (fun (v,_,t) -> v ,t) e.e_types) in
List.iter (fun (c,doc,t,p) ->
if c = "name" && Plugin.defined "js" then error "This identifier cannot be used in Javascript" p;
let t = (match t with
@@ -2222,11 +2243,11 @@ let type_module ctx m tdecls loadp =
| l -> TFun (List.map (fun (s,b,t) -> s, b, load_type ctx p t) l, et)
) in
e.e_constrs <- PMap.add c { ef_name = c; ef_type = t; ef_pos = p; ef_doc = doc } e.e_constrs
- ) constrs
- | ETypedef (name,_,_,_,tt) ->
- let t = get_tdef name in
- ctx.type_params <- t.t_types;
- let tt = load_type ctx p tt in
+ ) d.d_data
+ | ETypedef d ->
+ let t = get_tdef d.d_name in
+ ctx.type_params <- List.map (fun (_,n,t) -> n, t) t.t_types;
+ let tt = load_type ctx p d.d_data in
unify ctx t.t_type tt p;
) tdecls;
(* PASS 3 : type checking, delayed until all modules and types are built *)
@@ -2237,7 +2258,7 @@ let type_module ctx m tdecls loadp =
let rec f9path p = {
tpackage = (match p.tpackage with "flash" :: l -> "flash9" :: l | l -> l);
tname = p.tname;
- tparams = List.map f9t p.tparams;
+ tparams = List.map (fun (v,t) -> v, f9t t) p.tparams;
}
and f9t = function
@@ -2260,33 +2281,40 @@ let f9to = function
let f9decl (d,p) =
(match d with
- | EClass (name,doc,params,flags,fields) ->
- EClass (name,doc,params,List.map (function
- | HInterface
- | HExtern
- | HPrivate as f -> f
- | HExtends p -> HExtends (f9path p)
- | HImplements p -> HImplements (f9path p)
- ) flags,List.map (fun (f,p) ->
- (match f with
- | FVar (name,doc,acc,t,e) ->
- FVar (name,doc,acc,f9to t,e)
- | FFun (name,doc,acc,params,f) ->
- FFun (name,doc,acc,params,{
- f_args = List.map (fun (n,o,t) -> n , o, f9to t) f.f_args;
- f_type = f9to f.f_type;
- f_expr = f.f_expr;
- })
- | FProp (name,doc,acc,get,set,t) ->
- FProp (name,doc,acc,get,set,f9t t)
- ) , p
- ) fields)
- | EEnum (name,doc,params,flags,constrs) ->
- EEnum (name,doc,params,flags,List.map (fun (name,doc,args,p) ->
- name, doc, List.map (fun (name,p,t) -> name, p, f9t t) args, p
- ) constrs)
- | ETypedef (name,doc,params,flags,t) ->
- ETypedef (name,doc,params,flags,f9t t)
+ | EClass d ->
+ EClass {
+ d with
+ d_flags = List.map (function
+ | HInterface
+ | HExtern
+ | HPrivate as f -> f
+ | HExtends p -> HExtends (f9path p)
+ | HImplements p -> HImplements (f9path p)
+ ) d.d_flags;
+ d_data = List.map (fun (f,p) ->
+ (match f with
+ | FVar (name,doc,acc,t,e) ->
+ FVar (name,doc,acc,f9to t,e)
+ | FFun (name,doc,acc,params,f) ->
+ FFun (name,doc,acc,params,{
+ f_args = List.map (fun (n,o,t) -> n , o, f9to t) f.f_args;
+ f_type = f9to f.f_type;
+ f_expr = f.f_expr;
+ })
+ | FProp (name,doc,acc,get,set,t) ->
+ FProp (name,doc,acc,get,set,f9t t)
+ ) , p
+ ) d.d_data
+ }
+ | EEnum d ->
+ EEnum {
+ d with
+ d_data = List.map (fun (name,doc,args,p) ->
+ name, doc, List.map (fun (name,p,t) -> name, p, f9t t) args, p
+ ) d.d_data
+ }
+ | ETypedef d ->
+ ETypedef { d with d_data = f9t d.d_data }
| EImport ("flash" :: l,x,o) ->
EImport ("flash9" :: l,x,o)
| EImport _ ->
@@ -2467,7 +2495,7 @@ let types ctx main excludes =
Not_found -> error ("Invalid -main : " ^ s_type_path cl ^ " does not have static function main") null_pos
) in
let path = ([],"@Main") in
- let tmain = TInst (cmain,List.map snd cmain.cl_types) in
+ let tmain = TInst (cmain,List.map (fun (v,_,t) -> v,t) cmain.cl_types) in
let c = mk_class path null_pos None false in
let f = {
cf_name = "init";
Please sign in to comment.
Something went wrong with that request. Please try again.