Przeglądaj źródła

added -D no-tre

Aleksandr Kuzmenko 5 lat temu
rodzic
commit
1c31a59125
2 zmienionych plików z 30 dodań i 20 usunięć
  1. 5 0
      src-json/define.json
  2. 25 20
      src/filters/tre.ml

+ 5 - 0
src-json/define.json

@@ -664,5 +664,10 @@
 		"name": "WarnVarShadowing",
 		"define": "warn_var_shadowing",
 		"doc": "Warn about shadowing variable declarations."
+	},
+	{
+		"name": "NoTre",
+		"define": "no_tre",
+		"doc": "Disable tail recursion elimination."
 	}
 ]

+ 25 - 20
src/filters/tre.ml

@@ -200,23 +200,28 @@ let rec has_tail_recursion is_recursive_call cancel_tre function_end e =
 	| _ ->
 		check_expr (has_tail_recursion is_recursive_call cancel_tre function_end) e
 
-let run ctx e =
-	match e.eexpr with
-	| TFunction fn ->
-		let is_tre_eligible =
-			match ctx.curfield.cf_kind with
-			| Method MethDynamic -> false
-			| Method MethInline -> true
-			| Method _ when ctx.curfun = FunStatic -> true
-			| _ -> has_class_field_flag ctx.curfield CfFinal
-			in
-		let is_recursive_call callee args =
-			is_tre_eligible && is_recursive_method_call ctx.curclass ctx.curfield callee args
-		in
-		if has_tail_recursion is_recursive_call false true fn.tf_expr then
-			(* print_endline ("TRE: " ^ ctx.curfield.cf_pos.pfile ^ ": " ^ ctx.curfield.cf_name); *)
-			let fn = transform_function ctx is_recursive_call fn in
-			{ e with eexpr = TFunction fn }
-		else
-			e
-	| _ -> e
+let run ctx =
+	if Common.defined ctx.com Define.NoTre then
+		(fun e -> e)
+	else
+		(fun e ->
+			match e.eexpr with
+			| TFunction fn ->
+				let is_tre_eligible =
+					match ctx.curfield.cf_kind with
+					| Method MethDynamic -> false
+					| Method MethInline -> true
+					| Method _ when ctx.curfun = FunStatic -> true
+					| _ -> has_class_field_flag ctx.curfield CfFinal
+					in
+				let is_recursive_call callee args =
+					is_tre_eligible && is_recursive_method_call ctx.curclass ctx.curfield callee args
+				in
+				if has_tail_recursion is_recursive_call false true fn.tf_expr then
+					(* print_endline ("TRE: " ^ ctx.curfield.cf_pos.pfile ^ ": " ^ ctx.curfield.cf_name); *)
+					let fn = transform_function ctx is_recursive_call fn in
+					{ e with eexpr = TFunction fn }
+				else
+					e
+			| _ -> e
+		)