Browse Source

added @classes generation.

Nicolas Cannasse 19 years ago
parent
commit
1d112a83fc
1 changed files with 22 additions and 7 deletions
  1. 22 7
      genneko.ml

+ 22 - 7
genneko.ml

@@ -436,7 +436,12 @@ let gen_class ctx c =
 		clpath,
 		(EObject (PMap.fold (gen_method ctx p) c.cl_fields fstring),p)
 	),p) in
-	(EBlock [eclass; estat; call p (builtin p "objsetproto") [clpath; esuper]; (EBinop ("=",field p clpath "__class__",stpath),p)],p)	
+	let emeta = (EBinop ("=",field p clpath "__class__",stpath),p) ::
+		match c.cl_path with
+		| [] , name -> [(EBinop ("=",field p (ident p "@classes") name,ident p name),p)]
+		| _ -> []
+	in
+	(EBlock ([eclass; estat; call p (builtin p "objsetproto") [clpath; esuper]] @ emeta),p)	
 
 let gen_enum_constr path c =
 	let p = pos c.ef_pos in
@@ -464,7 +469,10 @@ let gen_enum e =
 	let path = gen_type_path p e.e_path in
 	(EBlock (
 		(EBinop ("=",path, call p (builtin p "new") [null p]),p) ::		
-		pmap_list (gen_enum_constr path) e.e_constrs
+		pmap_list (gen_enum_constr path) e.e_constrs @
+		match e.e_path with
+		| [] , name -> [EBinop ("=",field p (ident p "@classes") name,ident p name),p]
+		| _ -> []
 	),p)
 
 let gen_type ctx t =
@@ -504,7 +512,7 @@ let gen_static_vars ctx t =
 						),p) :: acc
 			) c.cl_ordered_statics []
 
-let gen_packages h t =
+let gen_package h t =
 	let rec loop acc p =
 		match p with
 		| [] -> []
@@ -512,9 +520,14 @@ let gen_packages h t =
 			let path = acc @ [x] in
 			if not (Hashtbl.mem h path) then begin
 				let p = pos (match t with TClassDecl c -> c.cl_pos | TEnumDecl e -> e.e_pos) in
-				let e = (EBinop ("=",gen_type_path p (acc,x),call p (builtin p "new") [null p]),p) in
+				let e = (EBinop ("=",gen_type_path p (acc,x),call p (builtin p "new") [null p]),p) in				
 				Hashtbl.add h path ();
-				e :: loop path l
+				(match acc with
+				| [] ->
+					let reg = (EBinop ("=",field p (ident p "@classes") x,ident p x),p) in
+					e :: reg :: loop path l
+				| _ ->
+					e :: loop path l)
 			end else
 				loop path l
 	in
@@ -526,6 +539,7 @@ let gen_boot hres =
 	(EBlock [
 		call null_pos (field null_pos (gen_type_path null_pos (["neko"],"Boot")) "__init") [];
 		EBinop ("=",field null_pos (gen_type_path null_pos (["neko"],"Boot")) "__res",objres),null_pos;
+		EBinop ("=",field null_pos (gen_type_path null_pos (["neko"],"Boot")) "__classes",ident null_pos "@classes"),null_pos;
 	],null_pos)
 
 let gen_name acc t =
@@ -550,19 +564,20 @@ let generate file types hres =
 		locals = PMap.empty;
 	} in
 	let h = Hashtbl.create 0 in
+	let classes = (EBinop ("=",ident null_pos "@classes", call null_pos (builtin null_pos "new") [null null_pos]),null_pos) in
 	let enum_str = (EBinop ("=",ident null_pos "@enum_to_string",(EFunction ([],
 		call null_pos (field null_pos (gen_type_path null_pos (["neko"],"Boot")) "__enum_str") [this null_pos]
 	),null_pos)),null_pos) in
 	let class_str = (EBinop ("=",ident null_pos "@class_to_string",(EFunction ([],
 		field null_pos (call null_pos (field null_pos (field null_pos (this null_pos) "__name__") "join") [gen_constant null_pos (TString ".")]) "__s"
 	),null_pos)),null_pos) in
-	let packs = List.concat (List.map (gen_packages h) types) in
+	let packs = List.concat (List.map (gen_package h) types) in
 	let names = List.fold_left gen_name [] types in
 	let methods = List.map (gen_type ctx) types in
 	let boot = gen_boot hres in
 	let inits = List.map (gen_expr ctx) (List.rev ctx.inits) in
 	let vars = List.concat (List.map (gen_static_vars ctx) types) in
-	let e = (EBlock (enum_str :: class_str :: packs @ methods @ boot :: names @ inits @ vars), null_pos) in
+	let e = (EBlock (classes :: enum_str :: class_str :: packs @ methods @ boot :: names @ inits @ vars), null_pos) in
 	let neko_file = Filename.chop_extension file ^ ".neko" in
 	let ch = IO.output_channel (open_out neko_file) in
 	(if !Plugin.verbose then Nxml.write_fmt else Nxml.write) ch (Nxml.to_xml e);