Permalink
Browse files

added variance.

git-svn-id: http://haxe.googlecode.com/svn/trunk@1432 f16182fa-f095-11de-8f43-4547254af6c6
  • Loading branch information...
ncannasse
ncannasse committed Sep 6, 2006
1 parent f5fed79 commit bbcdb812a7e15c937559fa2e6646964bd7899970
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
@@ -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
@@ -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
@@ -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 {
+}
Oops, something went wrong.

0 comments on commit bbcdb81

Please sign in to comment.