浏览代码

add `s_tclass` to printer

Simon Krajewski 9 年之前
父节点
当前提交
082664704b
共有 1 个文件被更改,包括 42 次插入14 次删除
  1. 42 14
      type.ml

+ 42 - 14
type.ml

@@ -1213,6 +1213,10 @@ let s_class_kind = function
 		Printf.sprintf "KAbstractImpl %s" (s_type_path a.a_path)
 
 module Printer = struct
+
+	let s_type =
+		s_type (print_context())
+
 	let s_record_field name value =
 		Printf.sprintf "%s = %s;" name value
 
@@ -1223,21 +1227,24 @@ module Printer = struct
 	let s_list sep f l =
 		"[" ^ (String.concat sep (List.map f l)) ^ "]"
 
+	let s_metadata_entry (s,el,_) =
+		Printf.sprintf "@%s%s" (Meta.to_string s) (match el with [] -> "" | el -> String.concat ", " (List.map Ast.s_expr el))
+
+	let s_metadata metadata =
+		s_list " " s_metadata_entry metadata
+
+	let s_type_param (s,t) = match follow t with
+		| TInst({cl_kind = KTypeParameter tl1},tl2) ->
+			begin match tl1 with
+			| [] -> s
+			| _ -> Printf.sprintf "%s:%s" s (String.concat ", " (List.map s_type tl1))
+			end
+		| _ -> assert false
+
+	let s_type_params tl =
+		s_list ", " s_type_param tl
+
 	let s_tclass_field cf =
-		let s_type = s_type (print_context()) in
-		let s_meta_entry (s,el,_) =
-			Printf.sprintf "@%s%s" (Meta.to_string s) (match el with [] -> "" | el -> String.concat ", " (List.map Ast.s_expr el));
-		in
-		let s_metadata metadata = s_list " " s_meta_entry metadata in
-		let s_type_param (s,t) = match follow t with
-			| TInst({cl_kind = KTypeParameter tl1},tl2) ->
-				begin match tl1 with
-				| [] -> s
-				| _ -> Printf.sprintf "%s:%s" s (String.concat ", " (List.map s_type tl1))
-				end
-			| _ -> assert false
-		in
-		let s_type_params tl = s_list ", " s_type_param tl in
 		s_record_fields [
 			"cf_name",cf.cf_name;
 			"cf_type",s_type_kind (follow cf.cf_type);
@@ -1247,6 +1254,27 @@ module Printer = struct
 			"cf_params",s_type_params cf.cf_params;
 			"cf_expr",(match cf.cf_expr with None -> "None" | Some e-> s_expr_ast true "" s_type e);
 		]
+
+	let s_tclass c =
+		s_record_fields [
+			"cl_path",s_type_path c.cl_path;
+			"cl_module",s_type_path c.cl_module.m_path;
+			"cl_private",string_of_bool c.cl_private;
+			"cl_meta",s_metadata c.cl_meta;
+			"cl_params",s_type_params c.cl_params;
+			"cl_kind",s_class_kind c.cl_kind;
+			"cl_extern",string_of_bool c.cl_extern;
+			"cl_interface",string_of_bool c.cl_interface;
+			"cl_super",(match c.cl_super with None -> "None" | Some (c,tl) -> s_type (TInst(c,tl)));
+			"cl_implements",s_list ", " (fun (c,tl) -> s_type (TInst(c,tl))) c.cl_implements;
+			"cl_dynamic",(match c.cl_dynamic with None -> "None" | Some t -> s_type t);
+			"cl_array_access",(match c.cl_dynamic with None -> "None" | Some t -> s_type t);
+			"cl_overrides",s_list "," (fun cf -> cf.cf_name) c.cl_overrides;
+			"cl_init",(match c.cl_init with None -> "None" | Some e -> s_expr_ast true "" s_type e);
+			"cl_constructor",(match c.cl_constructor with None -> "None" | Some cf -> s_tclass_field cf);
+			"cl_ordered_fields",s_list "\n" s_tclass_field c.cl_ordered_fields;
+			"cl_ordered_statics",s_list "\n" s_tclass_field c.cl_ordered_statics;
+		]
 end
 
 (* ======= Unification ======= *)