added documentation

ast.ml

@@ -170,14 +170,16 @@ and expr_def =
 
 and expr = expr_def * pos
 
+type documentation = string option
+
 type access =
 	| APublic
 	| APrivate
 	| AStatic
 
 type class_field =
-	| FVar of string * access list * type_path option * expr option
-	| FFun of string * access list * func
+	| FVar of string * documentation * access list * type_path option * expr option
+	| FFun of string * documentation * access list * func
 
 type type_param_flag =
 	| HInterface
@@ -188,8 +190,8 @@ type type_param_flag =
 type type_param = string * type_path_normal list
 
 type type_def =
-	| EClass of string * type_param list * type_param_flag list * (class_field * pos) list
-	| EEnum of string * type_param list * (string * (string * type_path) list * pos) list
+	| EClass of string * documentation * type_param list * type_param_flag list * (class_field * pos) list
+	| EEnum of string * documentation * type_param list * (string * documentation * (string * type_path) list * pos) list
 	| EImport of (string list * string)
 
 type type_decl = type_def * pos

genxml.ml

@@ -34,6 +34,13 @@ let pmap f m =
 let gen_path (p,n) =
 	("path",String.concat "." (p @ [n]))
 
+let gen_doc s = node "doc" [] [pcdata s]
+
+let gen_doc_opt d =
+	match d with 
+	| None -> []
+	| Some s -> [gen_doc s]
+
 let rec gen_type t =
 	match t with
 	| TMono m -> (match !m with None -> tag "unknown" | Some t -> gen_type t)
@@ -44,11 +51,12 @@ let rec gen_type t =
 	| TDynamic t2 -> node "d" [] (if t == t2 then [] else [gen_type t2])
 
 let gen_constr e =
-	node e.ef_name [] (match follow e.ef_type with TFun (args,_) -> List.map gen_type args | _ -> [])
+	let doc = gen_doc_opt e.ef_doc in
+	node e.ef_name [] (match follow e.ef_type with TFun (args,_) -> List.map gen_type args @ doc | _ -> doc)
 
 let gen_field att f =
 	let att = (match f.cf_expr with None -> att | Some e -> ("line",string_of_int (Lexer.get_error_line e.epos)) :: att) in
-	node f.cf_name (if f.cf_public then ("public","1") :: att else att) [gen_type f.cf_type]
+	node f.cf_name (if f.cf_public then ("public","1") :: att else att) (gen_type f.cf_type :: gen_doc_opt f.cf_doc)
 
 let gen_type t =
 	match t with
@@ -56,9 +64,11 @@ let gen_type t =
 		let stats = pmap (gen_field ["static","1"]) c.cl_statics in
 		let fields = pmap (gen_field []) c.cl_fields in
 		let constr = (match c.cl_constructor with None -> [] | Some f -> [gen_field [] f]) in
-		node "class" [gen_path c.cl_path;("file",c.cl_pos.pfile)] (stats @ fields @ constr)
+		let doc = gen_doc_opt c.cl_doc in
+		node "class" [gen_path c.cl_path;("file",c.cl_pos.pfile)] (stats @ fields @ constr @ doc)
 	| TEnumDecl e ->
-		node "enum" [gen_path e.e_path;("file",e.e_pos.pfile)] (pmap gen_constr e.e_constrs)
+		let doc = gen_doc_opt e.e_doc in
+		node "enum" [gen_path e.e_path;("file",e.e_pos.pfile)] (pmap gen_constr e.e_constrs @ doc)
 
 let att_str att = 
 	String.concat "" (List.map (fun (a,v) -> Printf.sprintf " %s=\"%s\"" a v) att)

parser.ml

@@ -37,6 +37,7 @@ let error_msg = function
 let error m p = raise (Error (m,p))
 
 let cache = ref (DynArray.create())
+let doc = ref None
 
 let last_token s =
 	let n = Stream.count s in
@@ -112,6 +113,8 @@ let ident = parser
 let log m s =
 	prerr_endline m
 
+let get_doc s = !doc
+
 let comma = parser
 	| [< '(Comma,_) >] -> ()
 
@@ -129,10 +132,12 @@ let rec	parse_file = parser
 	| [< '(Const (Ident "package"),_); p = parse_package; _ = semicolon; l = plist parse_type_decl; '(Eof,_); >] -> p , l
 	| [< l = plist parse_type_decl; '(Eof,_) >] -> [] , l
 
-and parse_type_decl = parser
+and parse_type_decl s =
+	doc := None;
+	match s with parser
 	| [< '(Kwd Import,p1); t = parse_type_path_normal; _ = semicolon >] -> (EImport (t.tpackage,t.tname), p1)
-	| [< '(Kwd Enum,p1); '(Const (Type name),_);  tl = parse_type_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] -> (EEnum (name,tl,l), punion p1 p2)
-	| [< n , p1 = parse_class_native; '(Const (Type name),_); tl = parse_type_params; hl = psep Comma parse_class_herit; '(BrOpen,_); fl = plist parse_class_field; '(BrClose,p2) >] -> (EClass (name,tl,n @ hl,fl), punion p1 p2)
+	| [< '(Kwd Enum,p1); doc = get_doc; '(Const (Type name),_); tl = parse_type_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] -> (EEnum (name,doc,tl,l), punion p1 p2)
+	| [< n , p1 = parse_class_native; 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,n @ hl,fl), punion p1 p2)
 
 and parse_package s = psep Dot ident s
 
@@ -177,18 +182,22 @@ and parse_type_path_next t = parser
 and parse_type_anonymous = parser
 	| [< '(Const (Ident name),_); '(DblDot,_); t = parse_type_path >] -> (name,t)
 
-and parse_enum = parser
-	| [< '(Const (Ident name),p); s >] ->
+and parse_enum s = 
+	doc := None;
+	match s with parser
+	| [< '(Const (Ident name),p); doc = get_doc; s >] ->
 		match s with parser
-		| [< '(POpen,_); l = psep Comma parse_enum_param; '(PClose,_); _ = semicolon; >] -> (name,l,p)
-		| [< '(Semicolon,_) >] -> (name,[],p)
+		| [< '(POpen,_); l = psep Comma parse_enum_param; '(PClose,_); _ = semicolon; >] -> (name,doc,l,p)
+		| [< '(Semicolon,_) >] -> (name,doc,[],p)
 		| [< >] -> serror()
 
 and parse_enum_param = parser
 	| [< '(Const (Ident name),_); '(DblDot,_); t = parse_type_path >] -> (name,t)
 
-and parse_class_field = parser
-	| [< l = parse_cf_rights []; s >] ->
+and parse_class_field s =
+	doc := None;
+	match s with parser
+	| [< l = parse_cf_rights []; doc = get_doc; s >] ->
 		match s with parser
 		| [< '(Kwd Var,p1); '(Const (Ident name),_); t = parse_type_opt; s >] ->			
 			let e , p2 = (match s with parser
@@ -196,7 +205,7 @@ and parse_class_field = parser
 			| [< '(Semicolon,p2) >] -> None , p2
 			| [< >] -> serror()
 			) in
-			(FVar (name,l,t,e),punion p1 p2)
+			(FVar (name,doc,l,t,e),punion p1 p2)
 		| [< '(Kwd Function,p1); name = parse_fun_name; '(POpen,_); al = psep Comma parse_fun_param; '(PClose,_); t = parse_type_opt; s >] ->			
 			let e = (match s with parser
 				| [< e = expr >] -> e
@@ -208,7 +217,7 @@ and parse_class_field = parser
 				f_type = t;
 				f_expr = e;
 			} in
-			(FFun (name,l,f),punion p1 (pos e))
+			(FFun (name,doc,l,f),punion p1 (pos e))
 		| [< >] -> if l = [] then raise Stream.Failure else serror()
 
 and parse_cf_rights l = parser
@@ -350,11 +359,16 @@ let parse code file =
 	let old_cache = !cache in
 	let mstack = ref [] in
 	cache := DynArray.create();
+	doc := None;
 	Lexer.init file;	
 	let rec next_token() =
 		let tk = Lexer.token code in
-		match fst tk with 
-		| Comment s | CommentLine s -> 
+		match fst tk with
+		| Comment s ->
+			let l = String.length s in
+			if l > 2 && s.[0] = '*' && s.[l-1] = '*' then doc := Some (String.sub s 1 (l-2));
+			next_token()
+		| CommentLine s -> 
 			next_token()
 		| Macro "end" ->
 			(match !mstack with

type.ml

@@ -81,12 +81,14 @@ and tclass_field = {
 	cf_name : string;
 	cf_type : t;
 	cf_public : bool;
+	cf_doc : Ast.documentation;
 	mutable cf_expr : texpr option;
 }
 
 and tclass = {
 	cl_path : module_path;
 	cl_pos : Ast.pos;
+	cl_doc : Ast.documentation;
 	mutable cl_extern : bool;
 	mutable cl_interface : bool;
 	mutable cl_types : (string * t) list;
@@ -102,17 +104,19 @@ and tenum_field = {
 	ef_name : string;
 	ef_type : t;
 	ef_pos : Ast.pos;
+	ef_doc : Ast.documentation;
 }
 
 and tenum = {
 	e_path : module_path;
 	e_pos : Ast.pos;
+	e_doc : Ast.documentation;
 	mutable e_types : (string * t) list;
 	mutable e_constrs : (string , tenum_field) PMap.t;
 }
 
 and module_type = 
-	| TClassDecl of tclass 
+	| TClassDecl of tclass
 	| TEnumDecl of tenum
 
 type module_def = {
@@ -126,10 +130,11 @@ let mk_mono() = TMono (ref None)
 
 let rec t_dynamic = TDynamic t_dynamic
 
-let mk_class path pos =
+let mk_class path pos doc =
 	{
 		cl_path = path;
 		cl_pos = pos;
+		cl_doc = doc;
 		cl_extern = false;
 		cl_interface = false;
 		cl_types = [];

typer.ml

@@ -143,6 +143,7 @@ and load_type ctx p t =
 				cf_type = t;
 				cf_public = true;
 				cf_expr = None;
+				cf_doc = None;
 			} acc
 		in
 		TAnon (List.fold_left loop PMap.empty l)
@@ -193,11 +194,12 @@ let type_type_params ctx path p (n,flags) =
 			e_pos = p;
 			e_types = [];
 			e_constrs = PMap.empty;
+			e_doc = None;
 		} in
 		TEnum (e,[])
 	| l ->
 		(* build a phantom class *)
-		let c = mk_class (fst path @ [snd path],n) p in
+		let c = mk_class (fst path @ [snd path],n) p None in
 		set_heritance ctx c (List.map (fun t -> HImplements t) l) p;
 		let add_field ctypes params _ f =
 			let f = { f with cf_type = apply_params ctypes params f.cf_type } in
@@ -340,7 +342,7 @@ let type_type ctx tpath p =
 		) in
 		mk (TType (TClassDecl c)) (TAnon fl) p
 	| TEnumDecl e ->
-		let fl = PMap.map (fun e -> { cf_name = e.ef_name; cf_public = true; cf_type = e.ef_type; cf_expr = None }) e.e_constrs in 
+		let fl = PMap.map (fun e -> { cf_name = e.ef_name; cf_public = true; cf_type = e.ef_type; cf_expr = None; cf_doc = None }) e.e_constrs in 
 		mk (TType (TEnumDecl e)) (TAnon fl) p
 
 let type_constant ctx c p =
@@ -654,6 +656,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				cf_type = e.etype;
 				cf_public = false;
 				cf_expr = None;
+				cf_doc = None;
 			} in
 			((f,e) :: l, PMap.add f cf acc)
 		in
@@ -977,7 +980,7 @@ let init_class ctx c p types herits fields =
 	in
 	let loop_cf f p =
 		match f with
-		| FVar (name,access,t,e) ->
+		| FVar (name,doc,access,t,e) ->
 			let t = (match t with
 				| None -> 
 					if not (List.mem AStatic access) then error ("Type required for member variable " ^ name) p;
@@ -986,6 +989,7 @@ let init_class ctx c p types herits fields =
 			) in
 			let cf = {
 				cf_name = name;
+				cf_doc = doc;
 				cf_type = t;
 				cf_expr = None;
 				cf_public = is_public access;
@@ -998,7 +1002,7 @@ let init_class ctx c p types herits fields =
 				)
 			) in
 			List.mem AStatic access, false, cf, delay
-		| FFun (name,access,f) ->
+		| FFun (name,doc,access,f) ->
 			let r = type_opt p f.f_type in
 			let args = List.map (fun (name,t) -> name , type_opt p t) f.f_args in
 			let t = TFun (List.map snd args,r) in
@@ -1006,6 +1010,7 @@ let init_class ctx c p types herits fields =
 			let constr = (name = "new") in
 			let cf = {
 				cf_name = name;
+				cf_doc = doc;
 				cf_type = t;
 				cf_expr = None;
 				cf_public = is_public access;
@@ -1055,6 +1060,7 @@ let init_class ctx c p types herits fields =
 			c.cl_constructor <- Some {
 				cf_name = "new";
 				cf_type = t;
+				cf_doc = None;
 				cf_expr = Some (mk (TFunction func) t p);
 				cf_public = f.cf_public;
 			}
@@ -1079,15 +1085,16 @@ let type_module ctx m tdecls =
 	List.iter (fun (d,p) ->
 		match d with
 		| EImport _ -> ()
-		| EClass (name,_,_,_) ->
+		| EClass (name,doc,_,_,_) ->
 			let path = decl_with_name name p in
-			let c = mk_class path p in
+			let c = mk_class path p doc in
 			decls := TClassDecl c :: !decls
-		| EEnum (name,_,_) ->
+		| EEnum (name,doc,_,_) ->
 			let path = decl_with_name name p in
 			let e = {
 				e_path = path;
 				e_pos = p;
+				e_doc = doc;
 				e_types = [];
 				e_constrs = PMap.empty;
 			} in
@@ -1123,23 +1130,23 @@ let type_module ctx m tdecls =
 		| EImport t ->
 			let m = load ctx t p in
 			ctx.local_types <- ctx.local_types @ m.mtypes
-		| EClass (name,types,herits,fields) ->
+		| EClass (name,_,types,herits,fields) ->
 			let c = List.find (fun d -> match d with TClassDecl { cl_path = _ , n } -> n = name | _ -> false) m.mtypes in
 			let c = (match c with TClassDecl c -> c | _ -> assert false) in
 			delays := !delays @ check_overloading c p :: check_interfaces c p :: init_class ctx c p types herits fields
-		| EEnum (name,types,constrs) ->
+		| EEnum (name,_,types,constrs) ->
 			let e = List.find (fun d -> match d with TEnumDecl { e_path = _ , n } -> n = name | _ -> false) m.mtypes in
 			let e = (match e with TEnumDecl e -> e | _ -> assert false) in
 			ctx.type_params <- [];
 			e.e_types <- List.map (type_type_params ctx e.e_path p) types;
 			ctx.type_params <- e.e_types;
 			let et = TEnum (e,List.map snd e.e_types) in
-			List.iter (fun (c,t,p) ->
+			List.iter (fun (c,doc,t,p) ->
 				let t = (match t with 
 					| [] -> et
 					| l -> TFun (List.map (fun (_,t) -> load_type ctx p t) l, et)
 				) in
-				e.e_constrs <- PMap.add c { ef_name = c; ef_type = t; ef_pos = p } e.e_constrs
+				e.e_constrs <- PMap.add c { ef_name = c; ef_type = t; ef_pos = p; ef_doc = doc } e.e_constrs
 			) constrs
 	) tdecls;
 	(* PASS 3 : type checking, delayed until all modules and types are built *)
@@ -1185,7 +1192,7 @@ let context warn =
 		local_types = [];
 		type_params = [];
 		curmethod = "";
-		curclass = mk_class ([],"") null_pos;
+		curclass = mk_class ([],"") null_pos None;
 		current = empty;
 		std = empty;
 	} in
@@ -1310,11 +1317,12 @@ let types ctx main =
 				Not_found -> error ("Invalid -main : " ^ s_type_path cl ^ " does not have static function main") null_pos
 		);
 		let path = ([],"@Main") in
-		let c = mk_class path null_pos in
+		let c = mk_class path null_pos None in
 		c.cl_statics <- PMap.add "init" {
 			cf_name = "init";
 			cf_type = mk_mono();
 			cf_public = false;
+			cf_doc = None;
 			cf_expr = Some (mk (TCall (mk (TField (mk (TType t) (mk_mono()) null_pos,"main")) (mk_mono()) null_pos,[])) (mk_mono()) null_pos);
 		} c.cl_statics;
 		types := TClassDecl c :: !types