v0.17~preview.128.47+23

src/printf.ml

@@ -3,5 +3,10 @@ include Stdlib.Printf
 
 (** failwith, invalid_arg, and exit accepting printf's format. *)
 
-let[@inline never] failwithf fmt = ksprintf (fun s () -> failwith s) fmt
-let[@inline never] invalid_argf fmt = ksprintf (fun s () -> invalid_arg s) fmt
+let[@inline never] [@zero_alloc assume never_returns_normally] failwithf fmt =
+  ksprintf (fun s () -> failwith s) fmt
+;;
+
+let[@inline never] [@zero_alloc assume never_returns_normally] invalid_argf fmt =
+  ksprintf (fun s () -> invalid_arg s) fmt
+;;

src/printf.mli

@@ -128,8 +128,12 @@ val kbprintf
     in a useful way) so they serve as an effective signpost for
     "end of formatting arguments". *)
 
-(** Raises [Failure]. *)
+(** Raises [Failure].
+
+    *)
 val failwithf : ('r, unit, string, unit -> _) format4 -> 'r
 
-(** Raises [Invalid_arg]. *)
+(** Raises [Invalid_arg].
+
+    *)
 val invalid_argf : ('r, unit, string, unit -> _) format4 -> 'r

src/sequence.ml

@@ -162,17 +162,13 @@ let fold t ~init ~f =
 let to_list_rev t = fold t ~init:[] ~f:(fun l x -> x :: l)
 
 let to_list (Sequence { state = s; next }) =
-  let safe_to_list t = List.rev (to_list_rev t) in
-  let rec to_list s next i =
-    if i = 0
-    then safe_to_list (Sequence { state = s; next })
-    else (
-      match next s with
-      | Done -> []
-      | Skip { state = s } -> to_list s next i
-      | Yield { value = a; state = s } -> a :: to_list s next (i - 1))
+  let[@tail_mod_cons] rec to_list s next =
+    match next s with
+    | Done -> []
+    | Skip { state = s } -> (to_list [@tailcall]) s next
+    | Yield { value = a; state = s } -> a :: (to_list [@tailcall]) s next
   in
-  to_list s next 500
+  to_list s next
 ;;
 
 let sexp_of_t sexp_of_a t = sexp_of_list sexp_of_a (to_list t)

test/allocation/test_zero_alloc.ml

@@ -0,0 +1,22 @@
+[@@@zero_alloc check]
+
+let[@zero_alloc] foo x = Base.Printf.failwithf "%d" x ()
+let[@zero_alloc] bar x y = Base.Printf.invalid_argf "%d" (x + y) ()
+
+let%expect_test "foo" =
+  let x = Sys.opaque_identity 5 in
+  (try foo x with
+   | Failure s ->
+     print_string s;
+     print_newline ());
+  [%expect {| 5 |}]
+;;
+
+let%expect_test "bar" =
+  let x = Sys.opaque_identity 5 in
+  (try bar x x with
+   | Invalid_argument s ->
+     print_string s;
+     print_newline ());
+  [%expect {| 10 |}]
+;;

test/allocation/test_zero_alloc.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)