Explorar o código

[debug] port dump_with_pos to texpr

Simon Krajewski %!s(int64=6) %!d(string=hai) anos
pai
achega
fcd8daac7e
Modificáronse 2 ficheiros con 117 adicións e 3 borrados
  1. 112 1
      src/core/texpr.ml
  2. 5 2
      src/typing/typeloadFunction.ml

+ 112 - 1
src/core/texpr.ml

@@ -388,4 +388,115 @@ let build_metadata api t =
 		let meta_obj = (if fields = [] then meta_obj else (("fields",null_pos,NoQuotes),make_meta fields) :: meta_obj) in
 		let meta_obj = (if fields = [] then meta_obj else (("fields",null_pos,NoQuotes),make_meta fields) :: meta_obj) in
 		let meta_obj = (if statics = [] then meta_obj else (("statics",null_pos,NoQuotes),make_meta statics) :: meta_obj) in
 		let meta_obj = (if statics = [] then meta_obj else (("statics",null_pos,NoQuotes),make_meta statics) :: meta_obj) in
 		let meta_obj = (try (("obj",null_pos,NoQuotes), make_meta_field (List.assoc "" meta)) :: meta_obj with Not_found -> meta_obj) in
 		let meta_obj = (try (("obj",null_pos,NoQuotes), make_meta_field (List.assoc "" meta)) :: meta_obj with Not_found -> meta_obj) in
-		Some (mk (TObjectDecl meta_obj) t_dynamic p)
+		Some (mk (TObjectDecl meta_obj) t_dynamic p)
+
+let dump_with_pos tabs e =
+	let buf = Buffer.create 0 in
+	let add = Buffer.add_string buf in
+	let rec loop' tabs e =
+		let p = e.epos in
+		let add s = add (Printf.sprintf "%4i-%4i %s%s\n" p.pmin p.pmax tabs s) in
+		let loop e = loop' (tabs ^ "  ") e in
+		match e.eexpr with
+		| TConst ct -> add (s_const ct)
+		| TLocal v -> add ("TLocal " ^ v.v_name)
+		| TTypeExpr mt -> add ("TTypeExpr " ^ (s_type_path (t_infos mt).mt_path))
+		| TIdent s -> add ("TIdent " ^ s)
+		| TEnumParameter(e1,ef,_) ->
+			add ("TEnumParameter " ^ ef.ef_name);
+			loop e1
+		| TEnumIndex e1 ->
+			add "TEnumIndex";
+			loop e1
+		| TArray(e1,e2) ->
+			add "TArray";
+			loop e1;
+			loop e2;
+		| TBinop(op,e1,e2) ->
+			add ("TBinop " ^ (s_binop op));
+			loop e1;
+			loop e2;
+		| TField(e1,s) ->
+			add ("TField " ^ (field_name s));
+			loop e1
+		| TParenthesis e1 ->
+			add "TParenthesis";
+			loop e1
+		| TObjectDecl fl ->
+			add "TObjectDecl";
+			List.iter (fun ((n,p,_),e1) ->
+				Buffer.add_string buf (Printf.sprintf "%4i-%4i %s%s\n" p.pmin p.pmax tabs n);
+				loop e1
+			) fl;
+		| TArrayDecl el ->
+			add "TArrayDecl";
+			List.iter loop el
+		| TCall(e1,el) ->
+			add "TCall";
+			loop e1;
+			List.iter loop el
+		| TNew(c,_,el) ->
+			add ("TNew " ^ s_type_path c.cl_path);
+			List.iter loop el
+		| TUnop(op,_,e1) ->
+			add ("TUnop " ^ (s_unop op));
+			loop e1
+		| TVar(v,eo) ->
+			add ("TVar " ^ v.v_name);
+			begin match eo with
+				| None -> ()
+				| Some e ->
+					loop' (Printf.sprintf "%s  " tabs) e
+			end
+		| TFunction tf ->
+			add "TFunction";
+			loop tf.tf_expr;
+		| TBlock el ->
+			add "TBlock";
+			List.iter loop el
+		| TFor(v,e1,e2) ->
+			add ("TFor " ^ v.v_name);
+			loop e1;
+			loop e2;
+		| TIf(e1,e2,eo) ->
+			add "TIf";
+			loop e1;
+			loop e2;
+			Option.may loop eo;
+		| TWhile(e1,e2,_) ->
+			add "TWhile";
+			loop e1;
+			loop e2;
+		| TSwitch(e1,cases,def) ->
+			add "TSwitch";
+			loop e1;
+			List.iter (fun (el,e) ->
+				List.iter (loop' (tabs ^ "    ")) el;
+				loop' (tabs ^ "      ") e;
+			) cases;
+			Option.may (loop' (tabs ^ "      ")) def
+		| TTry(e1,catches) ->
+			add "TTry";
+			loop e1;
+			List.iter (fun (v,e) ->
+				loop' (tabs ^ "    ") e
+			) catches
+		| TReturn eo ->
+			add "TReturn";
+			Option.may loop eo;
+		| TBreak ->
+			add "TBreak";
+		| TContinue ->
+			add "TContinue"
+		| TThrow e1 ->
+			add "EThrow";
+			loop e1
+		| TCast(e1,_) ->
+			add "TCast";
+			loop e1;
+		| TMeta((m,_,_),e1) ->
+			add ("TMeta " ^ fst (Meta.get_info m));
+			loop e1
+	in
+	loop' tabs e;
+	Buffer.contents buf

+ 5 - 2
src/typing/typeloadFunction.ml

@@ -111,9 +111,11 @@ let type_function ctx args ret fmode f do_display p =
 				error "Function body required" p
 				error "Function body required" p
 		| Some e -> e
 		| Some e -> e
 	in
 	in
-	let e = if not do_display then
+	let is_position_debug = Meta.has (Meta.Custom ":debug.position") ctx.curfield.cf_meta in
+	let e = if not do_display then begin
+		if is_position_debug then print_endline ("syntax:\n" ^ (Expr.dump_with_pos e));
 		type_expr ctx e NoValue
 		type_expr ctx e NoValue
-	else begin
+	end else begin
 		let is_display_debug = Meta.has (Meta.Custom ":debug.display") ctx.curfield.cf_meta in
 		let is_display_debug = Meta.has (Meta.Custom ":debug.display") ctx.curfield.cf_meta in
 		if is_display_debug then print_endline ("before processing:\n" ^ (Expr.dump_with_pos e));
 		if is_display_debug then print_endline ("before processing:\n" ^ (Expr.dump_with_pos e));
 		let e = if !Parser.had_resume then e else Display.ExprPreprocessing.process_expr ctx.com e in
 		let e = if !Parser.had_resume then e else Display.ExprPreprocessing.process_expr ctx.com e in
@@ -198,6 +200,7 @@ let type_function ctx args ret fmode f do_display p =
 		| _ -> e
 		| _ -> e
 	in
 	in
 	List.iter (fun r -> r := Closed) ctx.opened;
 	List.iter (fun r -> r := Closed) ctx.opened;
+	if is_position_debug then print_endline ("typing:\n" ^ (Texpr.dump_with_pos "" e));
 	e , fargs
 	e , fargs
 
 
 let type_function ctx args ret fmode f do_display p =
 let type_function ctx args ret fmode f do_display p =