diff --git a/R/generator.R b/R/generator.R index 1d2ac24..3932eb0 100644 --- a/R/generator.R +++ b/R/generator.R @@ -29,16 +29,18 @@ #' @export #' @examples #' # A generator statement creates a generator factory. The -#' # following generator yields two times and then returns `"c"`: +#' # following generator yields three times and then returns `"d"`. +#' # Only the yielded values are visible to the callers. #' generate_abc <- generator(function() { #' yield("a") #' yield("b") -#' "c" +#' yield("c") +#' "d" #' }) #' -#' # Or equivalently: +#' # Equivalently: #' generate_abc <- generator(function() { -#' for (x in letters[1:3]) { +#' for (x in c("a", "b", "c")) { #' yield(x) #' } #' }) @@ -103,6 +105,7 @@ generator <- function(fn) { assert_lambda(substitute(fn)) generator0(fn) } + #' @rdname generator #' @param expr A yielding expression. #' @export @@ -110,6 +113,7 @@ gen <- function(expr) { fn <- new_function(NULL, substitute(expr), caller_env()) generator0(fn)() } + generator0 <- function(fn, type = "generator") { state_machine <- NULL fmls <- formals(fn) diff --git a/R/parser.R b/R/parser.R index 9f55ac6..8fbe4cf 100644 --- a/R/parser.R +++ b/R/parser.R @@ -568,7 +568,7 @@ strip_explicit_return <- function(expr) { } return_call <- function(info) { if (is_null(info$async_ops)) { - quote(return(last_value())) + quote(return(exhausted())) } else { quote(return(as_promise(last_value()))) } @@ -995,8 +995,8 @@ try_catch_states <- function(preamble, depth <- machine_depth(counter) try_catch_depth <- depth + 1L - # Handlers can't be evaluated until runtime. We store them in a list - # dynamically. + # Handlers can't be evaluated until runtime. We store their expressions in a + # list. They are evaluated when the user enters the `tryCatch()` state. handler_body <- expr({ !!!preamble %&&% list(user_call(preamble)) handlers[[!!try_catch_depth]] <- user(base::list(!!!handlers_exprs)) diff --git a/man/generator.Rd b/man/generator.Rd index 53a092e..4b1e279 100644 --- a/man/generator.Rd +++ b/man/generator.Rd @@ -38,16 +38,18 @@ protocol such as \code{\link[=loop]{loop()}} and \code{\link[=collect]{collect() } \examples{ # A generator statement creates a generator factory. The -# following generator yields two times and then returns `"c"`: +# following generator yields three times and then returns `"d"`. +# Only the yielded values are visible to the callers. generate_abc <- generator(function() { yield("a") yield("b") - "c" + yield("c") + "d" }) -# Or equivalently: +# Equivalently: generate_abc <- generator(function() { - for (x in letters[1:3]) { + for (x in c("a", "b", "c")) { yield(x) } }) diff --git a/tests/testthat/_snaps/generator.md b/tests/testthat/_snaps/generator.md index 166c364..3907a5f 100644 --- a/tests/testthat/_snaps/generator.md +++ b/tests/testthat/_snaps/generator.md @@ -28,7 +28,7 @@ state[[1L]] <- 3L }, `3` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -64,7 +64,7 @@ state[[1L]] <- 3L }, `3` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) diff --git a/tests/testthat/_snaps/parser-block.md b/tests/testthat/_snaps/parser-block.md index da24478..691c5ce 100644 --- a/tests/testthat/_snaps/parser-block.md +++ b/tests/testthat/_snaps/parser-block.md @@ -21,7 +21,7 @@ state[[1L]] <- 3L }, `3` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -60,7 +60,7 @@ "after2" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -93,7 +93,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -141,7 +141,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -187,7 +187,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -222,7 +222,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -251,7 +251,7 @@ state[[1L]] <- 3L }, `3` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -291,7 +291,7 @@ state[[1L]] <- 5L }, `5` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -336,7 +336,7 @@ "after2" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -377,7 +377,7 @@ "after2" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -416,7 +416,7 @@ "after2" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -481,7 +481,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -520,7 +520,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -559,7 +559,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) diff --git a/tests/testthat/_snaps/parser-if.md b/tests/testthat/_snaps/parser-if.md index 9def096..eecbf3c 100644 --- a/tests/testthat/_snaps/parser-if.md +++ b/tests/testthat/_snaps/parser-if.md @@ -83,7 +83,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -174,7 +174,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -271,7 +271,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -347,7 +347,7 @@ "if-after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `4` = { break }) @@ -367,7 +367,7 @@ "foo" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `2` = { break }) @@ -441,7 +441,7 @@ state[[3L]] <- 3L }, `3` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `4` = { break }) @@ -476,7 +476,7 @@ "foo" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `2` = { break }) @@ -589,7 +589,7 @@ "if-2-after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `4` = { break }) @@ -624,7 +624,7 @@ FALSE }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `2` = { break }) @@ -694,7 +694,7 @@ "if-after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `4` = { break }) @@ -725,7 +725,7 @@ "else-after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `4` = { break }) @@ -844,7 +844,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -932,7 +932,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1026,7 +1026,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1120,7 +1120,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1209,7 +1209,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1430,7 +1430,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) diff --git a/tests/testthat/_snaps/parser-loop.md b/tests/testthat/_snaps/parser-loop.md index d1e89ab..21163a6 100644 --- a/tests/testthat/_snaps/parser-loop.md +++ b/tests/testthat/_snaps/parser-loop.md @@ -47,7 +47,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -90,7 +90,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -139,7 +139,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -217,7 +217,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -280,7 +280,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -329,7 +329,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -418,7 +418,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1159,7 +1159,7 @@ state[[1L]] <- 5L }, `5` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1325,7 +1325,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1523,7 +1523,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1670,7 +1670,7 @@ repeat switch(state[[3L]], `1` = { user(1L) exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `2` = { break }) @@ -1862,7 +1862,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -2008,7 +2008,7 @@ "after" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) diff --git a/tests/testthat/_snaps/parser.md b/tests/testthat/_snaps/parser.md index 7053a02..6b1364f 100644 --- a/tests/testthat/_snaps/parser.md +++ b/tests/testthat/_snaps/parser.md @@ -10,7 +10,7 @@ repeat switch(state[[1L]], `1` = { user("foo") exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -28,7 +28,7 @@ repeat switch(state[[1L]], `1` = { user("foo") exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -53,7 +53,7 @@ state[[1L]] <- 3L }, `3` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -78,7 +78,7 @@ state[[1L]] <- 3L }, `3` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -102,7 +102,7 @@ "bar" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -133,7 +133,7 @@ state[[1L]] <- 3L }, `3` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -157,7 +157,7 @@ "value" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -192,7 +192,7 @@ "bar" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -227,7 +227,7 @@ "bar" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -314,7 +314,7 @@ body2() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -369,7 +369,7 @@ body4() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -447,7 +447,7 @@ body4() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -844,7 +844,7 @@ body2() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -932,7 +932,7 @@ body2() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1036,7 +1036,7 @@ body2() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1079,7 +1079,7 @@ state[[2L]] <- 3L }, `3` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `4` = { break }) @@ -1099,7 +1099,7 @@ "else" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `2` = { break }) @@ -1323,7 +1323,7 @@ body2() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1482,7 +1482,7 @@ body3() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1601,7 +1601,7 @@ body4() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1772,7 +1772,7 @@ body2() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1795,7 +1795,7 @@ }, `2` = { .last_value <- user_env[["x"]] <- if (missing(arg)) NULL else arg exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1822,7 +1822,7 @@ }, `2` = { .last_value <- user_env[["x"]] <- if (missing(arg)) NULL else arg exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1840,7 +1840,7 @@ repeat switch(state[[1L]], `1` = { user(tryCatch(foo())) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1883,7 +1883,7 @@ state[[2L]] <- 3L }, `3` = { exhausted <- TRUE - return(last_value()) + return(exhausted()) }, `4` = { break }) @@ -1901,7 +1901,7 @@ last_value() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1965,7 +1965,7 @@ "value" }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -1983,7 +1983,7 @@ repeat switch(state[[1L]], `1` = { user(withCallingHandlers(expr)) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) @@ -2042,7 +2042,7 @@ last_value() }) exhausted <- TRUE - return(last_value()) + return(exhausted()) }) exhausted <- TRUE invisible(exhausted()) diff --git a/tests/testthat/test-generator.R b/tests/testthat/test-generator.R index e91eaf1..8286241 100644 --- a/tests/testthat/test-generator.R +++ b/tests/testthat/test-generator.R @@ -1,6 +1,6 @@ test_that("can create non-yielding generator functions", { gen <- generator(function() "foo") - expect_identical(collect(gen()), list("foo")) + expect_identical(collect(gen()), list()) }) test_that("can yield `NULL` without terminating iteration", { @@ -71,7 +71,7 @@ test_that("generator factories can take dots", { }) test_that("generators can take missing arguments", { - new_gen <- generator(function(arg) missing(arg)) + new_gen <- generator(function(arg) yield(missing(arg))) expect_true(new_gen()()) expect_false(new_gen(1)()) }) @@ -87,7 +87,7 @@ test_that("yield within if within for loops properly", { } } }) - expect_identical(collect(new_gen()), list(1L, 2L, 3L, 4L, 100L)) + expect_identical(collect(new_gen()), list(1L, 2L, 3L, 4L)) }) test_that("unexpected exits disable generators", { @@ -104,43 +104,47 @@ test_that("unexpected exits disable generators", { }) test_that("can use tryCatch()", { - out <- gen({ - tryCatch( + out <- collect(gen({ + x <- tryCatch( error = function(...) "handled", { stop("error") yield("yield") } ) - })() - expect_equal(out, "handled") + yield(x) + })) + expect_equal(out, list("handled")) - out <- gen({ - tryCatch( + out <- collect(gen({ + x <- tryCatch( error = function(...) "handled", { stop("error") yield("yield") } ) - "value" - })() - expect_equal(out, "value") + yield(x) + yield("value") + })) + expect_equal(out, list("handled", "value")) - out <- gen({ + out <- collect(gen({ if (TRUE) { - tryCatch( + x <- tryCatch( error = function(...) "handled", { repeat if (TRUE) stop("error") yield("yield") } ) } - "value" - })() - expect_equal(out, "value") + yield(x) + yield("value") + })) + expect_equal(out, list("handled", "value")) out <- gen(tryCatch({ stop("foo"); yield("value") }, error = function(...) "handled"))() - expect_equal(out, "handled") + expect_equal(out, exhausted()) + # Handlers are matched to the condition class expect_error( gen({ tryCatch( @@ -149,7 +153,7 @@ test_that("can use tryCatch()", { yield("yield") } ) - "value" + yield("value") })(), regexp = "error" ) @@ -173,10 +177,12 @@ test_that("tryCatch(finally = ) is handled", { test_that("can yield within tryCatch()", { g <- gen({ - tryCatch(error = function(...) "handled", { + x <- tryCatch(error = function(...) "handled", { yield("value") stop("error") }) + yield(x) + yield("value") }) expect_equal(g(), "value") expect_equal(g(), "handled") @@ -188,21 +194,9 @@ test_that("can assign tryCatch()", { yield("value") stop("error") }) - value + yield(value) }) expect_equal(collect(g), list("value", "handled")) - - # Last expression - fn <- NULL - g <- gen({ - fn <<- function() value - value <- tryCatch(error = function(...) "handled", { - yield("value") - stop("error") - }) - }) - expect_equal(collect(g), list("value", "handled")) - expect_equal(fn(), "handled") }) test_that("can't await() within a generator", { @@ -219,10 +213,11 @@ test_that("reentering the generator forces argument in proper context", { expect_error(g(stop("error")), "error") g <- generator(function() { - tryCatch(error = function(...) "handled", { + x <- tryCatch(error = function(...) "handled", { yield("value") return("wrong") }) + yield(x) })() g() expect_equal(g(stop("error")), "handled") @@ -234,13 +229,16 @@ test_that("exit expressions are suspended and resumed", { g <- generator(function() { on.exit(unwound <<- TRUE) yield(1) - 2 + yield(2) })() expect_equal(g(), 1) expect_false(unwound) expect_equal(g(), 2) + expect_false(unwound) + + expect_exhausted(g()) expect_true(unwound) unwound <- FALSE @@ -249,7 +247,7 @@ test_that("exit expressions are suspended and resumed", { }) test_that("formals of generator factory do not mask private variables", { - generate <- generator(function(fn = "arg", env = "arg") c(fn, env)) + generate <- generator(function(fn = "arg", env = "arg") yield(c(fn, env))) expect_equal( generate()(), c("arg", "arg") @@ -257,32 +255,17 @@ test_that("formals of generator factory do not mask private variables", { }) test_that("yield-assign returns default `NULL`", { - g <- generator(function() x <- yield("foo"))() - expect_equal(collect(g), list("foo", NULL)) - - g <- generator(function() x <- tryCatch(yield("foo")))() + g <- generator(function() { + x <- yield("foo") + yield(x) + })() expect_equal(collect(g), list("foo", NULL)) -}) - -test_that("trailing yield-assign returns argument", { - g <- generator(function() x <- yield("foo"))() - g() - expect_equal(g("bar"), "bar") - - g <- generator(function() x <- tryCatch(yield("foo")))() - g() - expect_equal(g("bar"), "bar") - - g <- generator(function() x <- tryCatch(if (TRUE) yield("foo")))() - g() - expect_equal(g("bar"), "bar") g <- generator(function() { - x <- tryCatch(if (TRUE) yield("foo")) - x + x <- tryCatch(yield("foo")) + yield(x) })() - g() - expect_equal(g("bar"), "bar") + expect_equal(collect(g), list("foo", NULL)) }) test_that("generators call as_iterator() method", { @@ -309,7 +292,10 @@ test_that("generators call as_iterator() method", { }) test_that("can yield-assign with `=` (#29)", { - g <- generator(function() x = yield("foo")) + g <- generator(function() { + x = yield("foo") + yield(x) + }) expect_equal(collect(g()), list("foo", NULL)) i <- g() @@ -339,3 +325,16 @@ test_that("generators do not cause CMD check notes (#40)", { )) ) }) + +test_that("returning early doesn't yield values (#51)", { + g <- generator(function(items) NULL) + expect_equal(collect(g()), list()) + + g <- generator(function(items) { + if (TRUE) { + return() + } + yield("value") + }) + expect_equal(collect(g()), list()) +})